; Author: Juergen Lorenz
;         ju (at) jugilo (dot) de


(require-library tuples simple-tests dbc)

(import tuples triples couples singles simple-tests dbc)

(contract-check-level 2)


(compound-test ("TUPLES")
(simple-test ("TUPLES")
  (define tup (tuple 0 1 2 3))
  (equal? (tuple->list tup) '(0 1 2 3))
  (tuple-eql? = tup '#,(tuple 0 1 2 3))
  (tuple-equal? tup (tuple 0 1 2 3))
  (tuple? tup)
  (= (tuple-length tup) 4)
  (= (tuple-ref tup 2) 2)
  (= (tuple-find (lambda (x) (= x 2)) tup) 2)
  (not (tuple-find (cut = <> 4) tup))
  (equal? (tuple->list (tuple-map add1 tup)) '(1 2 3 4))
  (tuple-eqv? (tuple-map + tup (tuple 0 10 20 30) (tuple 0 100 200 300))
              (tuple 0 111 222 333))
  (equal?
    (let ((result '()))
      (tuple-for-each (lambda (x) (set! result (cons x result)))
                      tup)
      result)
    '(3 2 1 0))
  (receive (head tail) (tuple-split tup 2)
    (and (equal? (tuple->list head) '(0 1))
         (equal? (tuple->list tail) '(2 3))))
  (equal? (tuple->list (tuple-copy tup)) '(0 1 2 3))
  (equal? (tuple->list (tuple-from-upto tup 2 3)) '(2))
  (equal? (tuple->list (tuple-from-upto tup 2)) '(2 3))
  (equal? (tuple->list (tuple)) '())
  (tuple-empty? (tuple))
  ((tuple-of? even?) (tuple))
  (not ((tuple-of? even?) (tuple 1 2 3)))
  ((tuple-of? even?) (tuple 2 4 6))
  (not (tuple? 3))
  (= (tuple-length (tuple)) 0)
  (not (tuple-find (cut = 3 <>) (tuple)))
  (= (tuple-find (cut = 2 <>) tup) 2)
  (not (tuple-equal? (tuple) (tuple 1)))
  (tuple-eql? = (list->tuple '(0 1 2 3)) tup)
  (tuple-eqv? (list->tuple '()) (tuple))
  (tuple-eq? (tuple-map add1 (tuple)) (tuple))
  (tuple-equal? (tuple-append (tuple 0 1 2) (tuple 3) (tuple 4 5))
                (tuple 0 1 2 3 4 5))
  (tuple-eqv? (tuple-butleft tup) (tuple 1 2 3))
  (tuple-eqv? (tuple-butright tup) (tuple 0 1 2))
  (tuple-eqv? (tuple-tail tup 2) (tuple 2 3))
  (tuple-eqv? (tuple-head tup 2) (tuple 0 1))
  (tuple-eqv? (tuple-cons-left 0 (tuple-butleft tup)) tup)
  (tuple-eqv? (tuple-cons-right 3 (tuple-butright tup)) tup)
  (not (tuple-empty? (tuple 1 2)))
  (not (tuple-empty? 3))
  )

(simple-test ("MUTABLE SINGLES")
  (single? (single 1))
  (not (single? 3))
  (define sgl (single 0))
  (= (single-ref sgl) 0)
  (= (begin (single-set! sgl 2) (single-ref sgl)) 2)
  )

(simple-test ("COUPLES")
  (define cpl (couple 0 1))
  (couple? cpl)
  (not (triple? cpl))
  (= (couple-left cpl) 0)
  (= (couple-right cpl) 1)
  )

(simple-test ("TRIPLES")
  (define trp (triple 0 1 2))
  (not (couple? trp))
  (tuple? (couple->tuple cpl))
  (not (tuple? trp))
  (tuple? (triple->tuple trp))
  (triple? trp)
  (= (triple-left trp) 0)
  (= (triple-middle trp) 1)
  (= (triple-right trp) 2)
))