;;;
;;; NEW TESTS
;;;

(require (planet "78.ss" ("soegaard" "srfi.plt")))
(require "ec.scm")

(begin
  
  (check (list-ec (:list x (list 1 2 3))
                  x)
         => '(1 2 3))
  
  (check (list-ec (:list x (list 1 2 3)) 
                  (:list y (list 'a 'b 'c))
                  (list x y))
         => '((1 a) (1 b) (1 c) (2 a) (2 b) (2 c) (3 a) (3 b) (3 c)))
  
  (check (list-ec (:range x 1 5)
                  x)
         => '(1 2 3 4))
  
  (check (list-ec (:list x (index i) '(a b c))
                  (list i x))
         => '((0 a) (1 b) (2 c)))
  
  (check  (list-ec (:list x '(1 2 3))
                   (:let y (* 2 x))
                   y)
          => '(2 4 6))
  
  (check (list-ec (:list x '(1 2 3))
                  (:let y (index i) (* 2 x))
                  (list i y))
         => '((0 2) (0 4) (0 6)))
  
  (check (list-ec (:parallel
                   (:list x '(1 2 3))
                   (:list y '(a b c)))
                  (list x y))
         => '((1 a) (2 b) (3 c)))
  
  (check (list-ec (:parallel (:parallel (:list x '(a b c))
                                        (:list y '(1 2 3)))
                             (:list z '(4 5 6)))
                  (list x y z))
         => '((a 1 4) (b 2 5) (c 3 6)))
  
  (check (list-ec (:parallel (:range i 2) (:range j 3) (:range k 4))
                  (list i j k))
         => '((0 0 0) (1 1 1)))
  
  (check (list-ec (:parallel (index x) (:range i 2) (:range j 3) (:range k 4))
                  (list x i j k))
         => '((0 0 0 0) (1 1 1 1)))
  
  ; :integers with index
  (check (list-ec (:parallel (:integers x (index i))
                             (:range y 5))
                  i)
         => '(0 1 2 3 4))
  
  ; filtering of vectors of length 0
  (check (list-ec (:vector x '#(1 2) '#() '#(3) '#())
                  x)
         => '(1 2 3))
  
  (check (list-ec (:range x 3 1 -1)
                  x)
         => '(3 2))
  
  
  (check (list-ec (:real-range x (index i) 2.0)
                  i)
         => '(0 1))
  
  (check (list-ec (:real-range x (index i) 1.0   4.0)
                  i)
         => '(0 1 2))
  
  ; port med index
  
  ; :parallel with one generator
  
  (check (list-ec (:parallel (:range x 4)) x)
         => '(0 1 2 3))
  
  (check (append-ec (list 1 2 3))
         => '(1 2 3))
  
  
  (check (vector-of-length-ec 4 
                              (nested (:range x 2) 
                                      (:range y 2))
                              (list x y ))
         => '#4((0 0) (0 1) (1 0) (1 1)))
  
  (check (vector-of-length-ec 4 
                              (nested (:range x 2) 
                                      (:range y 2)
                                      (:range z 1))
                              (list x y z))
         => '#4((0 0 0) (0 1 0) (1 0 0) (1 1 0)))
  
  
  (check  (list-ec (:let-values (a b) (values 1 2))
                   (list a b))
          => '((1 2)))
  
  (check  (list-ec (:let-values (a b) (index i) (values 1 2))
                   (list a b i))
          => '((1 2 0)))
  
  (check (list-ec (:repeat 5)
                  1)
         => '(1 1 1 1 1))
  
  (check (list-ec (:repeat (index i) 5)
                  i)
         => '(0 1 2 3 4))
  
  (check (list-ec (:combinations x 3 '(1 2 3 4 5)) x)
         => '((1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5)
                      (1 4 5) (2 3 4) (2 3 5) (2 4 5) (3 4 5)))
  
  (check (list-ec (:vector-combinations x 3 '#(1 2 3 4 5)) x)
         => '(#3(1 2 3) #3(1 2 4) #3(1 2 5) #3(1 3 4) #3(1 3 5) 
                        #3(1 4 5) #3(2 3 4) #3(2 3 5) #3(2 4 5) #3(3 4 5)))
  
  (check (list-ec (:iterate e 0 (lambda (x) (+ x 2)) (lambda (x) (>= x 10))) 
                  e) 
         => '(0 2 4 6 8))
  
  (check (list-ec (:pairs p '(1 2 3)) p)
         => '((1 2 3) (2 3) (3)))
  
  (check (list-ec (:pairs-by p '(1 2 3 4) cddr) p)
         => '((1 2 3 4) (3 4)))
  
  (check (list-ec (:do-until ((x 0)) (> x 5) ((+ x 1))) x)
         => '(0 1 2 3 4 5 6))
  
  (check (list-ec (:bytes x #"AB" #"C")
                  x)
         => '(65 66 67))
  
  (check (list-ec (:alist (k v) '((1 . 2) (3 . 4))) (+ k v))
         => '(3 7))
  
  (check (list-ec (:hash-table (k v) #hash((1 . 2) (3 . 4))) (+ k v))
         => '(3 7))
  
  (check (list-ec (:hash-table a #hash((1 . 2) (3 . 4))) (+ (car a) (cdr a)))
         => '(3 7))
  
  (check (list-ec (:hash-table-keys k #hash((1 . 2) (3 . 4))) k)
         => '(1 3))
  
  (check (list-ec (:hash-table-values k #hash((1 . 2) (3 . 4))) k)
         => '(2 4))
  
  (check (list-ec (: x '(1 (2 3) (3 4 5) 7 (8 9)))
                  (:match (a b) x)
                  (list a b))
         => '((2 3) (8 9)))
  
  (check (list-ec (: x '(1 (2 3) (3 4 5) 7 (8 9)))
                  (:plt-match (list a b) x)
                  (list a b))
         => '((2 3) (8 9)))
  
  ; my shop of horrors
  
  (check (list-ec (:while (:vector x (index i) '#(1 2 3 4 5))
                          (< x 10))
                  x)
         => '(1 2 3 4 5))
  
  (check (list-ec (:while (:vector x (index i) '#(1 2 3 4 5))
                          (< x 3))
                  x)
         => '(1 2))
  
  (module foo mzscheme
    ; example of defining new generator in a module
    (provide :foo)
    (require "ec.scm")
    (require-for-syntax "ec.scm") ; only neeed when add-index is used
    (define-generator (:foo stx)
      (syntax-case stx ()
        [(_ x 1) #'(:foo x)]
        [(_ x) #'(:list x '(1 2 3))])))
  (require foo)
  (check (list-ec (:foo x 1) x)
         => '(1 2 3))
  )

;;;
;;; ORIGINAL TESTS
;;;

; Tools for checking results
; ==========================

(define-syntax my-check
  (syntax-rules () [(_ x ...) (check x ...)]))
(define (my-open-output-file filename)
  (open-output-file filename 'replace 'text) )
(define (my-call-with-input-file filename thunk)
  (call-with-input-file filename thunk 'text) )

;;;
;;; TESTS FROM ORIGINAL examples.scm
;;;

; ==========================================================================
; do-ec
; ==========================================================================


(my-check 
 (let ((x 0)) (do-ec (set! x (+ x 1))) x) 
 => 1)

(my-check 
 (let ((x 0)) (do-ec (:range i 10) (set! x (+ x 1))) x) 
 => 10)

(my-check 
 (let ((x 0)) (do-ec (:range n 10) (:range k n) (set! x (+ x 1))) x) 
 => 45)


; ==========================================================================
; list-ec and basic qualifiers
; ==========================================================================
(begin
  (my-check (list-ec 1) => '(1))
  
  (my-check (list-ec (:range i 4) i) => '(0 1 2 3))
  
  (my-check (list-ec (:range n 3) (:range k (+ n 1)) (list n k)) 
            => '((0 0) (1 0) (1 1) (2 0) (2 1) (2 2)) )
  
  (my-check 
   (list-ec (:range n 5) (if (even? n)) (:range k (+ n 1)) (list n k)) 
   => '((0 0) (2 0) (2 1) (2 2) (4 0) (4 1) (4 2) (4 3) (4 4)) )
  
  (my-check 
   (list-ec (:range n 5) (not (even? n)) (:range k (+ n 1)) (list n k)) 
   => '((1 0) (1 1) (3 0) (3 1) (3 2) (3 3)) )
  
  (my-check
   (list-ec (:range n 5) 
            (and (even? n) (> n 2)) 
            (:range k (+ n 1)) 
            (list n k) )
   => '((4 0) (4 1) (4 2) (4 3) (4 4)) )
  
  (my-check
   (list-ec (:range n 5) 
            (or (even? n) (> n 3)) 
            (:range k (+ n 1)) 
            (list n k) )
   => '((0 0) (2 0) (2 1) (2 2) (4 0) (4 1) (4 2) (4 3) (4 4)) )
  
  (my-check
   (let ((x 0)) (list-ec (:range n 10) (begin (set! x (+ x 1))) n) x)
   => 10 )
  
  (my-check
   (list-ec (nested (:range n 3) (:range k n)) k)
   => '(0 0 1) )
  )

; ==========================================================================
; Other comprehensions
; ==========================================================================

(begin
  (my-check (append-ec '(a b)) => '(a b))
  (my-check (append-ec (:range i 0) '(a b)) => '())
  (my-check (append-ec (:range i 1) '(a b)) => '(a b))
  (my-check (append-ec (:range i 2) '(a b)) => '(a b a b))
  
  (my-check (string-ec #\a) => (string #\a))
  (my-check (string-ec (:range i 0) #\a) => "")
  (my-check (string-ec (:range i 1) #\a) => "a")
  (my-check (string-ec (:range i 2) #\a) => "aa")
  
  (my-check (string-append-ec "ab") => "ab")
  (my-check (string-append-ec (:range i 0) "ab") => "")
  (my-check (string-append-ec (:range i 1) "ab") => "ab")
  (my-check (string-append-ec (:range i 2) "ab") => "abab")
  
  (my-check (vector-ec 1) => (vector 1))
  (my-check (vector-ec (:range i 0) i) => (vector))
  (my-check (vector-ec (:range i 1) i) => (vector 0))
  (my-check (vector-ec (:range i 2) i) => (vector 0 1))
  
  (my-check (vector-of-length-ec 1 1) => (vector 1))
  (my-check (vector-of-length-ec 0 (:range i 0) i) => (vector))
  (my-check (vector-of-length-ec 1 (:range i 1) i) => (vector 0))
  (my-check (vector-of-length-ec 2 (:range i 2) i) => (vector 0 1))
  
  (my-check (sum-ec 1) => 1)
  (my-check (sum-ec (:range i 0) i) => 0)
  (my-check (sum-ec (:range i 1) i) => 0)
  (my-check (sum-ec (:range i 2) i) => 1)
  (my-check (sum-ec (:range i 3) i) => 3)
  
  (my-check (product-ec 1) => 1)
  (my-check (product-ec (:range i 1 0) i) => 1)
  (my-check (product-ec (:range i 1 1) i) => 1)
  (my-check (product-ec (:range i 1 2) i) => 1)
  (my-check (product-ec (:range i 1 3) i) => 2)
  (my-check (product-ec (:range i 1 4) i) => 6)
  
  (my-check (min-ec 1) => 1)
  (my-check (min-ec (:range i 1) i) => 0)
  (my-check (min-ec (:range i 2) i) => 0)
  
  (my-check (max-ec 1) => 1)
  (my-check (max-ec (:range i 1) i) => 0)
  (my-check (max-ec (:range i 2) i) => 1)
  
  (my-check (first-ec #f 1) => 1)
  (my-check (first-ec #f (:range i 0) i) => #f)
  (my-check (first-ec #f (:range i 1) i) => 0)
  (my-check (first-ec #f (:range i 2) i) => 0)
  
  (my-check 
   (let ((last-i -1))
     (first-ec #f (:range i 10) (begin (set! last-i i)) i)
     last-i )
   => 0 )
  
  (my-check (last-ec #f 1) => 1)
  (my-check (last-ec #f (:range i 0) i) => #f)
  (my-check (last-ec #f (:range i 1) i) => 0)
  (my-check (last-ec #f (:range i 2) i) => 1)
  
  (my-check (any?-ec #f) => #f)
  (my-check (any?-ec #t) => #t)
  (my-check (any?-ec (:range i 2 2) (even? i)) => #f)
  (my-check (any?-ec (:range i 2 3) (even? i)) => #t)
  
  (my-check (every?-ec #f) => #f)
  (my-check (every?-ec #t) => #t)
  (my-check (every?-ec (:range i 2 2) (even? i)) => #t)
  (my-check (every?-ec (:range i 2 3) (even? i)) => #t)
  (my-check (every?-ec (:range i 2 4) (even? i)) => #f)
  
  (my-check 
   (let ((sum-sqr (lambda (x result) (+ result (* x x)))))
     (fold-ec 0 (:range i 10) i sum-sqr) )
   => 285 )
  
  (my-check 
   (let ((minus-1 (lambda (x) (- x 1)))
         (sum-sqr (lambda (x result) (+ result (* x x)))))
     (fold3-ec (error "wrong") (:range i 10) i minus-1 sum-sqr) )
   => 284 )
  
  (my-check 
   (fold3-ec 'infinity (:range i 0) i min min)
   => 'infinity )
  )

; ==========================================================================
; Typed generators
; ==========================================================================


(begin
  (my-check (list-ec (:list x '()) x) => '())
  (my-check (list-ec (:list x '(1)) x) => '(1))
  (my-check (list-ec (:list x '(1 2 3)) x) => '(1 2 3))
  (my-check (list-ec (:list x '(1) '(2)) x) => '(1 2))
  (my-check (list-ec (:list x '(1) '(2) '(3)) x) => '(1 2 3))
  
  (my-check (list-ec (:string c "") c) => '())
  (my-check (list-ec (:string c "1") c) => '(#\1))
  (my-check (list-ec (:string c "123") c) => '(#\1 #\2 #\3))
  (my-check (list-ec (:string c "1" "2") c) => '(#\1 #\2))
  (my-check (list-ec (:string c "1" "2" "3") c) => '(#\1 #\2 #\3))
  
  (my-check (list-ec (:vector x (vector)) x) => '())
  (my-check (list-ec (:vector x (vector 1)) x) => '(1))
  (my-check (list-ec (:vector x (vector 1 2 3)) x) => '(1 2 3))
  (my-check (list-ec (:vector x (vector 1) (vector 2)) x) => '(1 2))
  (my-check 
   (list-ec (:vector x (vector 1) (vector 2) (vector 3)) x)
   => '(1 2 3))
  
  (my-check (list-ec (:range x -2) x) => '())
  (my-check (list-ec (:range x -1) x) => '())
  (my-check (list-ec (:range x  0) x) => '())
  (my-check (list-ec (:range x  1) x) => '(0))
  (my-check (list-ec (:range x  2) x) => '(0 1))
  
  (my-check (list-ec (:range x  0  3) x) => '(0 1 2))
  (my-check (list-ec (:range x  1  3) x) => '(1 2))
  (my-check (list-ec (:range x -2 -1) x) => '(-2))
  (my-check (list-ec (:range x -2 -2) x) => '())
  
  (my-check (list-ec (:range x 1 5  2) x) => '(1 3))
  (my-check (list-ec (:range x 1 6  2) x) => '(1 3 5))
  (my-check (list-ec (:range x 5 1 -2) x) => '(5 3))
  (my-check (list-ec (:range x 6 1 -2) x) => '(6 4 2))
  
  (my-check (list-ec (:real-range x 0.0 3.0)     x) => '(0. 1. 2.))
  (my-check (list-ec (:real-range x 0   3.0)     x) => '(0. 1. 2.))
  (my-check (list-ec (:real-range x 0   3   1.0) x) => '(0. 1. 2.))
  
  (my-check 
   (string-ec (:char-range c #\a #\z) c) 
   => "abcdefghijklmnopqrstuvwxyz" )
  
  (my-check 
   (begin
     (let ((f (my-open-output-file "tmp1")))
       (do-ec (:range n 10) (begin (write n f) (newline f)))
       (close-output-port f))
     (my-call-with-input-file "tmp1"
       (lambda (port) (list-ec (:port x port read) x)) ))
   => (list-ec (:range n 10) n) )
  
  (my-check 
   (begin
     (let ((f (my-open-output-file "tmp1")))
       (do-ec (:range n 10) (begin (write n f) (newline f)))
       (close-output-port f))
     (my-call-with-input-file "tmp1"                 
       (lambda (port) (list-ec (:port x port) x)) ))
   => (list-ec (:range n 10) n) )
  )

; ==========================================================================
; The special generators :do :let :parallel :while :until
; ==========================================================================


(begin
  
  (my-check (list-ec (:do ((i 0)) (< i 4) ((+ i 1))) i) => '(0 1 2 3))
  
  (my-check 
   (list-ec 
    (:do (let ((x 'x)))
         ((i 0)) 
         (< i 4) 
         (let ((j (- 10 i))))
         #t
         ((+ i 1)) )
    j )
   => '(10 9 8 7) )
  
  (my-check (list-ec (:let x 1) x) => '(1))
  (my-check (list-ec (:let x 1) (:let y (+ x 1)) y) => '(2))
  (my-check (list-ec (:let x 1) (:let x (+ x 1)) x) => '(2))
  
  (my-check 
   (list-ec (:parallel (:range i 1 10) (:list x '(a b c))) (list i x))
   => '((1 a) (2 b) (3 c)) )
  
  (my-check 
   (list-ec (:while (:range i 1 10) (< i 5)) i)
   => '(1 2 3 4) )
  
  (my-check 
   (list-ec (:until (:range i 1 10) (>= i 5)) i)
   => '(1 2 3 4 5) )
  
  ; with generator that might use inner bindings
  
  (my-check
   (list-ec (:while (:list i '(1 2 3 4 5 6 7 8 9)) (< i 5)) i)
   => '(1 2 3 4) )
  
  ; Was broken in original reference implementation as pointed
  ; out by sunnan@handgranat.org on 24-Apr-2005 comp.lang.scheme.
  ; Refer to http://groups-beta.google.com/group/comp.lang.scheme/
  ; browse_thread/thread/f5333220eaeeed66/75926634cf31c038#75926634cf31c038
  
  (my-check 
   (list-ec (:until (:list i '(1 2 3 4 5 6 7 8 9)) (>= i 5)) i)
   => '(1 2 3 4 5) )
  
  ; combine :while/:until and :parallel
  
  (my-check
   (list-ec (:while (:parallel (:range i 1 10)
                               (:list j '(1 2 3 4 5 6 7 8 9)))
                    (< i 5))
            (list i j))
   => '((1 1) (2 2) (3 3) (4 4)))
  
  (my-check
   (list-ec (:until (:parallel (:range i 1 10)
                               (:list j '(1 2 3 4 5 6 7 8 9)))
                    (>= i 5))
            (list i j))
   => '((1 1) (2 2) (3 3) (4 4) (5 5)))
  
  ; check that :while/:until really stop the generator
  
  (my-check
   (let ((n 0))
     (do-ec (:while (:range i 1 10) (begin (set! n (+ n 1)) (< i 5)))
            (if #f #f))
     n)
   => 5)
  
  (my-check
   (let ((n 0))
     (do-ec (:until (:range i 1 10) (begin (set! n (+ n 1)) (>= i 5)))
            (if #f #f))
     n)
   => 5)
  
  (my-check
   (let ((n 0))
     (do-ec (:while (:parallel (:range i 1 10)
                               (:do () (begin (set! n (+ n 1)) #t) ()))
                    (< i 5))
            (if #f #f))
     n)
   => 5)
  
  (my-check
   (let ((n 0))
     (do-ec (:until (:parallel (:range i 1 10)
                               (:do () (begin (set! n (+ n 1)) #t) ()))
                    (>= i 5))
            (if #f #f))
     n)
   => 5)
  )

; ==========================================================================
; The dispatching generator
; ==========================================================================

(begin
  
  (my-check (list-ec (: c '(a b)) c) => '(a b))
  (my-check (list-ec (: c '(a b) '(c d)) c) => '(a b c d))
  
  (my-check (list-ec (: c "ab") c) => '(#\a #\b))
  (my-check (list-ec (: c "ab" "cd") c) => '(#\a #\b #\c #\d))
  
  (my-check (list-ec (: c (vector 'a 'b)) c) => '(a b))
  (my-check (list-ec (: c (vector 'a 'b) (vector 'c)) c) => '(a b c))
  
  (my-check (list-ec (: i 0) i) => '())
  (my-check (list-ec (: i 1) i) => '(0))
  (my-check (list-ec (: i 10) i) => '(0 1 2 3 4 5 6 7 8 9))
  (my-check (list-ec (: i 1 2) i) => '(1))
  (my-check (list-ec (: i 1 2 3) i) => '(1))
  (my-check (list-ec (: i 1 9 3) i) => '(1 4 7))
  
  ; NOTE: The original (lib "42.ss" "srfi") also fails here
  ;       0.6000000000000001 is returned instead of 0.6
  #;(my-check (list-ec (: i 0.0 1.0 0.2) i) => '(0. 0.2 0.4 0.6 0.8))
  
  (my-check (list-ec (: c #\a #\c) c) => '(#\a #\b #\c))
  
  (my-check 
   (begin
     (let ((f (my-open-output-file "tmp1")))
       (do-ec (:range n 10) (begin (write n f) (newline f)))
       (close-output-port f))
     (my-call-with-input-file "tmp1"                 
       (lambda (port) (list-ec (: x port read) x)) ))
   => (list-ec (:range n 10) n) )
  
  (my-check 
   (begin
     (let ((f (my-open-output-file "tmp1")))
       (do-ec (:range n 10) (begin (write n f) (newline f)))
       (close-output-port f))
     (my-call-with-input-file "tmp1"                 
       (lambda (port) (list-ec (: x port) x)) ))
   => (list-ec (:range n 10) n) )
  
  )
; ==========================================================================
; With index variable
; ==========================================================================

(begin
  (my-check (list-ec (:list c (index i) '(a b)) (list c i)) => '((a 0) (b 1)))
  (my-check (list-ec (:string c (index i) "a") (list c i)) => '((#\a 0)))
  (my-check (list-ec (:vector c (index i) (vector 'a)) (list c i)) => '((a 0)))
  
  (my-check 
   (list-ec (:range i (index j) 0 -3 -1) (list i j)) 
   => '((0 0) (-1 1) (-2 2)) )
  
  ; TODO: This test fails also in (lib "42.ss" "srfi").
  ;       Again 0.6000000...01 is returned instead of 0.6
  #;(my-check 
     (list-ec (:real-range i (index j) 0 1 0.2) (list i j)) 
     => '((0. 0) (0.2 1) (0.4 2) (0.6 3) (0.8 4)) )
  
  (my-check 
   (list-ec (:char-range c (index i) #\a #\c) (list c i)) 
   => '((#\a 0) (#\b 1) (#\c 2)) )
  
  (my-check 
   (list-ec (: x (index i) '(a b c d)) (list x i))
   => '((a 0) (b 1) (c 2) (d 3)) )
  
  (my-check 
   (begin
     (let ((f (my-open-output-file "tmp1")))
       (do-ec (:range n 10) (begin (write n f) (newline f)))
       (close-output-port f))
     (my-call-with-input-file "tmp1"
       (lambda (port) (list-ec (: x (index i) port) (list x i))) ))
   => '((0 0) (1 1) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9)) )
  
  
  ; ==========================================================================
  ; The examples from the SRFI document
  ; ==========================================================================
  
  ; from Abstract
  
  (my-check (list-ec (: i 5) (* i i)) => '(0 1 4 9 16))
  
  (my-check 
   (list-ec (: n 1 4) (: i n) (list n i)) 
   => '((1 0) (2 0) (2 1) (3 0) (3 1) (3 2)) )
  
  ; from Generators
  
  (my-check 
   (list-ec (: x (index i) "abc") (list x i)) 
   => '((#\a 0) (#\b 1) (#\c 2)) )
  
  (my-check
   (list-ec (:string c (index i) "a" "b") (cons c i))
   => '((#\a . 0) (#\b . 1)) )
  
  
  ; ==========================================================================
  ; Little Shop of Horrors
  ; ==========================================================================
  
  (my-check (list-ec (:range x 5) (:range x x) x) => '(0 0 1 0 1 2 0 1 2 3))
  
  (my-check (list-ec (:list x '(2 "23" (4))) (: y x) y) => '(0 1 #\2 #\3 4))
  
  ; TODO: fix it -  scope - see docs on :parallel
  #;(my-check 
     (list-ec (:parallel (:integers x) 
                         (:do ((i 10)) (< x i) ((- i 1))))
              (list x i))
     => '((0 10) (1 9) (2 8) (3 7) (4 6)) )
  
  
  ; ==========================================================================
  ; Less artificial examples
  ; ==========================================================================
  
  (define (factorial n) ; n * (n-1) * .. * 1 for n >= 0
    (product-ec (:range k 2 (+ n 1)) k) )
  
  (my-check (factorial  0) => 1)
  (my-check (factorial  1) => 1)
  (my-check (factorial  3) => 6)
  (my-check (factorial  5) => 120)
  
  
  (define (eratosthenes n) ; primes in {2..n-1} for n >= 1
    (let ((p? (make-string n #\1)))
      (do-ec (:range k 2 n)
             (if (char=? (string-ref p? k) #\1))
             (:range i (* 2 k) n k)
             (string-set! p? i #\0) )
      (list-ec (:range k 2 n) (if (char=? (string-ref p? k) #\1)) k) ))
  
  (my-check 
   (eratosthenes 50)
   => '(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47) )
  
  (my-check
   (length (eratosthenes 100000))
   => 9592 ) ; we expect 10^5/ln(10^5)
  
  
  (define (pythagoras n) ; a, b, c s.t. 1 <= a <= b <= c <= n, a^2 + b^2 = c^2
    (list-ec 
     (:let sqr-n (* n n))
     (:range a 1 (+ n 1))
     ; (begin (display a) (display " "))
     (:let sqr-a (* a a))
     (:range b a (+ n 1)) 
     (:let sqr-c (+ sqr-a (* b b)))
     (if (<= sqr-c sqr-n))
     (:range c b (+ n 1))
     (if (= (* c c) sqr-c))
     (list a b c) ))
  
  (my-check
   (pythagoras 15)
   => '((3 4 5) (5 12 13) (6 8 10) (9 12 15)) )
  
  (my-check
   (length (pythagoras 200))
   => 127 )
  
  
  (define (qsort xs) ; stable
    (if (null? xs)
        '()
        (let ((pivot (car xs)) (xrest (cdr xs)))
          (append
           (qsort (list-ec (:list x xrest) (if (<  x pivot)) x))
           (list pivot)
           (qsort (list-ec (:list x xrest) (if (>= x pivot)) x)) ))))
  
  (my-check 
   (qsort '(1 5 4 2 4 5 3 2 1 3))
   => '(1 1 2 2 3 3 4 4 5 5) )
  
  
  (define (pi-BBP m) ; approx. of pi within 16^-m (Bailey-Borwein-Plouffe)
    (sum-ec 
     (:range n 0 (+ m 1))
     (:let n8 (* 8 n))
     (* (- (/ 4 (+ n8 1))
           (+ (/ 2 (+ n8 4))
              (/ 1 (+ n8 5))
              (/ 1 (+ n8 6))))
        (/ 1 (expt 16 n)) )))
  
  (my-check
   (pi-BBP 5)
   => (/ 40413742330349316707 12864093722915635200) )
  
  
  (define (read-line port) ; next line (incl. #\newline) of port
    (let ((line
           (string-ec 
            (:until (:port c port read-char)
                    (char=? c #\newline) )
            c )))
      (if (string=? line "")
          (read-char port) ; eof-object
          line )))
  
  (define (read-lines filename) ; list of all lines
    (my-call-with-input-file 
        filename
      (lambda (port)
        (list-ec (:port line port read-line) line) )))
  
  (my-check
   (begin
     (let ((f (my-open-output-file "tmp1")))
       (do-ec (:range n 10) (begin (write n f) (newline f)))
       (close-output-port f))
     (read-lines "tmp1") )
   => (list-ec (:char-range c #\0 #\9) (string c #\newline)) )
  
  )

;;;
;;; REPORT
;;;

(check-report)


;;;
;;; A BONUS EXAMPLE
;;;

(define prime?
  (let ()
    (define N 10000)                       ; cached small primes
    (define primes (make-vector N #t))    ; n prime <=> (vector-ref primes n)
    (vector-set! primes 0 #f)
    (vector-set! primes 1 #f)
    (do-ec (:range n 2 N)                 ; sieve of Eratosthenes
           (if (vector-ref primes n))
           (:range i (+ n n) N n)
           (vector-set! primes i #f))
    (lambda (n)
      (cond
        [(< n 0) #f]
        [(< n N) (vector-ref primes n)]
        [else    (let ([no-small-factor?
                        (every?-ec (:let sqrt-n (integer-sqrt n))
                                   (:while (:vector p-prime? (index p) primes)
                                           (<= p sqrt-n))
                                   (if p-prime?)
                                   (not (zero? (remainder n p))))])
                   (and no-small-factor?
                        (or (< (sqrt n) N)
                            ; large factors?
                            (every?-ec (:let sqrt-n (+ (integer-sqrt n) 1))
                                       (:range f (if (even? N) (+ N 1) N) sqrt-n 2)
                                       (not (zero? (remainder n f)))))))]))))

(define (next-prime n)
  ; find first prime larger than n
  (cond
    [(< n 2)                      2]
    [(= n 2)                      3]
    [(and (even? n) 
          (not (prime? (+ n 1)))  (next-prime (+ n 1)))]
    [(even? n)                    (+ n 1)]
    [else                         (first-ec 'never-used
                                            (:range m (+ n 2) (* 2 n) 2) ; Chebyshev's Theorem says (* 2 n) okay
                                            (if (prime? m))
                                            m)]))

(define-generator (:primes stx)
  (syntax-case stx (index)
    [(_ n (index i) . more)
     (add-index stx #'(_ n . more) #'i)]
    [(_ n)
     #'(:iterate n 2 next-prime (lambda (n) #f))]
    [(_ n from)
     #'(:iterate n from next-prime (lambda (n) #f))]
    [(_ n from to)
     #'(:iterate n from next-prime (let ([t to]) (lambda (n) (> n t))))]
    [_
     (raise-syntax-error 
      ':primes
      "expected (:primes from to), where from and to is optional"
      stx)]))


; (list-ec (:iterate n 2 next-prime (lambda (n) (> n 100)))
;         n)

; (sum-ec (:primes p 2 (expt 10 4))
;        p)

(require mzscheme)

; Project Euler Problem 60

(define (number-append x y)
  (string->number
   (string-append
    (number->string x) (number->string y))))
(define N 10000)

#;(first-ec 'not-found
          (:primes a 3 N)
          (:primes b (next-prime a) N)
          (if (and (prime? (number-append a b))
                   (prime? (number-append b a))))
          (:primes c (next-prime b) N)
          (if (and (prime? (number-append a c))
                   (prime? (number-append c a))
                   (prime? (number-append b c))
                   (prime? (number-append c b))))
          (:primes d (next-prime c) N)
          (if (and (prime? (number-append a d))
                   (prime? (number-append d a))
                   (prime? (number-append b d))
                   (prime? (number-append d b))
                   (prime? (number-append c d))
                   (prime? (number-append d c))))
          (:primes e (next-prime d) N)
          (if (and (prime? (number-append a e))
                   (prime? (number-append e a))
                   (prime? (number-append b e))
                   (prime? (number-append e b))
                   (prime? (number-append c e))
                   (prime? (number-append e c))
                   (prime? (number-append d e))
                   (prime? (number-append e d))))
          (list a b c d e))