; First test macro.
(progn
    (printf "macro: " ) 
    (if (equal?
	    (let*
		(m (macro (f) (f 1 2 3 4)))
		(m +)
	    )
            10)
        (printf "passed")
        (printf "FAILED")
    )
    (printf "\n")
)

; Now make a macro to do the other tests.
(define test
    (macro (name code result)
        (progn
	    (printf "%s: " name)
	    (if (equal? code result)
		(printf "passed")
		(printf "FAILED")
	    )
	    (printf "\n")
        )
    )
)

(test "cons" (cons 1 2) '(1 . 2))

(test "+" (+ 1 2 3) 6)

(test "-" (- 10 2 3) 5)

(test "*" (* 1 2 3 4 5 6 7 8 9 10) 3628800)

(test "/" (/ 6 3 2) 1)

(test "truncate a" (truncate 1) 1)
(test "truncate b" (truncate 1.5) 1)
(test "truncate c" (truncate -1) -1)
(test "truncate d" (truncate -1.5) -1)

(test "floor a" (floor 1) 1)
(test "floor b" (floor 1.5) 1)
(test "floor c" (floor -1) -1)
(test "floor d" (floor -1.5) -2)

(test "ceiling a" (ceiling 1) 1)
(test "ceiling b" (ceiling 1.5) 2)
(test "ceiling c" (ceiling -1) -1)
(test "ceiling d" (ceiling -1.5) -1)

(test "round a" (round 1) 1)
(test "round b" (round 1.25) 1)
(test "round c" (round 1.75) 2)
(test "round d" (round -1) -1)
(test "round e" (round -1.25) -1)
(test "round f" (round -1.75) -2)

(test "mod a" (mod 6 5) 1)
(test "mod b" (mod -1 5) 4)

(test "rem a" (rem 6 5) 1)
(test "rem b" (rem -1 5) -1)

(test "signum" (list (signum 10) (signum -10) (signum 0)) (list 1 -1 0))

(test "NUM < a" (< 1 2) t)
(test "NUM < b" (< 2 1) ())
(test "CHR <" (< 'a' 'b') t)
(test "STR <" (< "a" "b") t)
(test "ATOM <" (< 'a 'b) t)

(test "NUM > a" (> 2 1) t)
(test "NUM > b" (> 1 2) ())
(test "CHR >" (> 'b' 'a') t)
(test "STR >" (> "b" "a") t)
(test "ATOM >" (> 'b 'a) t)

(test "eql? a" (eql? 1 1) t)

(test "eql? b" (eql? 1 2) ())

(test "eql? c" (eql? 'a 'a) t)

(test "eql? d" (eql? 'a 'b) ())

(test "atom?" (atom? 'a) t)

(test "cons? a" (cons? '(1 . 2)) t)

(test "cons? b" (cons? t) ())

(test "closure?" (closure? (lambda (x) x)) t)

(test "macro?" (macro? (macro (x) x)) t)

(test "prim?" (prim? prim?) t)

(test "character?" (character? 'a') t)

(test "string?" (string? "a") t)

(test "number?" (number? 1) t)

(test "errex?" (errex? (err "foo")) t)

(test "or a" (or t t () t ()) t)

(test "or b" (or () () () () ()) ())

(test "and a" (and t t () t ()) ())

(test "and b" (and t t t t t) t)

(test "not a" (not t) ())

(test "not b" (not ()) t)

(test "cond a" (cond (() 1) (() 2) (t 3) (() 4)) 3)

(test "cond b" (cond (() 1) (() 2) (() 3) (() 4)) ())

(test "if a" (if t 1 2) 1)

(test "if b" (if () 1 2) 2)

(test "if c" (if t 1) 1)

(test "if d" (if () 1) ())

; Do a basic binding test on all three let variants.
(define test-lets-binding (macro (name f) (test name (f (a 1) (b 2) (c 3) (+ a b c)) 6)))
(test-lets-binding "let* binding" let*)
(test-lets-binding "let binding" let)
(test-lets-binding "letrec binding" letrec)

; Test sequential evaluation on let* and letrec.
(define test-lets-sequential (macro (name f) (test name (f (a 1) (b (+ a 1)) (c (+ b 1)) c) 3)))
(test-lets-sequential "let* sequential" let*)
(test-lets-sequential "letrec sequential" letrec)

(test "let nosequential" (errex? (let (a 1) (b (+ a 1)) (c (+ b 1)) c)) t)

(test "letrec recursion" (letrec (fact (lambda (n) (if (<= n 1) 1 (* n (fact (- n 1)))))) (fact 5)) 120)

(test "letrec mutual recursion" (letrec (a (lambda (n) (if (< n 10) (b (+ n 1)) n))) (b (lambda (n) (if (< n 10) (a (+ n 1)) n))) (a 0)) 10)

(test "define a" (define abc 123) 'abc)

(test "define b" abc 123)

(test "lexical scope" (errex? (let* (b (lambda () (let* (d 2) c))) (a (lambda () (let* (c 1) (b)))) (a))) t)

(test "currying" (((lambda (f x) (lambda args (f x . args))) + 1) 2 3) 6)

(test "same args" ((lambda (x y z) (list x y z)) '(1) '(2) '(3)) '((1) (2) (3)))

(test "extra args" ((lambda (x y) (list x y)) '(1) '(2) '(3)) '((1) (2)))

(test "caller dot" ((lambda (l) ((lambda (x y z) (list x y z)) '(1) '(2) . l)) '((3))) '((1) (2) (3)))

(test "callee dot" ((lambda (x y . z) (list x y z)) '(1) '(2) '(3)) '((1) (2) ((3))))

(test "both dot" ((lambda (l) ((lambda (x y . z) (list x y z)) '(1) '(2) . l)) '((3))) '((1) (2) ((3))))

(test "extra dot" ((lambda (l) ((lambda (x . y) (list x y)) '(1) '(2) . l)) '((3))) '((1) ((2) (3))))

(test "scant dot" ((lambda (l) ((lambda (x . y) (list x y)) '(1) . l)) '((2) (3))) '((1) ((2) (3))))

(test "early dot" ((lambda (l) ((lambda (x y . z) (list x y z)) '(1) . l)) '((2) (3))) '((1) (2) ((3))))

(test "assoc" (let* (a 1) (b 2) (e (list (list 'x . a) (list 'y . b))) (+ (assoc 'x e) (assoc 'y e))) 3)

(test "assoc symbol not found" (errex? (let* (a 1) (b 2) (e (list (list 'x . a) (list 'y . b))) (assoc 'z e))) t)

(test "progn" (progn (+ 1 2) (+ 3 4) (+ 5 6)) 11)

(test "while and setq!" (let* (n 1) (r 0) (progn (while (<= n 10) (progn (setq! r (+ r n)) (setq! n (+ n 1)))) r)) 55)

(test "until" (let* (n 1) (r 0) (progn (until (progn (setq! r (+ r n)) (setq! n (+ n 1)) (> n 10))) r )) 55)

(test "CHR literals and chr" (list 'a' 'b' 'c' ' ' '(' 1 ')' ';') (list (chr 97) (chr 98) (chr 99) (chr 32) (chr 40) 1 (chr 41) (chr 59)))

(test "CHR literals with backslash escaping" (list '\'' '\"' '\(' '\)' '\t' '\n' '\r' '\\') (list (chr 39) (chr 34) (chr 40) (chr 41) (chr 9) (chr 10) (chr 13) (chr 92)))

(test "string-substr a" (string-substr "abcdefghij" 0 4) "abcd")

(test "string-substr b" (string-substr "abcdefghij" 3 4) "defg")

(test "string-substr c" (string-substr "abcdefghij" 6 4) "ghij")

(test "string-find a" (string-find "abcdefghij" 'd') 3)

(test "string-find b" (string-find "abcdefghij" "def") 3)

(test "string-find c" (string-find "abcdefghij" "foo") ())

(test "string-chrat" (string-chrat "abcdefghij" 3) 'd')

(test "chr-tolower" (chr-tolower 'A') 'a')

(test "chr-toupper" (chr-toupper 'a') 'A')

(test "chr-isspace" (and (chr-isspace ' ') (chr-isspace '\t') (chr-isspace '\n') (chr-isspace '\r') (not (chr-isspace 'A'))) t)

(test "STR literals with backslash escaping" (list (string-chrat "\\" 0) (string-chrat "\"" 0) (string-chrat "\t" 0) (string-chrat "\n" 0) (string-chrat "\r" 0)) (list (chr 92) (chr 34) (chr 9) (chr 10) (chr 13)))

(test "string-concat" (string-concat "abc" ' ' "123" ' ' "xyz") "abc 123 xyz")

(test "vector literal and length" (vector-length [1 2 3 4 5]) 5)

(test "max" (max 1 9 2 8 3 7 4 6 5) 9)

(test "min" (min 1 9 2 8 3 7 4 6 5) 1)

(test "sprintf" (sprintf "%% %d %g %c %s %v" 1 1.5 'c' "s" ['v']) "% 1 1.5 c s ['v']")

(test "sprintf field widths" (sprintf "_%3%_%3d_%-3%_%-3d_" 1 1) "_  %_  1_%  _1  _")

(test "append" (append '(1 2 3) '(4 5) '(6 7)) '(1 2 3 4 5 6 7))

(test "apply" (apply + '(1 2 3 4 5)) 15)

(test "reduce" (reduce gcd '(36394865 13592801 13345345)) 37)

(test "reverse list" (reverse '(1 2 3 4 5)) '(5 4 3 2 1))

(test "reverse string" (reverse "12345") "54321")

(test "reverse vector" (reverse [1 2 3 4 5]) [5 4 3 2 1])

(test "mapcar" (mapcar negate '(1 2 3)) '(-1 -2 -3))

(test "map2car" (map2car + '(1 2 3) '(4 5 6)) '(5 7 9))

(test "union" (union '(1 2 3) '(3 4 5)) '(5 4 1 2 3))

(test "intersection" (intersection '(1 2 3) '(3 4 5)) '(3))

(test "apropos-list" (apropos-list "apropos") '(apropos apropos-list))

(test "catch/throw no throw" (catch 'tag 1 2 3) 3)

(test "catch/throw throw" (catch 'tag 1 2 (throw 'tag 4) 3) 4)

(test "catch/throw uncaught throw" (errex? (catch 'tag1 1 2 (throw 'tag2 4) 3)) t)

(test "catch/throw no catch tag" (catch 1 2 (throw 'tag 4) 3) 4)

(test "catch/throw no throw tag" (catch 'tag 1 2 (throw 4) 3) 4)

(test "catch/throw no either tag" (catch 1 2 (throw 4) 3) 4)

(test "catch/throw nested catches" (catch 'tag1 1 2 (catch 'tag2 3 4 (throw 'tag1 7) 5) 6) 7)

(test "catch/throw no throw value" (catch 'tag 1 2 (throw 'tag) 3) ())

(test "catch/throw no throw tag or value" (catch 'tag 1 2 (throw) 3) ())

(test "seq" (seq 1 10) '(1 2 3 4 5 6 7 8 9))

(test "for-seq" (for-seq 1 10 identity) '(1 2 3 4 5 6 7 8 9))

(test "seqby a" (seqby 1 10 2) '(1 3 5 7 9))

(test "seqby b" (seqby 10 1 -2) '(10 8 6 4 2))

(test "for-seqby" (for-seqby 1 10 2 identity) '(1 3 5 7 9))

(test "vector-length" (vector-length [0 1 2 3 4]) 5)

(test "vector-get" (vector-get [0 1 2 3 4] 2) 2)

(test "vector-split" (vector-split [0 1 2 3 4]) '(0 1 2 3 4))

(test "vector-map" (vector-map negate [0 1 2 3 4]) [0 -1 -2 -3 -4])

(test "vector-map2" (vector-map2 + [0 1 2 3 4] [5 6 7 8 9]) [5 7 9 11 13])

(test "vector-find" (vector-find [0 1 2 3 4] 2) 2)

(test "vector-filter" (vector-filter negative? [0 1 -2 3 -4]) [-2 -4])

(test "vector-all? a" (vector-all? negative? [-1 -2 -3 -4]) t)

(test "vector-all? b" (vector-all? negative? [0 1 -2 3 -4]) ())

(test "vector-any? a" (vector-any? negative? [0 1 -2 3 -4]) t)

(test "vector-any? b" (vector-any? negative? [0 1 2 3 4]) ())

(test "vector-sum" (vector-sum [0 1 2 3 4]) 10)

(test "vector-magnitude" (vector-magnitude [3 4]) 5)

(test "vector-normalize" (vector-normalize [3 4]) [0.6 0.8])

(test "vector-dotproduct" (vector-dotproduct [1 3 -5] [4 -2 -1]) 3)

(test "string-split" (string-split "Hello.") '('H' 'e' 'l' 'l' 'o' '.'))

(test "compare" (map2car compare '(10 10 -10 'b' "b") '(10 -10 10 'a' "a")) '(0 1 -1 1 1))

(test "uniq" (uniq '(2 1 2 2 1 3 1 3 3)) '(2 1 3))

(test "sort" (sort '(2 1 2 2 1 3 1 3 3)) '(1 1 1 2 2 2 3 3 3))

(test "sort descending" (sort '(2 1 2 2 1 3 1 3 3) (lambda (a b) (compare b a))) '(3 3 3 2 2 2 1 1 1))
