polymorphic hindley milner in 69 (96 incl. parser) (110 incl. example) lines of cursed functional js. CC-BY-NC.

lc.js

/** by monomere, under CC-BY-NC. last updated 4th of july, 2024. */
const hindleymilner = () => ((
	nextId = 1,
	Err = e => (_, b = x => Err(x)) => b(e),
	Ok  = x => (a, _ = x => Err(x)) => a(x),
	K = v => _ => v,
	strty = ([kind, ...data], p = false) => ((P = x => p ? `(${x})` : x) => ({
		'fun': (lhs, rhs) => P(`${strty(lhs, true)} → ${strty(rhs)}`),
		'meta': ([[s, t]]) => s ? strty(t) : `?${t}`,
	})[kind]?.(...data) ?? `${kind[0].toUpperCase() + kind.slice(1)}`)(),
	strexpr = (X, p = false) => X ? (([k, ...d], P = x => p ? `(${x})` : x) => ({
		'app': (lhs, rhs) => P(`${strexpr(lhs)} ${strexpr(rhs, true)}`),
		'lam': (name, body) => `(λ${name}. ${strexpr(body)})`,
		'if': (a, b, c) => `if ${strexpr(a)} then ${strexpr(b)} else ${strexpr(c)}`,
		'let': (name, val, body) => `let ${name} = ${strexpr(val)} in\n${strexpr(body)}`,
		'letrec': (defs, body) => `let rec ${defs.map(([name, val]) =>
			`${name} = ${strexpr(val)}`).join(' and ')} in\n${strexpr(body)}`,
	})[k]?.(...d) ?? `${d[0]}`)(X) : `<undefined>`,
	eagerty = ([kind, ...data]) => ({
		'fun': (lhs, rhs) => ['fun', eagerty(lhs), eagerty(rhs)],
		'meta': ([[s, ty]]) => s ? ty : undefined,
	})[kind]?.(...data) ?? [kind, ...data],
	fresh = d => ['meta', [[false, nextId++, d]]],
	dontgen = t => [new Set, t],
	gen = (d, t) => ((set = new Set, h = ([kind, ...data]) => ({
		'fun': (l, r) => (h(l), h(r)),
		'meta': ([[s, t, c]]) => s ? h(t) : (c > d) && set.add(t),
	})[kind]?.(...data)) => (h(t), [set, t]))(),
	inst = (d, [ps, ty]) => ((
		ts = new Map([...ps].map(p => [p, fresh(d)])),
		h = ([kind, ...data]) => ({
			'fun': (lhs, rhs) => ['fun', h(lhs), h(rhs)],
			'meta': ([[s, ty]]) => s ? h(ty) : (ts.get(ty) ?? [kind, ...data]),
		})[kind]?.(...data) ?? [kind, ...data]) => h(ty))(),
	infer = (e, [kind, ...data], d = 0, M = infer, G = gen) => ((es = e.entries()) => ({
		'app': (l, r) => ((ot = fresh(d)) =>
			M(e, l, d)(l => M(e, r, d)(rt => unify(l, ['fun', rt, ot])(K(Ok(ot))))))(),
		'if': (c, t, f) => M(e, c, d)(ct => unify(ct, ['bool'])(
			K(M(e, t, d)(tt => M(e, f, d)(ft => unify(tt, ft)(_ => Ok(tt))))))),
		'let': (n, v, b) => M(e, v, d + 1)(vt => M(new Map([...es, [n, G(d, vt)]]), b, d)),
		'letrec': (ds, b) => ((
			dts = new Map(ds.map(([n]) => [n, fresh(d + 1)])),
			dtf = f => ds.map(([n]) => [n, f(dts.get(n))]),
			e2 = new Map([...es, ...dtf(dontgen)])) =>
				ds.reduce((p, [n, v]) => p(_ => M(e2, v, d + 1)(
					vt => unify(vt, dts.get(n)))), Ok())(
						K(M(new Map([...es, ...dtf(t => gen(d, t))]), b, d))))(),
		'lam': (a, b) => ((at = fresh(d)) =>
			M(new Map([...es, [a, dontgen(at)]]), b, d)(bt => Ok(['fun', at, bt])))(),
		'var': n => e.has(n) ? Ok(inst(d, e.get(n))) : Err([`there's no ${n} silly`]),
		'nat': K(Ok(['nat'])),
		'bool': K(Ok(['bool'])),
	})[kind]?.(...data) ?? Err(['undefined', [kind, ...data]]))(),
	occurs = (v, [kind, ...data], O = occurs) => ({
		'fun': (lhs, rhs) => O(v, lhs) || O(v, rhs),
		'meta': ([m]) => m[0] ? O(v, m[1]) : (m[2] = Math.min(m[1], v[2]), v[1] === m[1]),
	})[kind]?.(...data) ?? false,
	unify = (a_, b_) => ((a = eagerty(a_), b = eagerty(b_)) => ({
		[['fun', 'fun']]: ([la, ra], [lb, rb]) => unify(la, lb)(K(unify(ra, rb))),
		[['bool', 'bool']]: K(Ok()),
		[['nat', 'nat']]: K(Ok()),
		[['meta', 'meta']]: ([[[sa, ida]]], [[[sb, idb]]]) =>
			!sa && !sb && ida === idb ? Ok() : undefined,
	})[[a[0], b[0]]]?.(a.slice(1), b.slice(1)) ??
		((f = (m, b) => occurs(m[0], b) ? Err(`?${m[0][1]} occurs in ${strty(b)}`) :
			(m[0] = [true, b], Ok())) => a[0] === 'meta' ? f(a[1], b) : b[0] === 'meta' ?
				f(b[1], a) : Err(`cant unify ${strty(a)} and ${strty(b)}`))())(),
) => ({ infer: (c, e) => infer(c, e), unify, eagerty, strexpr, strty, Ok, Err }))();

