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

(require-library simple-tests list-bindings)
(import simple-tests list-bindings)

(compound-test ("LIST-BINDINGS")
  (simple-test ("BINDING MACROS")
    (= (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-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)))
    )
  (simple-test ("DEFINE AND SET!")
    (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)
    )
  (simple-test ("TEST LOW-LEVEL MACROS")
    (define-macro (efreeze xpr)
      (renaming (% %lambda)
        `(,%lambda () ,xpr)))
    (= ((efreeze 3)) 3)
    (define-macro (ifreeze xpr)
      `(lambda () ,xpr))
    (= ((ifreeze 5)) 5)
    (define-macro (alambda args xpr . xprs)
      (injecting (self)
        `(letrec ((,self (lambda ,args ,xpr ,@xprs)))
           ,self)))
    (define ! (alambda (n) (if (zero? n) 1 (* n (self (- n 1))))))
    (= (! 5) 120)
    (define-macro (foo pair)
      (comparing (? bar?) `(if ,(bar? (car pair)) ,@(cdr pair) 'unchecked)))
    (eq? (foo (bar 'checked)) 'checked)
    (eq? (foo (baz 'checked)) 'unchecked)
    (define-macro (baz pair)
      (renaming (% %if)
        (comparing (? bar?)
          `(,%if ,(bar? (car pair)) ,@(cdr pair) 'unchecked))))
    (eq? (baz (bar 'checked)) 'checked)
    (eq? (baz (foo 'checked)) 'unchecked)
    (define-macro (swap! x y)
      `(let ((tmp ,x)) (set! ,x ,y) (set! ,y tmp)))
    (equal? (let ((x 'x) (y 'y)) (swap! x y) (list x y))
            '(y x))
    (= (letrec-macro (((ifreeze xpr) `(lambda () ,xpr))
                      ((efreeze xpr)
                       (renaming (% %lambda)
                         `(,%lambda () ,xpr))))
         ((efreeze ((ifreeze 3)))))
       3)
    (equal? (let-macro (((ifreeze xpr) `(lambda () ,xpr))
                        ((efreeze xpr)
                         (renaming (% %lambda)
                           `(,%lambda () ,xpr))))
              (list ((efreeze 3)) ((ifreeze 5))))
            '(3 5))
    (define-syntax-rule (freeze x) (lambda () x))
    (= ((freeze 25)) 25)
    ))