#lang zuo

(require "harness.zuo")

(alert "kernel eval")

(define bad-kernel-stx "bad kernel syntax")

(check (kernel-eval 1) 1)
(check (kernel-eval 'cons) cons)

(check (kernel-eval '(cons 1 2)) '(1 . 2))
(check-fail (kernel-eval '(cons 1 . 2)) bad-kernel-stx)
(check-fail (kernel-eval '(cons . 2)) bad-kernel-stx)

(check (procedure? (kernel-eval '(lambda (x) x))) #t)
(check (procedure? (kernel-eval '(lambda (x x) x))) #t)
(check (procedure? (kernel-eval '(lambda (x . x) x))) #t)
(check (procedure? (kernel-eval '(lambda (x x) "name" x))) #t)
(check ((kernel-eval '(lambda (x x) x)) #f 2) 2)
(check ((kernel-eval '(lambda (x x . x) x)) #f 2 3 4) '(3 4))
(check-fail (kernel-eval '(lambda)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda . x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda (x x))) bad-kernel-stx)
(check-fail (kernel-eval '(lambda (x x . x) . x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda (x y . x) . x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda (x x . 5) x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda 5 x)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda x #f 2)) bad-kernel-stx)
(check-fail (kernel-eval '(lambda x #f . 2)) bad-kernel-stx)
(check-fail (kernel-eval 'lambda) "undefined: 'lambda")
(check (((kernel-eval '(lambda (lambda) (lambda x x))) 1) 2) '(2))

(check (kernel-eval '(quote cons)) 'cons)
(check-fail (kernel-eval '(quote)) bad-kernel-stx)
(check-fail (kernel-eval '(quote cons list)) bad-kernel-stx)
(check-fail (kernel-eval '(quote . cons)) bad-kernel-stx)
(check-fail (kernel-eval '(quote cons . list)) bad-kernel-stx)
(check-fail (kernel-eval 'quote) "undefined: 'quote")

(check (kernel-eval '(if #t 1 2)) 1)
(check (kernel-eval '(if 0 1 2)) 1)
(check (kernel-eval '(if #f 1 2)) 2)
(check-fail (kernel-eval '(if)) bad-kernel-stx)
(check-fail (kernel-eval '(if . 1)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 . 2)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 2)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 2 . 3)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 2 3 . 4)) bad-kernel-stx)
(check-fail (kernel-eval '(if 1 2 3 4)) bad-kernel-stx)
(check-fail (kernel-eval 'if) "undefined: 'if")

(check (kernel-eval '(let ([x 1]) x)) 1)
(check (kernel-eval '(let ([x 1]) (let ([x 2]) x))) 2)
(check (kernel-eval '(let ([x 1]) (list (let ([x 2]) x) x))) '(2 1))
(check-fail (kernel-eval '(let)) bad-kernel-stx)
(check-fail (kernel-eval '(let . x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ())) bad-kernel-stx)
(check-fail (kernel-eval '(let () x)) bad-kernel-stx)
(check-fail (kernel-eval '(let (x) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x . 1]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 1 . 2]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 1 2]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([1 2]) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2] . y) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2] y) x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2]))) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2]) . x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2]) x . x)) bad-kernel-stx)
(check-fail (kernel-eval '(let ([x 2]) x x)) bad-kernel-stx)
(check-fail (kernel-eval 'let) "undefined: 'let")

(check (kernel-eval '(begin 1)) 1)
(check (kernel-eval '(begin 1 2)) 2)
(check (kernel-eval '(begin 1 2 3 4)) 4)
(check-fail (kernel-eval '(begin)) bad-kernel-stx)
(check-fail (kernel-eval '(begin . 1)) bad-kernel-stx)
(check-fail (kernel-eval '(begin 1 2 3 . 4)) bad-kernel-stx)
(check-fail (kernel-eval 'begin) "undefined: 'begin")

(check (andmap (lambda (k)
                 (eq? (kernel-eval k) (hash-ref (kernel-env) k #f)))
               (hash-keys (kernel-env))))

(check (kernel-eval
        (let loop ([i 10000])
          (if (= i 0)
              "ok"
              `(kernel-eval ',(loop (- i 1))))))
       "ok")
