;;; File: run.scm in er-macros
(require 'er-macros 'contracts)
(import er-macros contracts)
(import-for-syntax (only er-macros er-macro-rules))

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

(define-with-contract (foo n)
  (domain: (integer? n) (>= n 0))
  (range: (list? result))
  (let ((lst '()))
    (do-forever
      (if (zero? n)
        (exit lst))
        (begin
          (set! lst (cons 'a lst))
          (set! n (- n 1))))))

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

(er-macro-define (freeze xpr)
  (with-renamed (%lambda)
    `(,%lambda () ,xpr)))

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

(define (bar)
  (er-macro-let (
    ((f n) (with-renamed ()  n))
    ((g n) (with-renamed (%f) `(,%f ,n)))
    )
    (list (f 1) (g 1))))

(define (baz)
  (er-macro-letrec (
    ((f n) (with-renamed ()  n))
    ((g n) (with-renamed (%f) `(,%f ,n)))
    )
    (list (f 1) (g 1))))

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

(er-macro-define (awhen test xpr . xprs)
  (with-renamed (%let %if %begin)
    `(,%let ((it ,test))
       (,%if it (,%begin ,xpr ,@xprs)))))

(er-macro-define (aand . args)
  (with-renamed (%let %if)
   (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
  (er-macro-rules (%else %begin %let %if %error %acond)
    ((_ (test . xprs))
     (if (compare? test %else)
       `(,%begin ,@xprs)
       `(,%let ((it ,test))
          (,%if it
            (,%begin ,@xprs)
            (,%error 'acond "no test succeeds")))))
    ((_ (test . xprs) (test1 . xprs1) . clauses)
     `(,%let ((it ,test))
        (,%if it
          (,%begin ,@xprs)
          (,%acond (,test1 ,@xprs1) ,@clauses))))))

(er-macro-define (awhile ok? xpr . xprs)
  (with-renamed (%let %loop)
   `(,%let ,%loop ((it ,ok?))
      (when it
        ,xpr ,@xprs
        (,%loop ,ok?)))))

(er-macro-define (alambda args xpr . xprs)
  (with-renamed (%letrec %lambda)
   `(,%letrec ((self (,%lambda ,args ,xpr ,@xprs)))
      self)))

(define (run . xprs)
  (let loop ((xprs xprs))
    (if (null? xprs)
      (print "All tests passed!")
      (if (car xprs)
        (loop (cdr xprs))
        (error 'run "#### Some test failed! ####")))))

(run
  (equal?
    (er-macro-letrec (
      ((aif test then)
       (with-renamed (%let %if) `(,%let ((it ,test)) (,%if it ,then))))
      )
      (aif (memv 2 '(1 2 3)) it))
    '(2 3))
  (equal?
    (er-macro-let (
      ((aif test then)
       (with-renamed (%let %if) `(,%let ((it ,test)) (,%if it ,then))))
      )
      (aif (memv 2 '(1 2 3)) it))
    '(2 3))
  (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)
  (= ((freeze 3)) 3)
  (eq? (my-or) #f)
  (equal? (foo 3) '(a a a))
  (equal? (bar) '(1 11))
  (equal? (baz) '(1 1))
  )