// lisp_test — in-process test driver for the tiny Lisp.
//
// Drives eval_str on a sequence of source snippets and
// inspects the returned `*value` (kind + payload). `ww test
// lisp_test.ww` builds + execs this; exit 0 means every probe
// passed, non-zero means at least one failed (with `FAIL <name>`
// on stderr).
//
// We exercise the same wwstage cgen edges as lisp.ww itself, so a
// regression in cross-module type / field access shows up here:
//   - `*value` field reads (.kind / .ival / .fval / .sid)
//   - `(*value | rterror)` returns crossing the
//     use-boundary
//   - module-qualified enum constants (`valkind.INT`) in
//     `==` comparisons and `case let _: rterror =>` arms.

use os;
use fmt;
use strconv;
use lispcore;

let nfail: i32 = 0;
let ntotal: i32 = 0;

// ---- result printers --------------------------------------------------

fn pname(name: str) void = {
	os.write(1, name.ptr, name.len: u64);
};

fn ok(name: str) void = {
	os.write(1, "ok   ".ptr, 5u64);
	pname(name);
	os.write(1, "\n".ptr, 1u64);
};

fn fail(name: str, why: str) void = {
	os.write(2, "FAIL ".ptr, 5u64);
	os.write(2, name.ptr, name.len: u64);
	os.write(2, ": ".ptr, 2u64);
	os.write(2, why.ptr, why.len: u64);
	os.write(2, "\n".ptr, 1u64);
	nfail += 1;
};

fn faili(name: str, why: str, got: i64) void = {
	os.write(2, "FAIL ".ptr, 5u64);
	os.write(2, name.ptr, name.len: u64);
	os.write(2, ": ".ptr, 2u64);
	os.write(2, why.ptr, why.len: u64);
	os.write(2, " got=".ptr, 5u64);
	let buf: [32]u8;
	let n: i32 = strconv.i64tos(buf[0:32], got);
	os.write(2, buf.ptr, n: u64);
	os.write(2, "\n".ptr, 1u64);
	nfail += 1;
};

// ---- assertion helpers ------------------------------------------------
//
// Each `check_*` evaluates `input` against the supplied env, then
// verifies the result. We always bind the result to a local *value
// before doing field access — the wwstage cgen drops the trailing
// field load on chained `xs[0].kind`-style reads.

fn check_int(name: str, input: str, expected: i64, ep: **env) void = {
	ntotal += 1;
	let r = eval_str(input, ep);
	match (r) {
	case let v: *value => {
		let p: *value = v;
		if (p.kind != valkind.INT) {
			fail(name, "kind != INT");
			return;
		};
		if (p.ival != expected) {
			faili(name, "wrong i64", p.ival);
			return;
		};
		ok(name);
	};
	case let _e: rterror => fail(name, "rterror");
	};
};

fn check_bool(name: str, input: str, expected: bool, ep: **env) void = {
	ntotal += 1;
	let r = eval_str(input, ep);
	match (r) {
	case let v: *value => {
		let p: *value = v;
		if (p.kind != valkind.BOOL) {
			fail(name, "kind != BOOL");
			return;
		};
		let want: i32 = 0;
		if (expected) { want = 1; };
		if (p.bval != want) {
			faili(name, "wrong bool", p.bval: i64);
			return;
		};
		ok(name);
	};
	case let _e: rterror => fail(name, "rterror");
	};
};

fn check_kind(name: str, input: str, want: valkind, ep: **env) void = {
	ntotal += 1;
	let r = eval_str(input, ep);
	match (r) {
	case let v: *value => {
		let p: *value = v;
		if (p.kind != want) {
			faili(name, "wrong kind", p.kind as i32: i64);
			return;
		};
		ok(name);
	};
	case let _e: rterror => fail(name, "rterror");
	};
};

// Float — bit-equal comparison through the `fbuf` route lispcore uses
// elsewhere. f64 hand-routing avoids the cgen's mis-lowering of f64
// reads from struct fields.
let chkfbuf: f64 = 0.0;

fn fapprox(a: f64, b: f64) bool = {
	// Tolerance 1e-6 — enough for "is the answer right?" without
	// pulling in a real float compare.
	let d: f64 = a - b;
	if (d < 0.0) { d = -d; };
	return d < 0.000001;
};

