;	     Inverting a left-fold enumerator inside out
;
; The code demonstrates a generic left-fold-inversion
; procedure. lfold->lazy-list takes the left-fold enumerator 
; (such as the one defined in SRFI-44) for _any_
; collection whatsoever, and converts the enumerator to a lazy list.
; The test code is included. 
;
; This code was tested on Bigloo, Scheme48, SCM, and Petite Chez Scheme.
; It requires the standard Prelude for the corresponding
; platform, see util.html
; Please refer to
;    http://pobox.com/~oleg/ftp/Scheme/enumerators-callcc.html
; for more details.
;
; $Id: enumerators-callcc-code.scm,v 2.1 2004/01/01 04:13:18 oleg Exp oleg $


; The following three functions emulate a stream in Scheme.
; Some implementations of Scheme can force promises implicitly. In that
; case, the following three definitions become redundant.
(define (fcar x) (car (force x)))
(define (fcdr x) (cdr (force x)))
(define (fnull? x) (null? (force x)))


; The generic enumerator-inversion procedure
(define (lfold->lazy-list lfold collection)
  (delay
    (call-with-current-continuation
      (lambda (k-main)
	(lfold collection
	  (lambda (val seed)
	    ;(cerr (list val seed) nl)
	    (values
	      (call-with-current-continuation
		(lambda (k-reenter)
		  (k-main
		    (cons val
		      (delay
			(call-with-current-continuation
			  (lambda (k-new-main)
			    (set! k-main k-new-main)
			    (k-reenter #t))))))))
	      seed))
	  '()) 				; Initial seed
	(k-main '())))))

; A sample left-fold iterator (following SRFI-44)
; Collection is a file of data items. A datum is whatever 'read' reads.
; For the purpose of the current example, rather than enumerating the
; real file, we enumerate a string port. Therefore, our left-fold
; iterator receives a string, which it treats as a body of a file.

(define (string-port-fold-left coll fn . seeds)
  (call-with-input-string coll
    (lambda (port)
      (let loop ((continue? #t) (seeds seeds))
	(if (not continue?) (apply values seeds)
	  (let ((val (read port)))
	    (if (eof-object? val) (loop #f seeds)
	      (let*-values
		(((proceed? . seeds) (apply fn val seeds)))
		(loop proceed? seeds)))))))))

(cerr "Testing string-port-fold-left ..." nl)
(define test-str-file "1 2 #f 3.4 42")
(let ((expected-vals '(1 2 #f 3.4 42)))
  (cerr "Complete enumeration...")
  (let ((received-vals
	  (string-port-fold-left test-str-file
	    (lambda (val seed) (values #t (cons val seed)))
	    '())))
    (assert (equal? (reverse received-vals) expected-vals))
    (cerr "Done" nl))
  (cerr "Partial enumeration...")
  (let*-values
    (((val-exp count-exp) (values 3.4 4)) ; The first value >2, count
     ((val-rec count-rec)
       (string-port-fold-left test-str-file
	 (lambda (val in-val count)
	   (let ((count (+ 1 count)))
	     (if (and (number? val) (> val 2)) (values #f val count)
	       (values #t in-val count))))
	 #f 0)))
    (assert (equal? count-rec count-exp) (equal? val-rec val-exp))
    (cerr "Done" nl))
)

    
(cerr nl "Testing iteration inversion" nl)
(let* ((expected-vals '(1 2 #f 3.4 42))
       (stream (lfold->lazy-list string-port-fold-left test-str-file))
       (received-vals
	 (let loop ((stream stream) (acc '()))
	   (if (fnull? stream) acc
	     (loop (fcdr stream) (cons (fcar stream) acc))))))
  (assert (equal? (reverse received-vals) expected-vals)))

(cerr "All tests passed" nl)