diff --git a/prims.lua b/prims.lua index be0ae64..b4a4f3d 100644 --- a/prims.lua +++ b/prims.lua @@ -768,7 +768,45 @@ function P.install_native_stdlib() return orig_pr(s, st) end + -- hash (sys.kl:117) drives EVERY dict operation — get/put and the whole + -- property system (arities, source, types, ...). The kernel computes it as + -- (shen.mod (shen.prodbutzero (map string->n (explode V)) 1) Bound) + -- i.e. explode V into its printed characters, take each char's first BYTE + -- (string->n = string.byte), and fold them with prodbutzero: multiply while + -- the accumulator stays <= 1e10, switch to ADD once it exceeds (the kernel's + -- own overflow guard — so the key never leaves the double-exact range), then + -- reduce mod Bound with 0 mapped to 1. For a symbol explode yields the bytes + -- of its name; for a string, the bytes of the string (tlstr/pos/string->n + -- are all byte-based here) — verified identical to the compiled-KL hash over + -- every kernel F-name x 5 bounds plus edge strings (empty, embedded NUL, + -- UTF-8, >1e10-triggering lengths): 0 mismatches. Any other value type + -- delegates to the original so its exact printed form is never second-guessed. + -- Boot alone calls hash ~800 times (all on symbol keys); a native fold there + -- and at runtime avoids the per-call explode list + map + KL recursion. + local orig_hash = F["hash"] + local sbyte = string.byte + local function hashkey_bytes(s) + local acc = 1 + for i = 1, #s do + local b = sbyte(s, i) + if b ~= 0 then + if acc > 10000000000 then acc = acc + b else acc = acc * b end + end + end + return acc + end + local function hash(v, bound) + local s + if is_symbol(v) then s = v.name + elseif type(v) == "string" then s = v + else return orig_hash(v, bound) end + local h = hashkey_bytes(s) % bound + if h == 0 then return 1 end + return h + end + local function install(name, fn, arity) F[name] = fn; FA[fn] = arity end + install("hash", hash, 2) install("pr", pr, 2) install("variable?", variable_q, 1) install("fail", fail, 0) diff --git a/scripts/run-tests.lua b/scripts/run-tests.lua index 17f5790..edb6eb3 100644 --- a/scripts/run-tests.lua +++ b/scripts/run-tests.lua @@ -40,6 +40,7 @@ local specs = { "test/repl_spec.lua", "test/tailcall_spec.lua", "test/typecheck_api_spec.lua", + "test/typecheck_lazy_spec.lua", } local function sh_quote(s) return "'" .. tostring(s):gsub("'", "'\\''") .. "'" end diff --git a/test/primitives_spec.lua b/test/primitives_spec.lua index 736a709..57c58d7 100644 --- a/test/primitives_spec.lua +++ b/test/primitives_spec.lua @@ -177,6 +177,18 @@ do -- The kernel hash clusters near-identical keys; >=20 buckets for 100 keys is -- enough to prove it is not collapsing everything to a single bucket. check(n >= 20, "hash spreads 100 distinct keys over >=20 buckets (got " .. n .. ")") + + -- Golden values pin the native `hash` (prims.install_native_stdlib) to the + -- compiled-KL semantics it replaces: a symbol hashes identically to a string + -- of the same bytes, the empty key maps 0 -> 1, and long keys exercise the + -- prodbutzero >1e10 multiply->add overflow guard. If a future change to the + -- native fold diverges from the kernel `hash`, these break. + checkeq('(hash (intern "lambda") 20000)', "3297") + checkeq('(hash "lambda" 20000)', "3297") -- symbol/string parity + checkeq('(hash (intern "shen.initialise") 997)', "889") + checkeq('(hash "" 13)', "1") -- mod 0 -> 1 + checkeq('(hash "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" 20000)', "12575") -- overflow path + checkeq('(hash "the quick brown fox jumps" 65536)', "19259") end -- --------------------------------------------------------------------------- diff --git a/test/typecheck_lazy_spec.lua b/test/typecheck_lazy_spec.lua new file mode 100644 index 0000000..9ac959a --- /dev/null +++ b/test/typecheck_lazy_spec.lua @@ -0,0 +1,47 @@ +-- typecheck_lazy_spec.lua : the deferred typecheck-driver translation. +-- +-- luajit test/typecheck_lazy_spec.lua +-- +-- The engine defers translating the 16 t-star driver defuns from install time +-- to the first typecheck (halving warm boot). This locks that contract: +-- * boot leaves the drivers UNtranslated (n_ok == 0); +-- * the exported native entry is GUARDED — calling it directly, before any +-- dispatch, translates the drivers instead of reading nil predicates and +-- crashing (the pre-fix failure mode); +-- * the drivers are translated exactly ONCE and translation is clean. + +local shen = require("shen") +shen.boot{ quiet = true } +local tn = require("typecheck_native") +local P = shen.prims +local R = require("runtime") + +local pass, fail = 0, 0 +local function check(desc, cond) + if cond then pass = pass + 1 + else fail = fail + 1; print("FAIL " .. desc) end +end + +-- read a source string to the single form the kernel typecheck expects +local function form(s) return P.F["read-from-string"](s)[1] end + +-- 1) boot does NOT translate the drivers — that is the whole point. +check("drivers deferred at boot (n_ok == 0)", tn.n_ok == 0) +check("no failures recorded at boot (n_fail == 0)", tn.n_fail == 0) + +-- 2) the exported native_typecheck is guarded: a direct call (no dispatch has +-- run yet) must translate drivers first, not crash on nil NP predicates. +local ok, res = pcall(tn.native_typecheck, form("1"), form("number")) +check("direct native_typecheck does not crash", ok) +check("direct native_typecheck returns a result", ok and res ~= false) +check("direct call triggered driver translation (n_ok > 0)", tn.n_ok > 0) +check("driver translation was clean (n_fail == 0)", tn.n_fail == 0) + +-- 3) translated exactly once: a normal typecheck afterwards does not re-run it. +local n = tn.n_ok +check("a normal typecheck still succeeds", + shen.typecheck("[1 2 3]", "(list number)") ~= false) +check("drivers translated once (n_ok stable)", tn.n_ok == n) + +print(string.format("typecheck_lazy_spec: %d pass, %d fail", pass, fail)) +os.exit(fail == 0 and 0 or 1) diff --git a/typecheck_native.lua b/typecheck_native.lua index ab237dc..6599d4b 100644 --- a/typecheck_native.lua +++ b/typecheck_native.lua @@ -312,34 +312,66 @@ function M.install(Pmod, Emod) end return nil end - local src = read_kl("t-star") - if not src then - error("typecheck_native: cannot locate t-star.kl") - end - -- kernel signatures from init.kl; incomplete harvest forces legacy fallback M.sigs_complete = harvest_init_sigs(read_kl("init")) + -- Driver TRANSLATION is DEFERRED to the first typecheck; the t-star.kl READ + -- stays eager. Walking the 16 driver defuns through the KL->Lua prolog + -- compiler and loadstring'ing the emitted source is ~32ms — the bulk of the + -- engine's boot cost — and a plain boot never typechecks anything, so none + -- of it is needed until the first (shen.typecheck ...) call. But the *source + -- read* must happen now: read_kl resolves against the relative P.KLDIR, and a + -- caller may chdir between boot and its first typecheck (run-kernel-tests + -- does exactly this), which would leave a deferred read unable to find the + -- file. So we slurp the source string here — cheap, ~8ms — and defer only the + -- CPU-bound parse+translate, which needs nothing but the in-memory string. + -- ensure_drivers() runs that once, on demand; typecheck_dispatch calls it + -- before deciding native-vs-legacy (n_fail is only known after translation). + -- The drivers land in NP, the handports in NP too; both are consulted only + -- along the native typecheck path, so deferring them is behaviour-preserving. + -- Harvest and the declare/destroy wrappers below stay eager: they must + -- observe every kernel declare that initialise() issues after install. + local tstar_src = read_kl("t-star") + if not tstar_src then + error("typecheck_native: cannot locate t-star.kl") + end M.translate_errors = {} local n_ok, n_fail = 0, 0 - for _, form in ipairs(R.read_all(src)) do - if getmt(form) == Cons and getmt(form[2][1]) == Symbol - and DRIVER_FNS[form[2][1].name] then - local fn, err = PC.translate_defun(form) - local name = form[2][1].name - if fn then - NP[name] = fn - n_ok = n_ok + 1 - else - M.translate_errors[name] = err - n_fail = n_fail + 1 + M.n_ok, M.n_fail = 0, 0 -- 0 until ensure_drivers runs on the first typecheck + local drivers_ready = false + local function ensure_drivers() + if drivers_ready then return end + -- Translate into FRESH accumulators and commit `drivers_ready` (plus the + -- n_fail the dispatch consults) only AFTER the whole pass and the + -- hand-ports succeed. If R.read_all or an unexpected translator error + -- throws partway, drivers_ready stays false and n_fail stays 0-but-uncommitted, + -- so the next typecheck re-runs this from scratch rather than dispatching to + -- native_typecheck over a half-filled NP. Re-running is safe: the driver + -- source is fixed, so NP[name] writes are idempotent and the counters are + -- local, not accumulated across attempts. + local ok, fail, errors = 0, 0, {} + for _, form in ipairs(R.read_all(tstar_src)) do + if getmt(form) == Cons and getmt(form[2][1]) == Symbol + and DRIVER_FNS[form[2][1].name] then + local fn, err = PC.translate_defun(form) + local name = form[2][1].name + if fn then + NP[name] = fn + ok = ok + 1 + else + errors[name] = err + fail = fail + 1 + end end end + -- hand-ports (shen.lookupsig / shen.sigf, ...): also native-path only. + install_handports() + M.translate_errors = errors + n_ok, n_fail = ok, fail + M.n_ok, M.n_fail = ok, fail + drivers_ready = true end - M.n_ok, M.n_fail = n_ok, n_fail - - -- 2) hand-ports - install_handports() + M.ensure_drivers = ensure_drivers -- 3) declare wrapper: record raw type exprs for native lookupsig. -- boot.lua installs the engine before initialise(), so every kernel @@ -371,6 +403,7 @@ function M.install(Pmod, Emod) -- rerun the whole query on the legacy engine. local orig_typecheck_ref = nil -- resolved lazily: t-star loads before us local function typecheck_dispatch(expr, type_) + ensure_drivers() -- translate the drivers on first typecheck (see above) if n_fail == 0 and M.sigs_complete and P.GLOBALS["shen.*spy*"] ~= true then local ok, r = pcall(native_typecheck, expr, type_) @@ -387,7 +420,14 @@ function M.install(Pmod, Emod) F["shen.typecheck"] = typecheck_dispatch P.FA[F["shen.typecheck"]] = 2 end - M.native_typecheck = native_typecheck + -- Export a GUARDED entry: the drivers are translated lazily, so a caller that + -- reaches native_typecheck directly (embedders/tests) must trigger that first, + -- or it reads nil driver predicates out of NP and crashes. The internal + -- dispatch path already calls ensure_drivers(), so it uses the raw local. + M.native_typecheck = function(expr, type_) + ensure_drivers() + return native_typecheck(expr, type_) + end end return M