; General ways to traverse collections, and the fate of call/cc
;
; The code for the article
;    http://pobox.com/~oleg/ftp/Scheme/enumerators-callcc.html
;
; That article aims to consider various ways of traversing a collection,
; stressing the most complex and general case. That is, enumerating
; only a subset of a collection and performing actions that depend
; on the previously traversed nodes. This article also demonstrates
; a non-trivial use of call/cc -- to "invert" a traversal "inside out."
; In this application, call/cc _cannot_ be replaced with a simple
; throw/catch construction. A proposal is made for a convenient generic
; enumerator (which could be used, for example, in a truly Scheme
; ODBC interface).
;
; Suppose we have a collection with a for-each-type enumerator:
; a file system directory, an XML document, a suffix tree,
; or a "dynamic" collection that is the result of executing a
; SELECT DBMS/ODBC statement. Suppose we want to obtain the first
; 10 elements of the collection that satisfy a certain criterion:
; contain specific keywords, sound alike, what have you.
;
; For the purpose of this example, let's consider a collection
; of numbers of the form 65537x+5 mod 1997;  The criterion will be
; a value being divisible by 7. To make the problem less trivial, let
; the collection be represented by a treap. We won't use the full
; power of the treap in this example: what matters to us is that it
; is an advanced collection, and it implements a for-each enumerator.
;
; $Id: enumerators-callcc-code-old.scm,v 2.1 2004/01/01 03:51:57 oleg Exp oleg $

(include "lib/myenv.scm")
(include "lib/treap.scm") 

			; Make a collection to experiment with
(cerr "Loading a treap to play with..." nl)
(define treap (make-treap -))
(do ((i 0 (++ i))) ((>= i 1000))
  ((treap 'put!) (modulo (+ (* i 65537) 5) 1997) i))
(cerr "    treap's depth is " (treap 'depth) nl)
; (treap 'debugprint)

			; A criterion in our running example
(define (good-value? x) (zero? (modulo x 7)))
(define pagesize 10)	; How many good numbers to seek

			; This will serve as our baseline...
(cerr nl "Printing out " pagesize " good numbers from the collection" nl
      "    in a straightforward approach" nl)
(define (get-good-numbers-dumb treap count-max)
  (let ((count 0) (result '()))
    ((treap 'for-each-ascending)
      (lambda (key-value)
        (let ((x (car key-value)))
          (and (< count count-max) (good-value? x)
            (begin
              (set! count (+ 1 count))
              (set! result (cons x result)))))))
    (reverse result)))

(cerr (time (get-good-numbers-dumb treap pagesize)) nl)

; Assignments are prominent in this solution: they are necessary to advance
; the state. It must be represented by global (to the iteratee)
; variables, which can persists from one invocation of the iteratee to the
; other.

(cerr nl "Printing out " pagesize " good numbers from the collection" nl
      "    in the straightforward approach with an early escape" nl)
(define (get-good-numbers-cc treap count-max)
  (let ((count 0) (result '()))
    (call-with-current-continuation
      (lambda (escape)
        ((treap 'for-each-ascending)
          (lambda (key-value)
            (let ((x (car key-value)))
              (and (good-value? x)
                (begin
                  (set! count (+ 1 count))
                  (set! result (cons x result))
                  (if (>= count count-max)
                    (escape #f)))))))))
    (reverse result)))

(cerr (time (get-good-numbers-cc treap pagesize)) nl)


; Lazy list: a promise, which when applied returns '() or
; (cons value lazy-list)
; data LazyList a = Promise (Nil | (Cons a (LazyList a)))

(define (treap->lazy-list treap)
  (delay
    (call-with-current-continuation
      (lambda (k-main)
        ((treap 'for-each-ascending)
          (lambda (key-value)
            ; (cerr "\nIn treap->lazy-list's iteratee: " key-value "\n")
            (call-with-current-continuation
              (lambda (k-reenter)
                (let ((x (car key-value)))
                  (k-main (cons x
                      (delay
                        (call-with-current-continuation
                          (lambda (k-new-main)
                            (set! k-main k-new-main)
                            (k-reenter #f)))))))))))
        (k-main '())))))

		; Some implementations of Scheme can do forcing implicitly...
(define (fcar x) (car (force x)))
(define (fcdr x) (cdr (force x)))
(define (fnull? x) (null? (force x)))

(define lazy-treap-list (treap->lazy-list treap))
(cerr nl "First three elems of the treap: "
  (fcar lazy-treap-list) " "
  (fcar (fcdr lazy-treap-list)) " "
  (fcar (fcdr (fcdr lazy-treap-list))) nl)


(cerr nl "Printing out " pagesize " good numbers from the collection" nl
      "    by enumerating the lazy list" nl)
(define (get-good-numbers-ll lazy-treap-list count-max)
  (let loop ((count 0) (llst lazy-treap-list) (result '()))
    (cond
      ((or (>= count count-max) (fnull? llst)) (reverse result))
      ((good-value? (fcar llst))
        (loop (+ 1 count) (fcdr llst) (cons (fcar llst) result)))
      (else
        (loop count (fcdr llst) result)))))

(cerr (time (get-good-numbers-ll lazy-treap-list pagesize)) nl)

; Note a commented out line calling cerr procedure at the very
; beginning of the treap iteratee. If you uncomment that line
; you can see for yourself that iteratee is called only as many times
; as absolutely necessary during execution of get-good-numbers-ll.
; In all other respects lazy-treap-list looks like a regular list.
; This makes even complex, history-dependent traversal easily implementable,
; as lists can be walked in a variety of ways. The get-good-numbers-ll
; is a thinly-veiled finite state machine implemented in a pure-functional
; style.
; Performance-wise, the lazy list is definitely better than the dumb
; enumeration: the lazy list does not fetch the elements if they are
; not needed. Yet the lazy list loses out to the early escape.

; The get-good-numbers-ll procedure is purely functional: The state
; of the traversal is abstracted into a lazy pair, a first-class
; object. To advance the traversal, one has to _explicitly_ apply
; methods like fcdr (aka 'next'). One also has to explicitly check for EOF.
; In this respect, a lazy list is very similar to an STL
; iterator. OTH, a for-each enumerator does not give an iteratee
; any hint about the current state of the traversal, or its history.

; Procedure treap->lazy-list shows off call/cc at its best -- its
; ability not only to escape a scope but to re-enter it as well. 
; treap->lazy-list cannot be implemented with simpler, throw-like
; constructions.

; There has been a discussion about the fate of call/cc. No doubt call/cc
; causes many a grief to implementors. Is this worth the trouble? The
; conclusions of this article are mixed.
; The early-escape solution uses call/cc only to throw a
; non-reenterable exception. This solution will work even if call/cc did
; not exist, being replaced by its weak relative, throw or raise. Only
; treap->lazy-list requires the full call/cc, to implement an
; enumeration-inversion trick. Is it worth it? Flexibility
; may be gained, yet some performance is lost.