(define (make-primitive-iterator initial-value transform)
  (lambda (function)
    (define (loop x)
      (function x)
      (loop (transform x)))
    (loop initial-value)))

(syntax ($make-primitive-iterator initial-value transform)
  (lambda ($function)
    (define (loop x)
      ($function x)
      (loop (transform x)))
    (loop initial-value)))

(define (make-primitive-iterator! initial-value transform)
  (lambda (function)
    (define (loop x)
      ((lambda (next) (function x) (loop next))
       (transform x)))
    (loop initial-value)))

(syntax ($make-primitive-iterator! initial-value transform)
  (lambda ($function)
    (define (loop x)
      ((lambda (next) ($function x) (loop next))
       (transform x)))
    (loop initial-value)))

(define (restrict-iterator predicate iterator)
  (lambda (function)
    (iterator (when-combinator predicate function))))

(syntax ($restrict-iterator predicate iterator)
  (lambda ($function)
    (iterator ($when-combinator predicate $function))))

(define (compose-iterator f iterator)
  (lambda (g)
    (iterator (compose g f))))

(syntax ($compose-iterator f iterator)
  (lambda ($g)
    (iterator ($compose $g f))))

(define (make-iterator-until predicate iterator marker)
  (lambda (function)
    (call-with-current-continuation
      (lambda (exit)
        (iterator (if-combinator predicate exit function))
        marker))))

(syntax ($make-iterator-until predicate iterator marker)
  (lambda ($function)
    (call-with-current-continuation
      (lambda ($exit)
        (iterator ($if-combinator predicate $exit $function))
        marker))))

(define (make-iterator-while predicate iterator marker)
  (lambda (function)
    (call-with-current-continuation
      (lambda (exit)
        (iterator (if-combinator predicate function exit))
        marker))))

(syntax ($make-iterator-while predicate iterator marker)
  (lambda ($function)
    (call-with-current-continuation
      (lambda ($exit)
        (iterator ($if-combinator predicate $function $exit))
        marker))))

(define (for-each-in-interval first last)
  (make-iterator-until
    (bind-1-of-2 < last)
    (make-primitive-iterator first 1+)
    88)) ;why 88?

(syntax ($for-each-in-interval first last)
  ($make-iterator-until
    ($bind-1-of-2 < last)
    ($make-primitive-iterator first 1+)
    88))

(define (accumulate-iterator iterator)
  (lambda (function initial-value)
    (iterator
      (lambda (x) (set! initial-value (function initial-value x))))
    initial-value))

(syntax ($accumulate-iterator iterator)
  (lambda ($function $initial-value)
    (iterator
      (lambda ($x) (set! $initial-value ($function $initial-value $x))))
    $initial-value))

(define (test3 n) (($accumulate-iterator ($for-each-in-interval 1 n)) max 0))

(define (make-reduction iterator)
  (lambda (function . identity)
    (define result)
    (define marker #!false)
    (define (first-time x)
      (set! result x)
      (set! marker #!true)
      (set! first-time rest-of-times))
    (define (rest-of-times x)
      (set! result (function result x)))
    (iterator (lambda (x) (first-time x)))
    (if marker
        result
        (if identity (car identity) (function)))))

;;; and now we can define factorial as

(define (factorial n)
  ((make-reduction (for-each-in-interval 1 n)) *))


;;; functional forms on lists

;;; <cons, car and stuff>

(define (for-each-cdr list)
  (make-iterator-until pair? (make-primitive-iterator list cdr)))

(define (for-each-cdr! list)
  (make-iterator-until pair? (make-primitive-iterator! list cdr)))

(define (for-each-car list)
  (compose-iterator car (for-each-cdr list)))

(define (make-map! list)
  (lambda (function)
    ((for-each-cdr list) (lambda (x) (set-car! x (function (car x)))))))

(define (reverse-append a b)
  ((make-accumulate (for-each-car a)) (T-combinator cons) b))

(define (reverse-append! a b)
  ((make-accumulate (for-each-cdr! a))
   (lambda (x y) (set-cdr! y x) y)
   b))

;;;or we can use a clever trick of Risch:

(define (rcons pair value)
  (let ((temp (cons value '())))
    (set-cdr! pair temp)
    temp))

(define ((make-collect-cons iterator) function)
  (let ((header (cons 9 9))) ;9 is as good as anithing
    ((make-accumulate iterator)
     rcons
     header)
    (cdr header)))

(define (make-map list)
  (make-collect-cons (for-each-car list))

(define (list-copy list) ((make-map list) identity))

(define ((make-collect-append! iterator) function)
  (reverse!
    ((make-accumulate iterator)
     (lambda (x y) (reverse-append! (function y) x))
     '())))

(define (map-append! list) (make-collect-append! (for-each-car list)))


(define (member-if predicate? list)
  ((make-iterate-until
     (compose predicate? car)
     (for-each-cdr list)
     '())
   identity))

(define (filter predicate list)
  (map-append!
    (lambda (x)
      (if (predicate x)
          (cons x '())
          '()))
    list))

(define (filter! predicate list)
  (let ((first (member-if predicate list)))
    (if first
        (apply-until
          (lambda (x) (null? (cdr x)))
          (lambda (x)
            (cond ((predicate (cadr x))
                   (cdr x))
                  (else
                    (set-cdr! x (cddr x))
                    x)))
          first))
    first))