// 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);
	};
};

// check_str — assert kind==STR and byte-wise equal to `want`. Covers
// the str-ownership story: vstr/promote_v copy bytes into the arena
// so the value survives the REPL's buf reuse.
fn check_str(name: str, input: str, want: str, 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.STR) {
			fail(name, "kind != STR");
			return;
		};
		let got: str = p.text;
		if (got.len != want.len) {
			faili(name, "wrong len", got.len: i64);
			return;
		};
		let i: i32 = 0;
		for (i < got.len) {
			if (got[i] != want[i]) {
				faili(name, "byte mismatch at", i: i64);
				return;
			};
			i += 1;
		};
		ok(name);
	};
	case let _e: rterror => fail(name, "rterror");
	};
};

// strconv.f64tos probes. We run them through lisp_test rather than a
// standalone strconv test program because there's no stdlib-test
// scaffolding yet (cf. test/wcc/900_stdlib.c which only checks
// modules compile, not behaviour). Move out when that lands.
fn check_f64tos(name: str, v: f64, want: str) void = {
	ntotal += 1;
	let buf: [32]u8;
	let n: i32 = strconv.f64tos(buf[0:32], v);
	if (n != want.len) {
		faili(name, "wrong len", n: i64);
		return;
	};
	let i: i32 = 0;
	for (i < n) {
		if (buf[i] != want[i]) {
			faili(name, "byte mismatch at", i: i64);
			return;
		};
		i += 1;
	};
	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);

	// ---- tail-call optimization ----
	// 30k iterations is well past the pre-TCO segfault threshold
	// (~25k) but still completes inside the test budget. Each probe
	// exercises a different tail position: lambda body via if,
	// lambda body via begin, and lambda body via let.
	run        ("def-spin",         "(define spin (lambda (n a) (if (= n 0) a (spin (- n 1) (+ a 1)))))", ep);
	check_int  ("tco-if",           "(spin 30000 0)",      30000i64, ep);
	run        ("def-bspin",        "(define bspin (lambda (n a) (if (= n 0) a (begin a (bspin (- n 1) (+ a 1))))))", ep);
	check_int  ("tco-begin",        "(bspin 30000 0)",     30000i64, ep);
	run        ("def-lspin",        "(define lspin (lambda (n a) (if (= n 0) a (let ((m (- n 1))) (lspin m (+ a 1))))))", ep);
	check_int  ("tco-let",          "(lspin 30000 0)",     30000i64, 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);

	// ---- strconv.f64tos ----
	// Direct probes against the new strconv entry. The lisp printer
	// delegates to this, so any regression here surfaces in `(println
	// 1.5)` style output too. See lib/strconv/strconv.ww for the
	// documented subset (no NaN/Inf/sci, ≥9.22e18 → "huge").
	check_f64tos("f64tos-int",       1.0,         "1");
	check_f64tos("f64tos-half",      1.5,         "1.5");
	check_f64tos("f64tos-pi",        3.14,        "3.14");
	check_f64tos("f64tos-tenth",     0.1,         "0.1");
	check_f64tos("f64tos-neg",       -2.5,        "-2.5");
	check_f64tos("f64tos-zero",      0.0,         "0");
	check_f64tos("f64tos-hundred",   100.0,       "100");
	check_f64tos("f64tos-leadzero",  0.05,        "0.05");
	check_f64tos("f64tos-roundup",   0.9999996,   "1");
	check_f64tos("f64tos-trim",      123.450000,  "123.45");
	check_f64tos("f64tos-huge",      9.5e18,      "huge");

	// ---- 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);

	// ---- strings (vstr/promote_v deep-copy) ----
	// Pre-fix, top-level (define s "..") then later use printed
	// garbage because vstr borrowed the lexer's input buffer and
	// the REPL shifted it between forms. vstr now owns its bytes,
	// promote_v copies them into perm. Each probe runs eval_str on
	// its own input, so any borrow back into a dead source slice
	// would surface here as a byte mismatch.
	check_str  ("str-literal",      "\"hello\"",                "hello",      ep);
	run        ("def-s1",           "(define s1 \"first\")",                  ep);
	run        ("def-s2",           "(define s2 \"second\")",                 ep);
	run        ("def-s3",           "(define s3 \"third\")",                  ep);
	check_str  ("str-s1-survives",  "s1",                       "first",      ep);
	check_str  ("str-s2-survives",  "s2",                       "second",     ep);
	check_str  ("str-s3-survives",  "s3",                       "third",      ep);
	// String embedded in a lambda body — the lambda's body cell
	// holds a STR sub-cell that has to be promoted too.
	run        ("def-getstr",       "(define getstr (lambda () \"inside\"))", ep);
	check_str  ("str-from-lambda",  "(getstr)",                 "inside",     ep);

	// ---- dotted-pair literals ----
	// '(1 . 2) used to lex `.` as a 1-byte SYM, producing a
	// 3-element proper list. Now: lexer emits tkind.DOT inside a
	// list and the parser splices it as the cdr.
	check_kind ("dot-pair-kind",    "'(1 . 2)",                 valkind.CONS, ep);
	check_int  ("dot-pair-car",     "(car '(1 . 2))",           1i64,         ep);
	check_int  ("dot-pair-cdr",     "(cdr '(1 . 2))",           2i64,         ep);
	check_bool ("dot-pair-not-pair-cdr", "(pair? (cdr '(1 . 2)))", false,     ep);
	// Walk `(1 2 . 3)` → car=1, cadr=2, cddr=3 (the dotted tail).
	check_int  ("dot-tail-car",     "(car '(1 2 . 3))",         1i64,         ep);
	check_int  ("dot-tail-cadr",   "(car (cdr '(1 2 . 3)))",    2i64,         ep);
	check_int  ("dot-tail-cddr",   "(cdr (cdr '(1 2 . 3)))",    3i64,         ep);
	check_err  ("dot-leading",      "'(. 2)",                                 ep);
	check_err  ("dot-trailing",     "'(1 . 2 3)",                             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;
};