;;;; bshift-breset+range-test.scm
;;;; Kon Lovett, Apr 6 '06

;
(import utf8)
(import test)

(import (only (chicken format) format) (test-utils gloss))

;;;

(test-begin "Bshift-Breset + Range")

(import bshift-breset range)
(import srfi-1)

;; Generated value saving

(define (make-collector)
  (let ((lst '()))
    (lambda v
      (if (null? v) (reverse! lst)
        (begin
          (set-cdr! v lst)
          (set! lst v))))))

(test-group "bshift/breset"

  (let ((gather (make-collector)))

    (define (fact n) (let loop ((n n)) (if (<= n 0) 1 (* n (loop (- n 1))))))

    (test "step 1" '(1 2 6 24 120)
      (begin
        (breset r
          (gather (fact (range r 1 5))))
        (gather)))
    (set! gather (make-collector))

    (test "step 2" '(1 6 120 5040 362880 39916800 6227020800)
      (begin
        (breset r
          (gather (fact (range r 1 2 14))))
        (gather)))
    (set! gather (make-collector))

    (test "two ranges" '(101 111 121 102 112 122)
      (begin
        (breset r1
          (breset r2 (gather (+ (range r1 1 2) (range r2 100 10 120)))))
        (gather)))
    (set! gather (make-collector))

    (test "collect" 120
      (breset r1
        (breset r2
          (bshift r1 f
            (let ((n (range r2 1 5))
                  (nprev (f #f)))
              (* n (if (range-empty? nprev) 1 nprev)))))))

    (test "range-collect" '(120 120 60 20 5)
      (begin
        (breset r3
          (gather
            (breset r1
              (breset r2
                (bshift r1 f
                  (let ((n (range r2 (range r3 1 5) 5))
                        (nprev (f #f)))
                    (* n (if (range-empty? nprev) 1 nprev))))))))
        (gather)))
    (set! gather (make-collector))

    (test '(11 14 17)
      (begin
        (breset r
          (let* ((k (range r 1 3 9))
                 (j (+ 10 k)))
            (gather j)))
        (gather)))
    (set! gather (make-collector))

    (test '(1 2 3)
      (begin
        (breset out
          (breset r
            (let ((k (range r 1 4)))
              (gather k)
              (when (> k 2)
                (bshift out f #f)))))
        (gather)))
    (set! gather (make-collector))

    (test '((2 10) (2 12) (2 14) (2 16) (2 18) (2 20) (4 10) (4 14) (4 18) (4 22) (4 26) (4 30) (4 34) (4 38))
      (begin
        (breset r
          (let ((k (range r 1 4)))
            (breset inner
              (let ((j (range inner 10 k (* 10 k))))
                (when (odd? k)
                  (bshift r f #f))
                (gather (list k j))))))
        (gather)))
    (set! gather (make-collector)) )

  (test '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
    (cons 'a
      (breset r
        (cons 'b
          (let-values (((x y) (bshift r f (cons 1 (f '2 (f 3 '()))))))
            (cons x y))))))
)

;;;

(test-end "Bshift-Breset + Range")

(test-exit)