;;; Iterators
;;; one of the central ideas of higher order programming
;;; is the idea of using higher order functional forms
;;; (functions that produce functions) in stead of using
;;; recursion (tail or otherwise)
;;; we can implement a function that adds squareroots of all even
;;; numbers in an interval (a, b); but if we want to add square roots
;;; of all numbers in a list we shall need another program; and
;;; another one for vectors; and another one for heaps ...
;;; we can simplify our life by introducing iterators, that are
;;; somewhat like universal quantifiers on data structures
;;; simpliest class of functional forms are iterators
;;; iterator is a function that takes a structure and
;;; returns a function that takes a function f of one
;;; argument as its argument and applies f to every
;;; element of the structure
;;; most primitive kind of iterators can be produced with
(define (primitive-iterator initial-value transform)
(lambda (function)
(define (loop x)
(function x)
(loop (transform x)))
(loop initial-value)))
;;; sometimes the function we pass to the iterator is destructive
;;; and can affect x; to handle cases like that we define
(define (primitive-iterator! initial-value transform)
(lambda (function)
(define (loop x)
((lambda (next) (function x) (loop next))
(transform x)))
(loop initial-value)))
;;; For example, we can iterate through natural numbers with
(define for-each-natural-number
(primitive-iterator 1 1+))
;;; Problem:
;;; what will happen if you say
;;; (for-each-natural-number print)
;; ? (before you try it find out Ctrl-Break on your keyboard)
;;; here you can ask what good does it do to have a non-terminating
;;; iterators.
;;; but we can make functions that
;;; starting with any iterator can produce other iterators
;;; out of it
;;; for example, restrict-iterator takes a predicate and
;;; an iterator and returns a new iterator which applies
;;; function only to those elements that satisfy the predicate
(define (restrict-iterator predicate iterator)
(lambda (function)
(iterator (when-combinator predicate function))))
;;; and we can compose an iterator with a function
(define ((compose-iterator f iterator) g)
(iterator (compose g f)))
;;; and we can terminate the iteration with the following two
;;; iterator-manipulating functions:
(define (iterator-until predicate iterator marker)
(lambda (function)
(call-with-current-continuation
(lambda (exit)
(iterator (if-combinator predicate exit function))
marker))))
(define (iterator-while predicate iterator marker)
(lambda (function)
(call-with-current-continuation
(lambda (exit)
(iterator (if-combinator predicate function exit))
marker))))
;;; where call-with-current-continuation (or call/cc) is a
;;; function that ...
;;; there is an "extra" feature in iterators created with
;;; iterator-until and iterator-while: in case
;;; of "unnatural" termination they return a value that caused it
;;; otherwise they return a marker
;;; we can define a product of iterators
(define (product-of-iterators operation iterator1 iterator2)
(lambda (function)
(iterator1
(lambda (x)
(iterator2
(lambda (y)
(function (operation x y))))))))
;;; first class continuations allow us to step through an iterator
(define (make-step-iterator function iterator)
(lambda (return)
(iterator
(lambda (x)
(set! return
(call-with-current-continuation
(lambda (rest) (function x) (return rest))))))
#!false))
(define (step-iterator iterator)
(call-with-current-continuation
(lambda (here)
(iterator here))))
(define (sum-of-iterators operation iterator1 iterator2)
(lambda (function)
(let ((value1 '())
(value2 '()))
(let loop ((step1 (step-iterator
(make-step-iterator
(lambda (x) (set! value1 x))
iterator1)))
(step2 (step-iterator
(make-step-iterator
(lambda (x) (set! value2 x))
iterator2))))
(cond ((and step1 step2)
(function (operation value1 value2))
(loop (step-iterator step1)
(step-iterator step2)))
(step1 step1)
(step2 step2)
(else #!false))))))
(define (for-each-in-interval first last)
(iterator-until
(bind-1-of-2 < last)
(primitive-iterator first 1+)
'will-never-use-this-marker))
;;; it would also be nice
;;; to implement reduction (reduction operator was introduced by
;;; Kenneth Iverson in APL)
(define (reduce iterator)
(lambda (function . initial-value)
(define (add-to x)
(set! initial-value (function initial-value x)))
(cond (initial-value
(set! initial-value (car initial-value))
(iterator add-to)
initial-value)
(else
(let ((marker #!false))
(define (first-time x)
(set! initial-value x)
(set! marker #!true)
(set! first-time add-to))
(iterator (lambda (x) (first-time x)))
(if marker initial-value (function)))))))
;;; where set! is a special form that changes a value of a binding
;;; with all that we can give a new definition of factorial
(define (factorial n)
((reduce (for-each-in-interval 1 n)) *))
;;; Problem
;;; what does this function do:
(define (foo n)
((reduce
(compose-iterator (compose / factorial) (for-each-in-interval 0 n)))
+))
;;; ?
;;; Problem
;;; implement a function that takes an iterator and computes a mean of
;;; elements through which iteration is done
;;; functional forms on lists
;;;
(define (for-each-cdr list)
(iterator-while pair? (primitive-iterator list cdr) '()))
;;; (define for-each-cdr
;;; (compose (bind-1-of-2 iterator-while pair?)
;;; (bind-2-of-2 primitive-iterator cdr)))
(define (for-each-cdr! list)
(iterator-while pair? (primitive-iterator! list cdr) '()))
(define (for-each list)
(compose-iterator car (for-each-cdr list)))
(define (map! list)
(lambda (function)
((for-each-cdr list) (lambda (x) (set-car! x (function (car x)))))))
(define (reverse-append a b)
((reduce (for-each a)) (T-combinator cons) b))
(define (reverse-append! a b)
((reduce (for-each-cdr! a))
(lambda (x y) (set-cdr! y x) y)
b))
(define (vector-for-each-index v)
(for-each-in-interval 0 (-1+ (vector-length v))))
(define (vector-for-each v)
(compose-iterator (lambda (x) (vector-ref v x))
(vector-for-each-index v)))
(define (vector-map! v)
(lambda (function)
((vector-for-each-index v)
(lambda (i) (vector-set! v i (function (vector-ref v i)))))))
(define (rcons pair value)
(let ((temp (cons value '())))
(set-cdr! pair temp)
temp))
(define ((collect-cons iterator) function)
(let ((header (cons 9 9))) ;9 is as good as anithing
((reduce iterator)
rcons
header)
(cdr header)))
(define (map list)
(collect-cons (for-each list)))
(define (list-copy list) ((map list) identity))
(define ((collect-append! iterator) function)
(reverse!
((reduce iterator)
(lambda (x y) (reverse-append! (function y) x))
'())))
(define (map-append! list) (collect-append! (for-each list)))
(define (member-if predicate? list)
((iterate-until
(compose predicate? car)
(for-each-cdr list)
'())
identity))
(define (filter predicate list)
((collect-cons (restrict-iterator predicate (for-each list)))
identity))
(define (filter! predicate list)
((collect-append! (restrict-iterator (compose predicate car)
(for-each-cdr! list)))
identity))