const parser = ({ Err, Ok }) => ((
	STOP = new Set([')', 'then', 'else', 'in', undefined]),
	lex = s => s.replace(/[λ.()=]/g, ' $& ').split(/\s+/g).filter(x => x.length),
	expect = (m, alt = null) => ([t, ...ts]) => t !== undefined &&
		(m.test?.(t) ?? m === t) ? Ok([t, ts]) :
			Err(`expected ${alt ?? `'${m}'`}, got ${t === undefined ? 'eoi' : `'${t}'`}`),
	[ename, enat] = [expect(/^([^\P{L}λ]+|_)$/u, "name"), expect(/^[0-9]+$/u, "number")],
	plet = (ts, r = false) => ename(ts)(([name, ts]) => expect('=')(ts)(([_, ts]) =>
		papp(ts)(([val, ts]) => expect('in')(ts)(([_, ts]) => papp(ts)(([body, ts]) =>
			Ok([r ? ['letrec', [[name, val]], body] : ['let', name, val, body], ts])))))),
	patom = ([t, ...ts]) => t === undefined ? expect('', "atom")([t]) : ({
		'let': ([t, ...ts2]) => t === 'rec' ? plet(ts2, true) : plet(ts),
		'true': ts => Ok([['bool', true], ts]),
		'false': ts => Ok([['bool', false], ts]),
		'if': ts => papp(ts)(([cond, ts]) => expect('then')(ts)(([_, ts]) =>
			papp(ts)(([then, ts]) => expect('else')(ts)(([_, ts]) => papp(ts)(([othr, ts]) =>
				Ok([['if', cond, then, othr], ts])))))),
		'(': ts => papp(ts)(([e, ts]) => expect(')')(ts)(([_, ts]) => Ok([e, ts]))),
		'λ': ts => ename(ts)(([name, ts]) => expect('.')(ts)(([_, ts]) => papp(ts)
			(([body, ts]) => Ok([['lam', name, body], ts])))),
	})[t]?.(ts) ?? ename([t])(_ => Ok([['var', t], ts]),
		_ => enat([t])(_ => Ok([['nat', t], ts]))),
	papp = (ts, g = []) => !STOP.has(ts[0]) ? patom(ts)(([a, ts]) => 
		papp(ts, [...g, a])) : g.length ? Ok([g.reduce((a, b) => ['app', a, b]), ts]) :
			expect('', "expression")(ts),
	parse = src => papp(lex(src)),
) => ({ parse, lex }))();

(async () => {
	const hm = hindleymilner();
	const Okw = f => x => hm.Ok(f(x));
	parser(/* pass `Ok` and `Err` from: */ hm).parse(`
		let rec fix = λf.λx. f (fix f) x in
		let _ = fix λf.λa. if a then f false else true in
		fix λf.λa. if a then f false else 42
	`)(([expr, _rest]) => {
		console.log(hm.strexpr(expr), ':');
		return hm.infer(new Map, expr)(Okw(hm.eagerty))(Okw(hm.strty));
	})(x => console.log(x), e => console.error('error:', e));
})();