fn check_float(name: str, input: str, expected: f64, ep: **env) void = {
	ntotal += 1;
	let r = eval_str(input, ep);
	match (r) {
	case let v: *value => {
		let p: *value = v;
		if (p.kind != valkind.FLOAT) {
			fail(name, "kind != FLOAT");
			return;
		};
		// Cross-module *f64-via-pointer-deref read of v.fval.
		let raw: *u8 = p: *u8;
		let fp: *f64 = (raw + 16u64): *f64;
		let got: f64 = *fp;
		if (!fapprox(got, expected)) {
			fail(name, "wrong float");
			return;
		};
		ok(name);
	};
	case let _e: rterror => fail(name, "rterror");
	};
};

fn check_err(name: str, input: str, ep: **env) void = {
	ntotal += 1;
	let r = eval_str(input, ep);
	match (r) {
	case let _v: *value => fail(name, "expected rterror, got value");
	case let _e: rterror => ok(name);
	};
};

// run an expression for its effect (e.g. `(define ...)`); ignore the
// returned nil. Test passes iff there's no runtime error.
fn run(name: str, input: str, ep: **env) void = {
	ntotal += 1;
	let r = eval_str(input, ep);
	match (r) {
	case let _v: *value => ok(name);
	case let _e: rterror => fail(name, "rterror during run");
	};
};

// ---- entry ------------------------------------------------------------

