Defer typecheck driver translation to first typecheck (halve warm boot)

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)

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

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
 
 -- ---------------------------------------------------------------------------

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)

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