(import simple-binds)

(import simple-tests (chicken base))

(define (my-map fn lst)
  (bind-case lst (() '()) ((x . xs) (cons (fn x) (my-map fn xs)))))

(define-tester
  (setters?)
  (let ((x #f) (y #f) (z #f))
    (set-all! x 1)
    (set-all! y 2)
    (set-all! z 3)
    (list x y z))
  '(1 2 3)
  (let ((x #f) (y #f) (z #f)) (set-all! (x y z) '(10 20 30)) (list x y z))
  '(10 20 30)
  (let ((x #f) (y #f) (z #f) (u #f) (v #f))
    (set-all! (x (y . z)) '(1 (2 3 3)))
    (set-all! (u (v)) '(10 (20)))
    (list x y z u v))
  '(1 2 (3 3) 10 20)
  (define-all (x (y . z)) '(1 (2 3 3)))
  (void)
  (let ((x #f) (y #f) (z #f)) (set-all! (x (y . z)) '(1 (2 3 3))) (list x y z))
  '(1 2 (3 3))
  (let ((state #f) (push! #f) (pop! #f))
    (set-all!
      (state (push! pop!))
      (list '()
            (list (lambda (xpr) (set! state (cons xpr state)))
                  (lambda () (set! state (cdr state))))))
    (push! 1)
    (push! 0)
    state)
  '(0 1)
  (begin
    (set-all!
      (plus5 times5)
      (let ((a 5)) (list (lambda (x) (+ x a)) (lambda (x) (* x a)))))
    (list (plus5 6) (times5 6)))
  '(11 30)
  (begin (set-all! (x . y) '(1 . 2)) (list x y))
  '(1 2)
  (begin (set-all! (x y . z) '(1 10 . 2)) (list x y z))
  '(1 10 2)
  (begin (set-all! (x (a y (z b))) '(1 (2 3 (4 5)))) (list x y z))
  '(1 3 4)
  (bind-let
    ((pat 'pat))
    (let ((lst '()))
      (set-all!
        (push top pop)
        (list (lambda (xpr) (set! lst (cons xpr lst)))
              (lambda () (car lst))
              (lambda () (set! lst (cdr lst)))))))
  (void)
  (begin (push 0) (push 1) (push 2) (pop) (top))
  1
  (define-all
    (push top pop)
    (let ((lst '()))
      (list (lambda (xpr) (set! lst (cons xpr lst)))
            (lambda () (car lst))
            (lambda () (set! lst (cdr lst))))))
  (void)
  (and (procedure? push) (procedure? top) (procedure? pop))
  #t
  (begin (push 0) (top))
  0
  (begin (push 1) (top))
  1
  (begin (push 2) (pop) (top))
  1)

(define-tester
  (binds?)
  (bind a 1 a)
  1
  (bind (a b) '(1 2) (list a b))
  '(1 2)
  (bind (x . y) '(1 2 3 4) (list x y))
  '(1 (2 3 4))
  (bind (x (y . ys) . xs) '(1 (2 3 4) 5 6) (list x y))
  '(1 2)
  (bind (x (y (z . u)) v . w)
        (list 1 (list 2 (cons #f #f)) 5 6)
        (list x y z u v w))
  '(1 2 #f #f 5 (6))
  (bind (x (y (z . u)) v . w) '(1 (2 (3 . 4)) 5 6) (list x y z u v w))
  '(1 2 3 4 5 (6))
  (bindrec
    ((o?) e?)
    (list (list (lambda (m) (if (zero? m) #f (e? (- m 1)))))
          (lambda (n) (if (zero? n) #t (o? (- n 1)))))
    (list (o? 95) (e? 95)))
  '(#t #f))

(define-tester
  (predicates?)
  (bindable? (x) '(name 1))
  #f
  (bindable? (x y) '(name 1 2))
  #f
  (bindable? (a b) '(1 2))
  #t
  (bindable? (x (y z)) '(1 (2 3)))
  #t
  (bindable? (x (y . z)) '(1 (2 3)))
  #t
  (bindable? (x y) '(1 (2 3)))
  #t
  (bindable? (a) 1)
  #f
  (bindable? (a (b . c) . d) '(1 2 3 4 5))
  #f)

(define-tester
  (cases?)
  (bind-case '() (() #f))
  #f
  (bind-case
    '(2 2)
    ((a b) (where (even? a) (odd? b)) (print 'even-odd a b))
    ((a b) (where (odd? a) (even? b)) (print 'odd-even a b))
    ((a b) (list a b)))
  '(2 2)
  (bind-case '(1 (2 3)) ((x (y z w)) #f) ((x (y . z)) (list x y z)) ((x y) #t))
  '(1 2 (3))
  (bind-case '(1 (2 3)) ((x y) (list x y)) ((x (y . z)) #t) ((x (y z)) #t))
  '(1 (2 3))
  (bind-case '(1 (2 . 3)) ((x y) (list x y)) ((x (y . z)) #t) ((x (y z)) #f))
  '(1 (2 . 3))
  (bind-case '(1 2) (() #f) ((a) #f) ((a b) (list a b)) ((a b c) #f))
  '(1 2)
  (my-map add1 '(0 1 2 3))
  '(1 2 3 4))

(define-tester
  (lets?)
  (bind-let
    ((((x y) z) '((1 2) 3)) (u (+ 2 2)) ((v w) '(5 6)))
    (list x y z u v w))
  '(1 2 3 4 5 6)
  (bind-let
    loop
    (((a b) '(5 0)))
    (if (zero? a) (list a b) (loop (list (- a 1) (+ b 1)))))
  '(0 5)
  (bind-let
    loop
    (((x . y) '(1 2 3)) ((z) '(10)))
    (if (zero? z)
      (list x y z)
      (loop (cons (+ x 1) (map add1 y)) (list (- z 1)))))
  '(11 (12 13) 0)
  (bind-let*
    ((((x y) z) '((1 2) 3)) (u (+ 1 2 x)) ((v w) (list (+ z 2) 6)))
    (list x y z u v w))
  '(1 2 3 4 5 6)
  (bind-letrec
    ((o? (lambda (m) (if (zero? m) #f (e? (- m 1)))))
     ((e?) (list (lambda (n) (if (zero? n) #t (o? (- n 1)))))))
    (list (o? 95) (e? 95)))
  '(#t #f))

(check-all SIMPLE-BINDS (setters?) (binds?) (predicates?) (cases?) (lets?))

(test-all SIMPLE-BINDS
  setters?
  binds?
  predicates?
  cases?
  lets?
  )