export fn main() i32 = {
	// Shared env across the whole suite. `define`s leak between
	// probes so later tests can reference `fact`, `square`, etc.
	let e: *env = nil;
	let ep: **env = &e;
	initsyms();
	bind_builtins(ep);

	// ---- atoms + simple arithmetic ----
	check_int  ("int-literal",      "42",                  42i64,    ep);
	check_int  ("add",              "(+ 1 2 3 4 5)",       15i64,    ep);
	check_int  ("sub",              "(- 100 25 25)",       50i64,    ep);
	check_int  ("mul",              "(* 6 7)",             42i64,    ep);
	check_int  ("div",              "(/ 100 5)",           20i64,    ep);
	check_int  ("div-3way",         "(/ 1000 10 5)",       20i64,    ep);
	check_int  ("mod",              "(mod 17 5)",          2i64,     ep);
	check_int  ("neg",              "(- 7)",               -7i64,    ep);
	check_int  ("nested",           "(+ (* 2 3) (* 4 5))", 26i64,    ep);

	// ---- comparisons ----
	check_bool ("eq-true",          "(= 5 5)",             true,     ep);
	check_bool ("eq-false",         "(= 5 6)",             false,    ep);
	check_bool ("lt-chained",       "(< 1 2 3 4)",         true,     ep);
	check_bool ("lt-fail",          "(< 1 2 2)",           false,    ep);
	check_bool ("gt",               "(> 5 3 1)",           true,     ep);
	check_bool ("le",               "(<= 3 3 4)",          true,     ep);

	// ---- conditionals + truthy ----
	check_int  ("if-then",          "(if #t 1 2)",         1i64,     ep);
	check_int  ("if-else",          "(if #f 1 2)",         2i64,     ep);
	check_int  ("if-truthy-int",    "(if 0 1 2)",          1i64,     ep);
	check_bool ("not-false",        "(not #f)",            true,     ep);

	// ---- lists ----
	check_kind ("quote-list-cons",  "'(1 2 3)",            valkind.CONS, ep);
	check_kind ("empty-list-nil",   "'()",                 valkind.NIL,  ep);
	check_kind ("cons-cell",        "(cons 1 2)",          valkind.CONS, ep);
	check_int  ("car",              "(car '(11 22 33))",   11i64,    ep);
	check_int  ("car-of-list",      "(car (list 7 8))",    7i64,     ep);
	check_int  ("len-cdr",          "(car (cdr '(1 2 3)))",2i64,     ep);
	check_bool ("null?-empty",      "(null? '())",         true,     ep);
	check_bool ("null?-pair",       "(null? '(1))",        false,    ep);
	check_bool ("pair?-cons",       "(pair? '(a))",        true,     ep);
	check_bool ("pair?-atom",       "(pair? 'a)",          false,    ep);

	// ---- predicates ----
	check_bool ("number?-int",      "(number? 42)",        true,     ep);
	check_bool ("number?-float",    "(number? 3.14)",      true,     ep);
	check_bool ("number?-sym",      "(number? 'foo)",      false,    ep);
	check_bool ("symbol?-sym",      "(symbol? 'foo)",      true,     ep);
	check_bool ("symbol?-int",      "(symbol? 1)",         false,    ep);
	check_bool ("eq?-sym",          "(eq? 'a 'a)",         true,     ep);
	check_bool ("eq?-int",          "(eq? 7 7)",           true,     ep);
	check_bool ("eq?-mixed",        "(eq? 'a 1)",          false,    ep);

	// ---- define + lookup + set! ----
	run        ("def-x",            "(define x 100)",                ep);
	check_int  ("ref-x",            "x",                   100i64,   ep);
	run        ("set-x",            "(set! x 7)",                    ep);
	check_int  ("ref-x-set",        "x",                   7i64,     ep);

	// ---- lambdas + recursion ----
	run        ("def-sq",           "(define sq (lambda (n) (* n n)))",  ep);
	check_int  ("call-sq",          "(sq 9)",              81i64,    ep);
	run        ("def-fact",         "(define fact (lambda (n) (if (<= n 1) 1 (* n (fact (- n 1))))))", ep);
	check_int  ("fact-5",           "(fact 5)",            120i64,   ep);
	check_int  ("fact-10",          "(fact 10)",           3628800i64, ep);
	run        ("def-fib",          "(define fib (lambda (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))))", ep);
	check_int  ("fib-10",           "(fib 10)",            55i64,    ep);
	check_int  ("fib-15",           "(fib 15)",            610i64,   ep);
	run        ("def-gcd",          "(define gcd (lambda (a b) (if (= b 0) a (gcd b (mod a b)))))", ep);
	check_int  ("gcd",              "(gcd 60 48)",         12i64,    ep);

	// ---- higher-order ----
	run        ("def-map",          "(define mp (lambda (f l) (if (null? l) '() (cons (f (car l)) (mp f (cdr l))))))", ep);
	run        ("def-inc",          "(define inc (lambda (n) (+ n 1)))",  ep);
	check_kind ("map-yields-list",  "(mp inc '(1 2 3))",   valkind.CONS, ep);
	check_int  ("map-car",          "(car (mp inc '(1 2 3)))",  2i64, ep);

	// ---- let + begin ----
	check_int  ("let-product",      "(let ((a 3) (b 4)) (* a b))",   12i64, ep);
	check_int  ("begin-last",       "(begin 1 2 (+ 10 20))",         30i64, ep);

	// ---- floats ----
	check_float("float-add",        "(+ 1.5 2.5)",         4.0,      ep);
	check_float("float-mul",        "(* 0.5 0.5)",         0.25,     ep);
	check_float("float-div",        "(/ 22.0 7.0)",        3.142857, ep);
	check_float("float-promote",    "(+ 1 2.5)",           3.5,      ep);
	check_bool ("float-cmp",        "(< 1.0 2.0)",         true,     ep);

	// ---- runtime errors ----
	check_err  ("err-unbound",      "this-symbol-isnt-bound",        ep);
	check_err  ("err-car-not-pair", "(car 1)",                       ep);
	check_err  ("err-div-zero",     "(/ 5 0)",                       ep);
	check_err  ("err-bad-arg",      "(+ 'a 'b)",                     ep);

	// ---- summary ----
	let buf: [32]u8;
	let n: i32 = 0;
	if (nfail == 0) {
		os.write(1, "\nlisp_test: ".ptr, 12u64);
		n = strconv.i64tos(buf[0:32], ntotal: i64);
		os.write(1, buf.ptr, n: u64);
		os.write(1, "/".ptr, 1u64);
		os.write(1, buf.ptr, n: u64);
		os.write(1, " pass\n".ptr, 6u64);
		return 0;
	};
	os.write(2, "\nlisp_test: ".ptr, 12u64);
	n = strconv.i64tos(buf[0:32], nfail: i64);
	os.write(2, buf.ptr, n: u64);
	os.write(2, " of ".ptr, 4u64);
	n = strconv.i64tos(buf[0:32], ntotal: i64);
	os.write(2, buf.ptr, n: u64);
	os.write(2, " failed\n".ptr, 8u64);
	return 1;
};