;;; File: ir-macros-run.scm
(require 'ir-macros)
(import ir-macros)
(import-for-syntax (only ir-macros macro-rules ir-macro-rules)
  (only matchable match))

(macro-define (my-or . args)
  (if (null? args)
    #f
    (let ((tmp (car args)))
      `(if ,tmp ,tmp (my-or ,@(cdr args))))))

(macro-define (freeze . xprs)
  `(lambda () ,@xprs))

(define-syntax do-forever
  (ir-macro-rules (exit)
     ((_ . body)
      `(call/cc (lambda (,exit)
                  (let loop ()
                    ,@body
                    (loop)))))))

(define foo
  (lambda (n)
    (let ((lst '()))
      (do-forever
        (if (zero? n)
          (exit lst))
          (begin
            (set! lst (cons 'a lst))
            (set! n (- n 1)))))))

(define (f n) (+ n 10))

(define (bar)
  (macro-let (
    ((f n) n)
    ((g n) `(f ,n))
    )
    (list (f 1) (g 1))))



(define (baz)
  (macro-letrec (
    ((f n) n)
    ((g n) `(f ,n))
    )
    (list (f 1) (g 1))))

(define-syntax aif
  (ir-macro-rules (it)
    ((_ test then)
     `(let ((,it ,test))
        (if ,it ,then)))
    ((_ test then else)
     `(let ((,it ,test))
        (if ,it ,then ,else)))))

(define-syntax awhen
  (ir-macro-rules (it)
    ((_ test xpr . xprs)
     `(let ((,it ,test))
        (if ,it (begin ,xpr ,@xprs))))))

(define-syntax aand
  (ir-macro-rules (it)
    ((_ . args)
     (let loop ((args args))
       (cond 
         ((null? args) #t)
         ((null? (cdr args)) (car args))
         (else 
           `(let ((,it ,(car args)))
              (if ,it
                ,(loop (cdr args))))))))))

(define-syntax acond
  (ir-macro-rules (it)
    ((_ (test . xprs))
     `(if ,(compare? test 'else)
        (let ((,it #t)) ,@xprs)
        (let ((,it ,test)) (if ,it ,@xprs) #f)))
    ((_ (test . xprs) . clauses)
     `(let ((,it ,test))
        (if ,it (begin ,@xprs) (acond ,@clauses))))))


(define-syntax awhile
  (ir-macro-rules (it)
    ((_ ok? xpr . xprs)
     `(let loop ((,it ,ok?))
        (when ,it
          ,xpr ,@xprs
          (loop ,ok?))))))

(define-syntax alambda
  (ir-macro-rules (self)
    ((_ args xpr . xprs)
     `(letrec ((,self (lambda ,args ,xpr ,@xprs)))
        ,self))))

(define (run)
  (if 
    (and
      (= ((freeze 1 2 3)) 3)
      (equal?
        (macro-letrec (
          ((aif test then) (with (it) `(let ((,it ,test)) (if ,it ,then))))
          )
          (aif (memv 2 '(1 2 3)) it))
        '(2 3))
      (equal?
        (macro-let (
          ((aif test then) (with (it) `(let ((,it ,test)) (if ,it ,then))))
          )
          (aif (memv 2 '(1 2 3)) it))
        '(2 3))
      (equal?
        (let ((f (lambda (n) (+ n 10))))
          (ir-macro-let (
            ((f n) n)
            ((g n) `(f ,n))
            )
            (list (f 1) (g 1))))
        '(1 11))
      (equal?
        (let ((f (lambda (n) (+ n 10))))
          (macro-letrec (
            ((f n)  n)
            ((g n) `(f ,n))
            )
            (list (f 1) (g 1))))
        '(1 1))
      (equal?
        (map (alambda (n) (if (zero? n) 1 (* n (self (- n 1)))))
             '(1 2 3 4 5))
        '(1 2 6 24 120))
      (equal?
        (let ((lst '(0 1 2 3))) (aand lst (cdr it) (cdr it)))
        '(2 3))
      (equal?
        (let ((lst '(0 1 2 3)))
          (acond ((memv 5 lst) it) ((memv 2 lst) it) (else it)))
        '(2 3))
      (equal?
        (let ((lst '(0 1 2 3))) (aif (memv 2 lst) it #f))
        '(2 3))
      (equal?
        (let ((lst '(0 1 2 3))) (awhen (memv 2 lst) (reverse it)))
        '(3 2))
      (equal?
        (let ((lst '(0 1 2 3)) (acc '()))
          (awhile lst
            (if (null? lst)
              (set! lst #f)
              (begin 
                (set!  acc (cons (car lst) acc))
                (set! lst (cdr lst)))))
          acc)
        '(3 2 1 0))
      (= (my-or #f #f 2 #f) 2)
      (eq? (my-or) #f)
      (equal? (foo 3) '(a a a))
      (equal? (bar) '(1 11))
      (equal? (baz) '(1 1)))
    (print "All tests passed")
    (print "##### Some tests failed #####")))

(run)