(require-library cells simple-tests datatype typed-lists)
(import list-functor set-functor simple-tests datatype)

;;;;;; test untyped modules

(define-test (immutable-lists?)
  (check
    (import cells
            immutable-lists)
    (define nil (ilist-null))
    (ilist? nil)
    (ilist-null? nil)
    (not (null? nil))
    (define nls (ilist-cons 1 nil))
    (ilist? nls)
    nls
    (define nlst (ilist 0 1 (cell 2) 3 4))
    (ilist? nlst)
    (not (list? nlst))
    nlst
    (= (ilist-apply + 1 2 (ilist 3 4 5)) 15)
    (ilist-equal? (ilist-repeat 5 0) (ilist 0 0 0 0 0))
    (ilist-equal? (ilist-iterate 5 add1 0) (ilist 0 1 2 3 4))
    (ilist-equal? (ilist-iterate-while (lambda (x) (< x 5)) add1 0)
                  (ilist 0 1 2 3 4))
    (ilist-equal? (ilist-iterate-until (lambda (x) (= x 5)) add1 0)
                  (ilist 0 1 2 3 4))
    (ilist-equal? (ilist-zip (ilist 1 2 3 4 5) (ilist 10 20 30))
                  (ilist 1 10 2 20 3 30 4 5))
    (receive (even odd) (ilist-unzip (ilist 0 1 2 3 4 5 6 7))
      (and (ilist-equal? even (ilist 0 2 4 6))
           (ilist-equal? odd  (ilist 1 3 5 7))))
    (ilist-equal? (ilist-interpose 10 (ilist 1 2 3 4 5))
                  (ilist 1 10 2 10 3 10 4 10 5))
    (ilist-equal? (ilist-drop 3 nlst) (ilist 3 4))
    (ilist-equal? (ilist-drop-while odd? (ilist 1 3 2 4 5))
             (ilist 2 4 5))
    (ilist-equal? (ilist-take-while odd? (ilist 1 3 2 4 5))
                  (ilist 1 3))
    (receive (head tail) (ilist-split-with even? (ilist 1 3 2 4 5))
      (and (ilist-equal? head (ilist 1 3))
           (ilist-equal? tail (ilist 2 4 5))))
    (ilist-equal? (ilist-take 2 nlst) (ilist 0 1))
    (define nrest (ilist-rest nlst))
    nrest
    (ilist? (ilist-null))
    (ilist-null? (ilist-null))
    (not (ilist-null? nls))
    (not (ilist? '(1 2)))
    (ilist-null? (ilist-rest nls))
    (= (ilist-first nlst) 0)
    (ilist? (ilist-reverse nlst))
    (ilist-reverse nlst)
    (equal? (ilist->list nlst)
            (list 0 1 (cell 2) 3 4))
    (equal? (ilist-item 2 nlst) (cell 2))
    (cell-set! (ilist-item 2 nlst) 20)
    (equal? (ilist-item 2 nlst) (cell 20))
    (= (cell-ref (ilist-item 2 nlst)) 20)
    (= (ilist-length nlst) 5)
    (ilist-equal? (ilist-from-upto 2 4 nlst)
                  (ilist (cell 20) 3))
    (ilist-equal?  (ilist-append (ilist 0 1 2 3)
                                 (ilist 4 5 6))
                   (ilist 0 1 2 3 4 5 6))
    (ilist-equal? (ilist-append
                    (ilist 0)
                    (ilist 1)
                    (ilist 2)
                    (ilist 3 4)
                    (ilist 5 6 7)
                    (ilist 8))
                  (ilist 0 1 2 3 4 5 6 7 8))
    (ilist-equal? (ilist-map add1
                             (ilist 0 1 2 3))
                  (ilist 1 2 3 4))
    (ilist-equal? (ilist-map +
                             (ilist 1 2 3)
                             (ilist 10 20 30 40))
                  (ilist 11 22 33))
    (ilist-equal?
      (ilist-mappend ilist (ilist 10 20 30) (ilist 1 2 3 4 5))
      (ilist 10 1 20 2 30 3))
    (ilist-equal?
      (ilist-fold-right ilist-cons (ilist-null) (ilist 0 1 2 3 4))
      (ilist 0 1 2 3 4))
    (ilist-equal?
      (ilist-fold-right ilist-cons (ilist 0 1 2) (ilist 3 4))
      (ilist 3 4 0 1 2))
    (= (ilist-fold-right * 1 (ilist 1 2 3 4 5)) 120)
    (= (ilist-fold-left * 1 (ilist 1 2 3 4 5)) 120)
    (= (ilist-fold-left + 0 (ilist 1 2 3) (ilist 10 20 30)) 66)
    (equal? (ilist-fold-left cons '(100) (ilist 1 2 3 4))
            '(((((100) . 1) . 2) . 3) . 4))
    (equal?
      (call-with-values
        (lambda () (ilist-reverse (ilist 1 2 3) (ilist 10 20 30)))
        list)
      (list (ilist 3 2 1) (ilist 30 20 10)))
    (ilist-equal? (ilist-remove 0 (ilist 1 0 2 0 3 0 4))
                  (ilist 1 2 3 4))
    (ilist-equal? (ilist-merge < (ilist 2 4 5 7 8) (ilist 1 3 6 9 10))
                  (ilist 1 2 3 4 5 6 7 8 9 10))
    (not (condition-case (ilist-merge < (ilist-null) (ilist 1 3 2))
           ((exn) #f)))
    (ilist-equal? (ilist-merge-sort <= (ilist 2 0 1 4 3))
                  (ilist 0 1 2 3 4))
    (ilist-equal? (ilist-insertion-sort < (ilist 2 0 1 4 3))
                  (ilist 0 1 2 3 4))
    (not (ilist-sorted? <= (ilist 2 0 1 4 3)))
    (ilist-sorted? <= (ilist 0 1 2 3 4))
    (ilist-equal?
      (ilist-insert-sorted <= 2 (ilist 0 1 2 3 4))
      (ilist 0 1 2 2 3 4))
    (ilist-equal?
      (ilist-insert-sorted <= 5 (ilist 0 1 2 3 4))
      (ilist 0 1 2 3 4 5))
    (ilist-every? odd? (ilist 1 3 5))
    (ilist-every? odd? (ilist))
    (= (ilist-some odd? (ilist 2 3 5)) 3)
    (not (ilist-some odd? (ilist 2 4 6)))
    (ilist-not-every? odd? (ilist 1 2 3))
    (ilist-not-any? odd? (ilist 2 4 6))
    (ilist-in? (ilist 2 3) (ilist 1 2 3))
    (not (ilist-in? (ilist 1 2 3) (ilist 2 3)))
    (not (ilist-in? (ilist 1 2 3) (ilist 2 1 3)))
    (ilist-in? (ilist) (ilist 2 3))
    ))

(define-test (sets?)
  (check
    (import sets immutable-lists)
    (set=
      (ilist->set (ilist 1 2 1 3 2 3))
      (set 3 2 1))
    (set? (set 1 2 3))
    (set? (set 1 2 2 3))
    (set= (set 2 1 3) (set 1 2 2 3))
    (set-in? 2 (set 1 1 2 3))
    (set<= (set 2 1 2) (set 4 1 2 3 4))
    (set=
      (set-add 0 (set 1 2 3))
      (set 0 1 2 3))
    (set=
      (set-add 2 (set 1 2 3))
      (set 1 2 3))
    (= (set-cardinality (set 2 1 2 3 2)) 3)
    (set=
      (set-remove 2 (set 2 1 2 3 2))
      (set 1 3))
    (set=
      (set 0 1 1 0 2 3 2)
      (set 2 3 0 1))
    (set=
      (set-difference (set 0 2 1 3) (set 1 1))
      (set 0 2 3))
    (set=
      (set-union (set 1 2) (set 2 3) (set 3 4))
      (set 1 2 3 4))
    (set=
      (set-intersection (set 1 2 3 4) (set 2 3 5) (set 3 4))
      (set 3))
    (set= (set-filter odd? (set 2 1 3 3 1 1)) (set 3 1))
    ))

;;;;;; test functors

(define-test (any-lists?)
  (check
    ;; argument module
    (module any (item? equ?)
      (import scheme)
      (define (item? x) #t)
      (define (equ? x y) (equal? x y))
      )
    ;; apply functor
    (module any-lists = (list-functor any))
    ;; import
    (import (prefix any-lists any-) cells)
    (define als (any-ilist-repeat 3 (cell #f)))
    (any-ilist? als)
    (not (list? als))
    (= (any-ilist-length als) 3)
    (equal? (any-ilist->list (any-ilist-map cell-ref als))
            (make-list 3))
    (define alst (any-ilist (lambda (x) #f) 'a "x" (cell 3) #\z))
    (procedure? (any-ilist-first alst))
    (any-ilist-equal? (any-ilist-memp cell? alst)
                  (any-ilist (cell 3) #\z))
    (any-ilist-equal? (any-ilist-member #\z alst)
             (any-ilist-cons #\z (any-ilist-null)))
    ))


(define-test (string-lists?)
  (check
    (module strings (equ? item?)
      (import scheme)
      (define equ? string=?)
      (define item? string?))
    (module string-lists = (list-functor strings))
    (import (prefix string-lists str-))
    (str-ilist-equal?
      (str-ilist-append (str-ilist "a" "b")
                   (str-ilist "c"))
      (str-ilist "a" "b" "c"))
    ))

(define-test (symbol-lists?)
  (check
    (module symbols (equ? item?)
      (import scheme)
      (define equ? eq?)
      (define item? symbol?))
    (module symbol-lists = (list-functor symbols))
    (import (prefix symbol-lists sym-))
    (sym-ilist-equal?
      (sym-ilist-append (sym-ilist 'a 'b)
                   (sym-ilist 'c))
      (sym-ilist 'a 'b 'c))
    (equal?
      (sym-ilist-bind (x y z) (sym-ilist 'a 'b 'c) (list x y z))
      '(a b c))
    (sym-ilist-equal?
        (sym-ilist-bind (x . y) (sym-ilist 'a 'b 'c) y)
      (sym-ilist 'b 'c))
    (xpr:val
      (sym-ilist-bind (x . y) (sym-ilist 'a 'b) (list x y)))
    (sym-ilist-null? (sym-ilist-bind x (sym-ilist-null) x))
    (sym-ilist-bind () (sym-ilist-null) #t)
    ))

(define-test (list-lists?)
  (check
    (module lists (equ? item?)
      (import scheme
              (only data-structures list-of?)
              (only chicken condition-case))
      (define equ? equal?)
      (define item? (list-of? symbol?)))
    (module list-lists = (list-functor lists))
    (import (prefix list-lists lst-))
    (not (condition-case (lst-ilist-cons '(1) (lst-ilist-null))
           ((exn) #f)))
    (lst-ilist-equal?
      (lst-ilist-append
        (lst-ilist '(a) '(b))
        (lst-ilist '(c)))
      (lst-ilist '(a) '(b) '(c)))
    ))

(define-test (pair-lists?)
  (check
    (module pairs (item? equ?)
      (import scheme)
      (define (item? x)
        (and (pair? x) (number? (car x)) (string? (cdr x))))
      (define equ? equal?))
    (module pair-lists = (list-functor pairs))
    (import (prefix pair-lists nsp-))
    (define nspl (nsp-ilist (cons 1 "one") (cons 2 "two") (cons 3 "three")))
    (equal? (nsp-ilist-assoc 2 nspl) '(2 . "two"))
    (not (nsp-ilist-assp zero? nspl))
    ))

(define-test (num-sets?)
  (check
    ;; argument module
    (module nums (item? equ?)
      (import scheme)
      (define item? number?)
      (define equ? =)
      )
    ;; apply functors
    (module num-lists = (list-functor nums))
    (module num-sets = (set-functor nums num-lists))
    ;; import
    (import (prefix num-lists num-)
            (prefix num-sets num-))
    (num-set=
      (num-ilist->set (num-ilist 1 2 1 3 2 3))
      (num-set 3 2 1))
    (num-set? (num-set 1 2 3))
    (num-set? (num-set 1 2 2 3))
    (num-set= (num-set 2 1 3) (num-set 1 2 2 3))
    (num-set-in? 2 (num-set 1 1 2 3))
    (num-set<= (num-set 2 1 2) (num-set 4 1 2 3 4))
    (num-set=
      (num-set-add 0 (num-set 1 2 3))
      (num-set 0 1 2 3))
    (num-set=
      (num-set-add 2 (num-set 1 2 3))
      (num-set 1 2 3))
    (= (num-set-cardinality (num-set 2 1 2 3 2)) 3)
    (num-set=
      (num-set-remove 2 (num-set 2 1 2 3 2))
      (num-set 1 3))
    (num-set=
      (num-set 0 1 1 0 2 3 2)
      (num-set 2 3 0 1))
    (num-set=
      (num-set-difference (num-set 0 2 1 3) (num-set 1 1))
      (num-set 0 2 3))
    (num-set=
      (num-set-union (num-set 1 2) (num-set 2 3) (num-set 3 4))
      (num-set 1 2 3 4))
    (num-set=
      (num-set-intersection (num-set 1 2 3 4) (num-set 2 3 5) (num-set 3 4))
      (num-set 3))
    (num-set= (num-set-filter odd? (num-set 2 1 3 3 1 1)) (num-set 3 1))
    ))


(compound-test (TYPED-LISTS-AND-SETS)
  (immutable-lists?)
  (sets?)
  (any-lists?)
  (string-lists?)
  (symbol-lists?)
  (list-lists?)
  (pair-lists?)
  (num-sets?)
  )