(require-library basic-macros simple-tests)
(import basic-macro-helpers basic-macros simple-tests)
(import-for-syntax (only basic-macros bind bind-case once-only))

(print "IIIIIIIIII ir-macro alambda")
(pe '
  (define-ir-macro (alambda form % compare?)
    (bind (_ args xpr . xprs) form
      `(letrec ((,%self (lambda ,args ,xpr ,@xprs)))
         ,%self)))
  )

(print "ALAMBDA")
(pe '
  (alambda (n)
    (if (zero? n)
      1
      (* n (self (- n 1)))))
  )

(print "EEEEEEEEEE er-macro nif")
(pe '
  (define-er-macro (nif form % compare?)
    (bind (_ xpr pos zero neg) form
      `(,%let ((,%result ,xpr))
              (,%cond
                ((,%positive? ,%result) 'pos)
                ((,%negative? ,%result) 'neg)
                (,%else 'zero)))))
  )

(print "NIF")
(pe '(nif xpr pos zero neg))

(define-test (pseudolists)
  (check
    (pseudo-list? "x")
    (pseudo-null? 5)
    (equal? (pseudo-list #f 1 2 3 4)
            '(1 2 3 4 . #f))
    (not (pseudo-sentinel
           (pseudo-list #f 1 2 3 4)))
    (= (pseudo-tail 1 0) 1)
    (equal? (pseudo-head 1 0) '())
    (equal? (pseudo-head '(0 . 1) 0) '())
    (equal? (pseudo-head '(0 . 1) 1) '(0))
    (not (condition-case (pseudo-ref 1 0)
           ((exn) #f)))
    (equal? (pseudo-tail '(0 1 2 3 . 4) 1)
            '(1 2 3 . 4))
    (= (pseudo-ref '(0 1 2 3 . 4) 1) 1)
    (= (pseudo-length '(0 1 2 3 . 4)) 4)
    (equal? (pseudo-flatten '(0 1 . 2)) '(0 1 2))
    (equal? (pseudo-flatten '(0 (1 2))) '(0 1 2))
    (equal? (pseudo-flatten '(0 (1 (2 . 3)))) '(0 1 2 3))
    (equal? (pseudo-flatten '(0 (1 (2 . 3) 4))) '(0 1 2 3 4))
    ))


(define-test (other-helpers)
  (check
    (sym-prepends? '% '%foo)
    (eq? (sym-tail '% '%foo) 'foo)
    (equal? (adjoin 1 '(0 1 2 3)) '(0 1 2 3))
    (equal? (adjoin 1 '()) '(1))
    (equal? (remove-duplicates '(0 1 2 1 3 2)) '(0 1 2 3))
    (equal? (filter odd? '(0 1 2 3 4)) '(1 3))
    ))


(define-test (bindings)
  (check
    (= (bind x 1 x) 1)
    (equal? (bind (x . y) (cons 1 2) (list x y)) '(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 . w))) '(1 (2 (3 4 5))) (list x y z w))
            '(1 2 3 (4 5)))
    (= (bind (x . #f) (cons 1 #f) x) 1)
    (equal? (bind (x "y" z) '(1 "y" 2) (list x z)) '(1 2))
    (not (condition-case
           (bind (x . _) (list 1 2 3 4) _)
           ; wildcard not a variable
             ((exn) #f)))
    (not (condition-case
           (bind (x . #f) (cons 1 #t) x)
           ; literals don't match
             ((exn) #f)))
    (not (condition-case
           (bind (x "y" z) '(1 "q" 2) (list x z))
           ; literals don't match
             ((exn) #f)))
    (equal? (bind-case '(2 2)
              ((a b) (where (a even?) (b odd?)) (print 'even-odd a b))
              ((a b) (where (a odd?) (b even?)) (print 'odd-even a b))
              ((a b) (list a b)))
            '(2 2))
    (equal? (bind-case '(1 (2 3))
              ((x y) (where (y number?)) (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? (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)))
    (define (my-map fn lst)
      (let loop ((lst lst) (result '()))
        (bind-case lst
          (() (reverse result))
          ((x . xs)
           (loop xs (cons (fn x) result))))))
    (equal? (my-map add1 '(0 1 2 3 4))
            '(1 2 3 4 5))
    ))
  
(define-test (basic-macros)
  (check
    (define counter
      (let ((n 0))
        (lambda ()
          (set! n (add1 n))
          n)))
    (define-er-macro (square form % compare?)
      (let ((x (cadr form)))
        (once-only (x)
          `(* ,x ,x))))
    (= (square (counter)) 1)
    (= (square (counter)) 4)
    (= (square (counter)) 9)
    (define-er-macro (swap! form % compare?)
      (let ((x (cadr form)) (y (caddr form)))
        `(,%let ((,%tmp ,x))
           (,%set! ,x ,y)
           (,%set! ,y ,%tmp))))
    (equal? (let ((x 'x) (y 'y))
              (swap! x y)
              (list x y))
            '(y x))

    (define-er-macro (nif form % compare?)
      (bind (_ xpr pos zer neg)
        form
        `(,%let ((,%result ,xpr))
                (,%cond
                  ((,%positive? ,%result) ,pos)
                  ((,%negative? ,%result) ,neg)
                  (,%else ,zer)))))
    (eq? (nif 5 'pos 'zer 'neg) 'pos)

    ;;; verbose if
    (define-ir-macro (vif form % compare?)
      (bind-case form
        ((_ test (key xpr . xprs))
         (cond
           ((compare? key %then)
            `(if ,test (begin ,xpr ,@xprs)))
           ((compare? key %else)
            `(if ,(not test) (begin ,xpr ,@xprs)))
           (else
             `(error 'vif "syntax-error"))))
        ((_ test (key1 xpr . xprs) (key2 ypr . yprs))
         (cond
           ((and (compare? key1 %then)
                 (compare? key2 %else))
           `(if ,test
              (begin ,xpr ,@xprs)
              (begin ,ypr ,@yprs)))
           ((and (compare? key1 %else)
                 (compare? key2 %then))
           `(if ,test
              (begin ,ypr ,@yprs)
              (begin ,xpr ,@xprs)))
           (else
             `(error 'vif "syntax-error"))))
        ))
    (eq? (vif (positive? 5) (then 'pos)) 'pos)

    (define-ir-macro (alambda form % compare?)
      (bind (_ args xpr . xprs) form
        `(letrec ((,%self (lambda ,args ,xpr ,@xprs)))
           ,%self)))
    (equal?
      (map (alambda (n)
             (if (zero? n)
               1
               (* n (self (- n 1)))))
           '(1 2 3 4 5))
      '(1 2 6 24 120))
    ))

(compound-test (MACROS)
  (pseudolists)
  (other-helpers)
  (bindings)
  (basic-macros)
  )