;(require-library simple-tests) ; generics)
;(load "generics.scm") ; remove after compile
(require-library simple-tests generics)

(import generics generic-helpers simple-tests)

(define-test (Generic-helpers)
  (check
    (equal?
      (receive (rhead tail)
        (rsplit-with odd? '(1 3 5 2 4 6))
        (list rhead tail))
      '(() (1 3 5 2 4 6)))
    (equal?
      (receive (rhead tail)
        (rsplit-with even? '(1 3 5 2 4 6))
        (list rhead tail))
      '((5 3 1) (2 4 6)))
    (equal?
      (receive (rhead tail)
        (rsplit-at 3 '(0 1 2 3 4 5 6))
        (list rhead tail))
      '((2 1 0) (3 4 5 6)))
    (equal?
      (reverse* '(10 20 30) '(1 2 3 4 5))
      '(30 20 10 1 2 3 4 5))
    (equal?
      (reverse* '(10 20 30) '(1 2 3 4 5) list)
      '(30 (20 (10 (1 2 3 4 5)))))
    (equal?
      (reverse* '(10 20 30) '0 list)
      '(30 (20 (10 . 0))))
    (equal?
      (reverse* '(10 20 30) '(0 . 1) list)
      '(30 (20 (10 (0 . 1)))))
    (equal?
      (reverse* '(10 20 30) '((0 . 1) (0 . 2)) list)
      '(30 (20 (10 (0 . 1) (0 . 2)))))
    (equal?
      (map* add1 '(0 (1 (2 . 3)))) 
      '(1 (2 (3 . 4))))
    (equal?
      (map* add1 '(0 (1 (2) 3) 4)) 
      '(1 (2 (3) 4) 5))
    (equal? (map* add1 '(0 1 2)) '(1 2 3))
    (= (map* add1 0) 1)
    (= ((repeat 3 add1) 0) 3)
    (equal? ((repeat 2 cdr) '(0 1 2 3)) '(2 3))
    (equal?
      (map (named-lambda (! n) (if (zero? n) 1 (* n (! (- n 1)))))
           '(1 2 3 4 5))
      '(1 2 6 24 120))
    (eq? (proc-name
           (named-lambda (! n) (if (zero? n) 1 (* n (! (- n 1))))))
         '!)
    (eq? (proc-name number?) 'number?)
    (eq? (proc-name +) 'C_plus)
  ))

(define-test (Selectors)
  (check
    (define-selector number?? number? any??)
    (define-selector integer?? integer? number??)
    (define-selector fixnum?? fixnum? integer??)

    (define-selector vector?? vector? any??)
    (define-selector string?? string? vector??)
    (define-selector list?? list? string??)

    (define-selector 0<=?? 0<= any??)

    (selector? fixnum??)
    (equal? (selector-parents fixnum??)
            `(,integer?? ,number?? ,generics#any??))
    (eq? (0<=??) any??)
    ))

(define-test (Trees)
  (check
    (define item (method-tree-item + number??))
    (method-tree-item? item)
    (equal? item `(,number?? . ,+))
    (method-tree? (list item))
    (fx= (method-tree-depth (list item)) 1)

    (set! item (method-tree-item string-append string?? string??))
    (method-tree-item? item)
    (equal? item `(,string?? (,string?? . ,string-append)))
    (method-tree? (list item))
    (fx= (method-tree-depth (list item)) 2)
    (equal? (cadr item) `(,string?? . ,string-append))
    (eq? (cdadr item) string-append)

    ;(define tree (list (method-tree-item default none?? none??)))
    (define tree
            (list(method-tree-item append list?? list??)))
    ;(set! tree
    ;      (method-tree-insert tree
    ;                          (method-tree-item append list?? list??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item string-append
                                                string??
                                                string??)))
    (set! tree
          (method-tree-insert tree 
                              (method-tree-item + number??  number??)))
    (method-tree? tree)
    (fx= (method-tree-depth tree) 2)
    (equal? (method-tree-show tree)
            '((list?? (list?? . append))
              (string?? (string?? . string-append))
              (number?? (number?? . C_plus))
              ))
    (ppp (method-tree-show tree))
    (eq? (method-tree-dispatch tree '() '()) append)
    (eq? (method-tree-dispatch tree #t #t) #f)
    (eq? (method-tree-dispatch tree 0 0) +)
    (eq? (method-tree-dispatch tree "" "") string-append)
    (eq? (method-tree-dispatch tree '() 0) #f)
    (eq? (method-tree-dispatch tree 0 '()) #f)
    (eq? (method-tree-dispatch tree 0 "") #f)

    (define (fn+ x y) (+ x y))
    (define (nf+ x y) (+ x y))
    (define (nn+ x y) (+ x y))
    (set! tree
          (list (method-tree-item fx+ fixnum?? fixnum??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item fn+ fixnum?? number??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item nf+ number?? fixnum??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item nn+ number?? number??)))
    (method-tree? tree)
    (fx= (method-tree-depth tree) 2)
    (equal? (method-tree-show tree)
            '((fixnum?? (fixnum?? . fx+)
                        (number?? . fn+))
              (number?? (fixnum?? . nf+)
                        (number?? . nn+))))
    (eq? (method-tree-dispatch tree 0.0 0.0) nn+)
    (eq? (method-tree-dispatch tree 0 0.0) fn+)
    (eq? (method-tree-dispatch tree 0.0 0) nf+)
    (eq? (method-tree-dispatch tree 0 0) fx+)
    (not (method-tree-dispatch tree #f 0))
    (not (method-tree-dispatch tree 0 #f))
    (not (method-tree-dispatch tree #f #f))

    (define-values (fff+ ffn+ fnf+ fnn+ nff+ nfn+ nnf+ nnn+)
      (values mfx+ + + + + + + +))
    (define otree `((,fixnum?? (,fixnum?? (,fixnum?? . ,fff+)
                                          (,number?? . ,ffn+))
                               (,number?? (,fixnum?? . ,fnf+)
                                          (,number?? . ,fnn+)))
                    (,number?? (,fixnum?? (,fixnum?? . ,nff+)
                                          (,number?? . ,nfn+))
                               (,number?? (,fixnum?? . ,nnf+)
                                          (,number?? . ,nnn+)))))
    (set! tree
          (list (method-tree-item nnn+ number?? number?? number??)))
    ;(set! tree
    ;      (list (method-tree-item fff+ fixnum?? fixnum??  fixnum??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item fff+
                                                fixnum??
                                                fixnum??
                                                fixnum??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item ffn+
                                                fixnum??
                                                fixnum??
                                                number??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item fnf+
                                                fixnum??
                                                number??
                                                fixnum??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item fnn+
                                                fixnum??
                                                number??
                                                number??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item nff+
                                                number?? 
                                                fixnum??
                                                fixnum??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item nfn+
                                                number??
                                                fixnum??
                                                number??)))
    (set! tree
          (method-tree-insert tree
                              (method-tree-item nnf+
                                                number??
                                                number??
                                                fixnum??)))
    (method-tree? tree)
    (fx= (method-tree-depth tree) 3)
    (equal? tree otree)
    (eq? (method-tree-dispatch tree 0 0 0) fff+)
    (eq? (method-tree-dispatch tree 0.0 0 0) nff+)
    (eq? (method-tree-dispatch tree 0 0 0.0) ffn+)
    (eq? (method-tree-dispatch tree 0 0.0 0.0) fnn+)
    (eq? (method-tree-dispatch tree 0 0.0 0) fnf+)
    (eq? (method-tree-dispatch tree 0.0 0.0 0.0) nnn+)
    ;; override nnn+ with +
    (set! tree
          (method-tree-insert tree
                              (method-tree-item + number?? number??
                                           number??)))
    (eq? (method-tree-dispatch tree 0.0 0.0 0.0) +)
    (not (method-tree-dispatch tree 0 0 #f))
    (not (method-tree-dispatch tree 0 #f #f))
    (not (method-tree-dispatch tree #f 0 0))
    (not (method-tree-dispatch tree 0.0 0.0 #f))
    (not (method-tree-dispatch tree 0.0 0 #f))
    (not (method-tree-dispatch tree 0.0 #f 0.0))
    
    ))

(define-test (Generics)
  (check
    (define-generic (Add (x number??) (y number??)) (+ x y))
    (define-method  (Add (x fixnum??) (y fixnum??)) (fx+ x y))
    (generic? Add)
    (not (generic-variadic? Add))
    (fx= (generic-arity Add) 2)
    (= (Add 1 2.0) 3.0)
    (fx= (Add 1 2) 3)
    (not (condition-case (Add 1) ((exn) #f)))
    (not (condition-case (Add 1 #f) ((exn) #f)))

    (define-generic (At (k 0<=??) (seq list??)) (list-ref seq k))
    (define-generic (Drop (k 0<=??) (seq list??)) (list-tail seq k))
    (define-generic (Take (k 0<=??) (seq list??))
                    ;(compress (make-list k #t) seq))
                    (let loop ((n 0) (lst seq) (result '()))
                      (if (fx= n k)
                        (reverse result)
                        (loop (1+ n)
                              (cdr lst)
                              (cons (car lst) result)))))
    (define seq '(0 1 2 3 4))
    (= (At 2 seq) 2)
    (equal? (Drop 2 seq) '(2 3 4))
    (equal? (Take 2 seq) '(0 1))
    (generic? At)
    (not (generic-variadic? At))
    (= (generic-arity At) 2)
    (define-method (At (k 0<=??) (seq vector??)) (vector-ref seq k))
    (define-method (Drop (k 0<=??) (seq vector??)) (subvector seq k))
    (define-method (Take (k 0<=??) (seq vector??)) (subvector seq 0 k))
    (define-method (At (k 0<=??) (seq string??)) (string-ref seq k))
    (define-method (Drop (k 0<=??) (seq string??)) (substring seq k))
    (define-method (Take (k 0<=??) (seq string??)) (substring seq 0 k))
    (not (generic-variadic? At))
    (fx= (generic-arity Take) 2)
    (string=? (Drop 2 "abcde") "cde")
    (fx= (At 2 seq) 2)
    (equal? (Take 2 #(0 1 2 3 4)) #(0 1))

    (define-generic (Add* xs number??) (apply + xs))
    (define-method (Add* xs list??) (apply append xs))
    (fx= (Add* 1 2 3) 6)
    (equal? (Add* '(1) '(2) '(3)) '(1 2 3))
    (define-method (Add* xs string??) (apply string-append xs))
    (string=? (Add* "1" "2" "3") "123")
    (not (condition-case (Add* 1 #f 3) ((exn) #f)))
    (generic? Add*)
    (generic-variadic? Add*)
    (fx= (generic-arity Add*) 1)
    ))

(compound-test (GENERICS)
  (Generic-helpers)
  (Selectors)
  (Trees)
  (Generics)
  )