;;;; File: list-bindings-run.scm
;;;; Author: Juergen Lorenz
;;;; ju (at) jugilo (dot) de

(require-library simple-tests list-bindings)
(import simple-tests list-bindings)
(import-for-syntax (only list-bindings macro-rules))

(compound-test (list-bindings)
  (define-test (binding?)
    (check
      (= (bind a 1 a) 1)
      (equal? (bind (a b) '(1 2)  (list a b)) '(1 2))
      (equal?
        (bind (x y z w) '(1 2 3 4) (list x y z w))
        '(1 2 3 4))
      (equal? (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)))
      (equal? (bind (a (b . c) (d (e f))) '(1 (2 3) (4 (5 6)))
                (list a b c d e f))
              '(1 2 (3) 4 5 6))
      (equal? ((bind-lambda (a (b . c) . d) (list a b c d))
               '(1 (20 30 40) 2 3))
              '(1 20 (30 40) (2 3)))
      (equal? (bind-case '(1 (2 3))
                ((x (y z)) (list x y z))
                ((x (y . z)) (list x y z))
                ((x y) (list x y)))
              '(1 2 3))
      (equal? (bind-case '(1 (2 3))
                ((x (y . z)) (list x y z))
                ((x y) (list x y))
                ((x (y z)) (list x y z)))
              '(1 2 (3)))
      (equal? (bind-case '(1 (2 3))
                ((x y) (list x y))
                ((x (y . z)) (list x y z))
                ((x (y z)) (list x y z)))
              '(1 (2 3)))
      (equal? (bind-case '(1 (2 . 3))
                ((x y) (list x y))
                ((x (y . z)) (list x y z))
                ((x (y z)) (list x y z)))
              '(1 (2 . 3)))
      (equal?
        (letrec ((my-map
                   (lambda (fn lst)
                     (bind-case lst
                       (() '())
                       ((x . xs) (cons (fn x) (my-map fn xs)))))))
          (my-map add1 '(0 1 2 3))) '(1 2 3 4))
      ((bindable? (a b)) '(1 2)) 
      (not ((bindable? (x)) '(name 1)))
      ((bindable? (_ x)) '(name 1))
      (not ((bindable? (_ x)) '(name 1 2)))
      (equal? (bind-let* (((a b) '(1 2)) ((x . y) '(3))) (list a b x y))
              '(1 2 3 ()))
      (equal? (bind-let* (((a b) '(1 2)) ((x . y) (list a))) (list a b x y))
              '(1 2 1 ()))
      (equal? (bind-let (((a b) '(1 2)) ((x . y) '(3 4 4))) (list a b x y))
              '(1 2 3 (4 4)))))
  (binding?)
  (define-test (defining?)
    (check
      (bind-define (a (b c) (d (e f))) '(1 (2 3) (4 (5 6))))
      (= f 6)
      (bind-define (push top pop)
        (let ((state '()))
          (list (lambda (arg) (set! state (cons arg state)))
                (lambda () (car state))
                (lambda () (set! state (cdr state))))))
      (push 3)
      (push 5)
      (= (top) 5)
      (pop)
      (= (top) 3)
      (bind-set! (a (b c) (d (e f))) '(10 (20 30) (40 (50 60))))
      (= f 60)
      (bind-define (x (y . z)) '(1 (2 3 4 5)))
      (equal? z '(3 4 5))
      (bind-set! (x (y . z)) '(10 (20 . 30)))
      (= z 30)))
  (defining?))