;; Tests that should type check

(define test-1
  (lambda ()
    (equal?
      6
      (eval '((lambda (x) (+ x x))
               (let ((y 1) (z 2))
                 (if (= 1 y) (+ y z) 9)))))))

(define test-2  ; check for lexical scoping
  (lambda ()
    (equal?
      1
      (eval '(let ((x 0))
               (let ((f (lambda (y) (+ 1 x)))
                     (x 2))
                 (f 0)))))))

(define test-3
  (lambda ()
    (equal?
      6
      (eval '((lambda (x) (+ x x))
               (let ((y 1) (z 2))
                 (let ((y (- y 1)))
                   (let ((y (+ y 1)))
                     (if (= 1 y) (+ y z) 9)))))))))
      
(define test-4
  (lambda ()
    (equal?
      6
      (eval '((lambda (x) (+ x x))
               (let ((y 1) (z 2))
                 (if (= 1 y) (+ y z) 9)))))))

(define test-5
  (lambda ()
    (equal?
      6
      (eval '((lambda (x) (+ x x))
               (let ((y 1) (z 2))
                 (let ((y (- y 1)))
                   (let ((y (+ y 1)))
                     (if (= 1 y) (+ y z) 9)))))))))

(define test-6
  (lambda ()
    (equal?
      120
      (eval '(letrec ((fact (lambda (n)
                               (if (= 0 n)
                                   1
                                   (* n (fact (- n 1)))))))
                (fact 5))))))

(define test-7
  (lambda ()
    (equal?
      #t
      (eval '(letrec ((oddl (lambda (l)
                               (if (not (pair? l))
                                   #f
                                   (evenl (cdr l)))))
                       (evenl (lambda (l)
                                (if (not (pair? l))
                                    #t
                                    (oddl (cdr l))))))
                (oddl (cons 'x (cons 'a (cons 'b nil)))))))))

;; Let polymorphism

(define test-8
  (lambda ()
    (equal?
      #t
      (eval '(let ((f (lambda (x) x)))
               (if (symbol= (f 'x) 'x)
                   (if (= (f 1) 1)
                       #t
                       #f)
                   #f))))))

(define test-9
  (lambda ()
    (equal?
      #t
      (eval '(let ((f (lambda (x) (cons x nil))))
               (if (symbol= (car (f 'x)) 'x)
                   (if (= (car (f 1)) 1)
                       #t
                       #f)
                   #f))))))

(define test-10
  (lambda ()
    (equal?
      3
      (eval '(let ((len
                    (letrec ((len
                              (lambda (l)
                                (if (null? l)
                                    0
                                    (+ 1 (len (cdr l)))))))
                      len)))
               (begin
                 (len (cons 1 (cons 2 nil)))
                 (len (cons 'x (cons 'y (cons 'z nil))))))))))

;; Tests that should fail

(define test-11
  (lambda ()
    (eval '(if #t 1 'x))))

(define test-12
  (lambda ()
    (eval '(lambda (x) (x x)))))

(define test-13
  (lambda ()
    (eval '((lambda (f)
              (let ((g (lambda (x) (f x))))
                (begin
                  (g 1)
                  (g #t))))
            (lambda (y) y)))))

(define testit
  (lambda ()
    (printf "1: ~a " (test-1)) (flush-output)
    (printf "2: ~a " (test-2)) (flush-output)
    (printf "3: ~a " (test-3)) (flush-output)
    (printf "4: ~a " (test-4)) (flush-output)
    (printf "5: ~a " (test-5)) (flush-output)
    (printf "6: ~a " (test-6)) (flush-output)
    (printf "7: ~a " (test-7)) (flush-output)
    (printf "8: ~a " (test-8)) (flush-output)
    (printf "9: ~a " (test-9)) (flush-output)
    (printf "10: ~a " (test-10)) (flush-output)
    (printf "Remaining should fail to type check:~%")
    (printf "11: ~a " (test-11)) (flush-output)
    (printf "12: ~a " (test-12)) (flush-output)
    (printf "13: ~a " (test-10)) (flush-output)
    (printf "~%") (flush-output)))

;(testit)
;(exit)