(import callable-sequences)

(import (chicken condition) simple-tests arrays)

(define-checks
  (flat-access
    verbose?
    pls
    (make-callable '(0 1 2 3 4 5 . 6))
    lst
    (make-callable '(0 1 2 3 4 5))
    vec
    (make-callable #(0 1 2 3 4 5))
    str
    (make-callable "012345"))
  (callable-length pls)
  6
  (callable-length lst)
  6
  (callable-length str)
  6
  (callable-length vec)
  6
  (callable-null? str)
  #f
  (callable-flat? vec)
  #t
  (lst 0)
  0
  (lst 3)
  3
  (vec 3)
  3
  (str 3)
  #\3
  (lst 5)
  5
  (condition-case (lst (callable-length lst)) ((exn) #f))
  #f
  (condition-case (vec (callable-length vec)) ((exn) #f))
  #f
  (condition-case (str (callable-length str)) ((exn) #f))
  #f
  (callable-data (lst 2 4))
  '(2 3)
  (callable-data (lst 0 3))
  '(0 1 2)
  (callable-length (lst 0 3))
  3
  (callable-data (pls 0 3))
  '(0 1 2 . 6)
  ((pls 0 0))
  6
  (callable-data (pls 0 0))
  6
  (callable-null? (pls 3 3))
  #t
  (callable-null? (vec 1 2))
  #f
  (callable-data (pls 3 0))
  '(3 2 1 . 6)
  (callable-data (vec 0 3))
  #(0 1 2)
  (callable-data (str 0 3))
  "012"
  (callable-data (lst 3 0))
  '(3 2 1)
  (callable-data (vec 3 0))
  #(3 2 1)
  (callable-data (str 3 0))
  "321"
  (callable-data (pls 0 #f))
  '(0 1 2 3 4 5 . 6)
  (callable-data (pls 0 (callable-length pls)))
  '(0 1 2 3 4 5 . 6)
  (callable-data (lst 0 6))
  '(0 1 2 3 4 5)
  (callable-data (vec 0 #f))
  #(0 1 2 3 4 5)
  (callable-data (str 0 #f))
  "012345"
  (condition-case (lst 0 7) ((exn) #f))
  #f
  (condition-case (vec 0 7) ((exn) #f))
  #f
  (condition-case (str 0 7) ((exn) #f))
  #f
  (callable-data (lst 0 #f))
  '(0 1 2 3 4 5)
  (callable-data (vec 0 #f))
  #(0 1 2 3 4 5)
  (callable-data (str 0 #f))
  "012345"
  (callable-data (lst #f -1))
  '(5 4 3 2 1 0)
  (callable-data (lst (- (callable-length lst) 1) -1))
  '(5 4 3 2 1 0)
  (callable-data (callable-reverse lst))
  '(5 4 3 2 1 0)
  (callable-data (vec #f -1))
  #(5 4 3 2 1 0)
  (callable-data (vec (- (callable-length vec) 1) -1))
  #(5 4 3 2 1 0)
  (callable-data (vec #f -1))
  #(5 4 3 2 1 0)
  (callable-data (str #f -1))
  "543210"
  (callable-data (str (- (callable-length str) 1) -1))
  "543210"
  (callable-data (lst 3 1))
  '(3 2)
  (callable-data (vec 3 1))
  #(3 2)
  (callable-data (str 3 1))
  "32"
  (callable? str)
  #t
  (callable-sas? lst)
  #t
  (callable-ras? lst)
  #f
  (callable? lst)
  #t
  (callable? vec)
  #t
  (callable? (lst 1 4))
  #t
  (callable? (vec 1 4))
  #t
  (callable-ras? (str 1 4))
  #t
  (callable-sas? (str 1 4))
  #f
  (callable? (str 1 4))
  #t
  (callable? car)
  #f
  (callable? '(0 1 2 3))
  #f
  (callable? #(0 1 2 3))
  #f
  (sequence? #(0 1 2 3))
  #t
  (callable? "0123")
  #f
  (sequence? "0123")
  #t
  (sequence? #f)
  #f)

(define-checks
  (flat-operations
    verbose?
    pls
    (make-callable '(0 1 2 3 4 5 . 6))
    lst
    (make-callable '(0 1 2 3 4 5))
    vec
    (make-callable #(0 1 2 3 4 5))
    str
    (make-callable "012345"))
  (callable? pls)
  #t
  (callable? '())
  #f
  (callable-null? vec)
  #f
  (callable-null? (callable-nil vec))
  #t
  (callable-flat? vec)
  #t
  (callable-data (callable-nil vec))
  #()
  (callable-nil pls)
  6
  (callable-data (callable-reverse lst lst))
  '(5 4 3 2 1 0 0 1 2 3 4 5)
  (callable-data (callable-reverse str str))
  "543210012345"
  (callable-data (callable-reverse str))
  "543210"
  (callable-indices even? vec)
  '(0 2 4)
  (callable-indices odd? pls)
  '(1 3 5)
  (callable-data (callable-copy lst))
  '(0 1 2 3 4 5)
  (callable-data (callable-copy vec))
  #(0 1 2 3 4 5)
  (callable-data (callable-map add1 vec))
  #(1 2 3 4 5 6)
  (callable-data (callable-map add1 pls))
  '(1 2 3 4 5 6 . 6)
  (callable-for-each print vec)
  (if #f #f)
  (callable-data (callable-filter odd? vec))
  #(1 3 5)
  (receive (yes no) (callable-filter odd? vec) (list (yes) (no)))
  '(#(1 3 5) #(0 2 4))
  (callable-data (callable-append str str str))
  "012345012345012345"
  (callable-data (callable-append str str str str))
  "012345012345012345012345")

(define-checks
  (nested-access
    verbose?
    pl*
    (make-callable* '(a (b . c)))
    ls*
    (make-callable* '(a (b c)))
    lv*
    (make-callable* '(a #(b c)))
    vp*
    (make-callable* (vector 'a '(b . c)))
    vs*
    (make-callable* (vector 'a "bc"))
    lv**
    (make-callable* '(a (b #(c d) e) f))
    ls**
    (make-callable* '(a (b (c) d) e))
    ns**
    (make-callable* '(0 (1 #(2) 3) 4)))
  (callable-data* pl*)
  '(a (b . c))
  (callable-data* lv**)
  '(a (b #(c d) e) f)
  (callable-data* ns**)
  '(0 (1 #(2) 3) 4)
  (callable-data* (callable-map* add1 ns**))
  '(1 (2 #(3) 4) 5)
  (ls* 0)
  'a
  ((ls* 1) 1)
  'c
  (callable-data ((ls* 1) 2 #f))
  '()
  (callable? ((ls* 1) 1 2))
  #t
  (callable-data ((ls* 1) 1 2))
  '(c)
  (callable? pl*)
  #t
  (callable-data (pl* 1))
  '(b . c)
  (callable? (pl* 1))
  #t
  ((pl* 1) 0)
  'b
  (callable? ((pl* 1) 1 #f))
  #t
  (((pl* 1) 1 #f))
  'c
  (callable-data ((pl* 1) 1 #f))
  'c
  ((lv* 1) 1)
  'c
  (callable-data ((lv* 1) 1 2))
  #(c)
  ((vp* 1) 0)
  'b
  (callable? (vp* 1))
  #t
  (callable? ((vp* 1) 1 #f))
  #t
  (((vp* 1) 1 #f))
  'c
  (callable-data ((vp* 1) 1 #f))
  'c
  ((vs* 1) 0)
  #\b
  ((vs* 1) 1)
  #\c
  (callable-data ((vs* 1) 2 #f))
  ""
  (lv** 0)
  'a
  ((lv** 1) 0)
  'b
  (((lv** 1) 1) 0)
  'c
  (((lv** 1) 1) 1)
  'd
  (lv** 2)
  'f
  ((lv** 1) 2)
  'e)

(define-checks
  (new-types verbose?)
  ((sequence-constructors 'ras)
   array?
   (lambda (k)
     (apply array
            (let loop ((i 0) (result '()))
              (if (= i k) result (loop (+ i 1) (cons #f result))))))
   (lambda (arr k) (array-at k arr))
   (lambda (arr k new) (array-update! k new arr))
   array-length)
  (if #f #f)
  (sequence? (make-array))
  #t
  (set! arr (make-callable (array 0 1 2 3)))
  (if #f #f)
  (arr 2)
  2
  (array-equal? (callable-data (arr 1 3)) (array 1 2))
  #t
  (array-equal? (callable-data (arr 3 #f)) (array 3))
  #t
  (array-equal? (callable-data (arr 3 1)) (array 3 2))
  #t
  (set! va* (make-callable* (vector 0 (array 1 2 3))))
  (if #f #f)
  (set! mva* (callable-map* add1 va*))
  (if #f #f)
  (mva* 0)
  1
  ((mva* 1) 0)
  2
  (array-equal? (callable-data (mva* 1)) (array 2 3 4))
  #t
  (sequence-constructors)
  (if #f #f)
  (sequence? (make-array))
  #f)

(newline)

(newline)

(define-checks
  (collect? verbose?)
  ((callable-collect (add1 x) (x (make-callable '(0 1 2 3)))))
  '(1 2 3 4)
  ((callable-collect (add1 x) (x (make-callable '(0 1 2 3)))))
  '(1 2 3 4)
  ((callable-collect x (x (make-callable '(0 1 2 3 4 5)) (odd? x))))
  '(1 3 5)
  ((callable-collect x (x (make-callable '(0 1 2 3 4 5)) (odd? x))))
  '(1 3 5)
  ((callable-collect
     (* 10 n)
     (n (make-callable '(0 1 2 3 4 5)) (positive? n) (even? n))))
  '(20 40)
  ((callable-collect
     (list c k)
     (c (make-callable '(A B C)))
     (k (make-callable '(1 2 3 4)))))
  '((A 1) (A 2) (A 3) (A 4) (B 1) (B 2) (B 3) (B 4) (C 1) (C 2) (C 3) (C 4)))

(collect?)

(check-all CALLABLE-SEQUENCES
  (flat-access)
  (flat-operations)
  (nested-access)
  (new-types)
  (collect?)
  )