(import
  test
  srfi-1
  shen)

(define true-tests
  `(
    ("string concat"   . (= "FOO" (cn "FOO" "")))
    ("string concat"   . (= "FOO" (cn "" "FOO")))
    ("string position" . (= "FOO" (cn (pos "FOO" 0) (tlstr "FOO"))))
    ("string codes"    . (= (pos "FOO" 0) (n->string (string->n "FOO"))))
    ("string interns"  . (= (intern "x") (intern "x")))
    ("set / value "    . (do (set x y) (= (value x) y)))
    ("set"             . (= y (set x y)))
    ("trap-error"      . (= "Error"  (trap-error
				      (simple-error "Error")
				      (lambda E (error-to-string E)))))
    ("hd / cons"       . (= x (hd (cons x y))))
    ("tl / cons"       . (= y (tl (cons x y))))
    ("eval-kl"         . (= 3 (eval-kl (cons + (cons 1 (cons 2 ()))))))
    ("partial"         . (= (+ 1 2) ((+ 1) 2)))            
    ("boolean/true"    . (boolean? (intern "true")))
    ("boolean/false"   . (boolean? (intern "false")))))

(define false-tests
  `(
    ("symbol/true"       . (symbol? (intern "true")))
    ("symbol/false"      . (symbol? (intern "false")))
    ("symbol/lambda"     . (symbol? (lambda X X)))
    ("symbol/stinput"    . (symbol? (value *stinput*)))
    ("trap-error/simple" . (trap-error (simple-error "")
				       (lambda E (symbol? E))))
    ("symbol/empty"      . (symbol? ()))))

(define eval-tests
  `(
    ("code"     (string->n "a")   97)
    ("char"     (n->string 97)   "a")
    ("pos"      (pos "ABC" 0)    "A")
    ("cn"       (cn "A" "B")    "AB")
    ("plus"     (+ 1 1)            2)
    ("minus"    (- 3 1)            2)
    ("divide"   (/ 64 8)           8)
    ("multiply" (* 3 3)            9)
    ("trap-error" (trap-error
		   (/ 3 0)
		   (lambda E (error-to-string E))) "division by zero")))

(define klambda-tests
  `(
    ("cons"   (cons A B)       (cons (quote A) (quote B)))
    ("freeze" (freeze (+ 1 1)) (lambda () (+ 1 1)))
    ("cons?"  (cons? A)        (pair? (quote A)))
    ("str"    (str A)          (kl:str (quote A)))
    ("set"    (set A "ABC")    (kl:set (quote A) "ABC"))
    ("time"   (get-time real)  (kl:get-time (quote real)))
    ("lambda" (lambda X (+ X 1))    (lambda (X) (+ X 1)))
    ("defun"  (defun foo (X) (+ X 1))
     (begin
       (register-function-arity (quote foo) 1)
       (define (kl:foo X)
	 (+ X 1))
       (quote foo)))))

;;;  ____                _____         _
;;; |  _ \ _   _ _ __   |_   _|__  ___| |_ ___
;;; | |_) | | | | '_ \    | |/ _ \/ __| __/ __|
;;; |  _ <| |_| | | | |   | |  __/\__ \ |_\__ \
;;; |_| \_\\__,_|_| |_|   |_|\___||___/\__|___/

(test-begin "Evaluation")
(for-each
 (lambda (t)
   (test (car t) (caddr t) (eval (kl->scheme (cadr t)))))
 eval-tests)
(test-end "Evaluation")
	    
(test-begin "K-Lambda")
(for-each
 (lambda (t)
   (test (car t) (caddr t) (kl->scheme (cadr t))))
 klambda-tests)
(test-end "K-Lambda")


(test-begin "Statements should be true")
(for-each
 (lambda (t)
   (test (car t) #t (eval-without-macros (cdr t))))
 true-tests)
(test-end "Statements should be true")

(test-begin "Statements should be false")
(for-each
 (lambda (t)
   (test (car t) #f (eval-without-macros (cdr t))))
 false-tests)
(test-end "Statements should be false")
(test-exit)