diff --git a/README.md b/README.md index d98b28e..78920e7 100644 --- a/README.md +++ b/README.md @@ -119,15 +119,26 @@ and `SHEN_PROLOG_NATIVE=off` disable the typechecker/query routing individually. Correctness never depends on native coverage: anything the translator refuses simply keeps its legacy definition. -Two caches make warm starts near-instant (both content-keyed, both safe to +Three caches make warm starts near-instant (all content-keyed, all safe to delete at any time): * **Kernel bytecode cache** — the compiled kernel is `string.dump`ed after the first boot (`.shen-kernel-cache..bin`, one file per exact Lua build, since bytecode is not portable across builds — so e.g. your `luajit` and an embedded OpenResty/Envoy LuaJIT each keep their own warm cache instead of - invalidating each other's); warm boots load it in **~30 ms** instead of - recompiling (~1 s). + invalidating each other's). It also carries the kernel's 161 **type + signatures** as compiled prolog abstractions: `declare` runs the type theory + for real on each one, and re-running it on every boot was the single largest + item in a warm start. `SHEN_KERNEL_CACHE=off` disables; any other value is + used as the cache path. +* **Standard-library boot image** — the whole `lib/StLib` load (its + `install.shen` driver *and* the ~20 files it loads) is recorded as one + artifact, `/stdlib-.img`, and replayed in one go. This is the + nearest a Lua host gets to shen-cl's `save-lisp-and-die`. It is keyed on the + kernel key plus `install.shen`, and it stores the content hash of every file + the recorded load touched, so editing any standard-library file invalidates + it. `SHEN_STDLIB_IMAGE=off` disables it (the per-file fasl entries below are + written either way, so turning it off only costs speed). * **User fasl cache** — `(load "prog.shen")` records its compiled chunks and replays them on later runs, skipping the reader, macroexpansion *and typechecking* (SBCL-fasl semantics: it typechecked when it compiled). @@ -135,6 +146,12 @@ delete at any time): recompiles. `SHEN_FASL=off` disables; `SHEN_FASL_DIR` relocates (default `~/.cache/shen-lua-fasl`). +A cached boot is required to be **indistinguishable from an uncached one** at +the Shen level — same `shen.*sigf*` contents *and* order, same lambda table, +same datatypes, same `shen.*gensym*` and `(inferences)` counters, same +typechecking behaviour. `test/boot_cache_spec.lua` pins that across every cache +configuration. + ## Requirements * **LuaJIT 2.1** (Lua 5.1 semantics). On Debian/Ubuntu: `apt-get install luajit`. @@ -154,9 +171,9 @@ at boot and degrades gracefully: * **Prolog/typecheck engine** — the native soa32 engine needs the LuaJIT FFI; without it the port automatically falls back to the compiled-KL CPS engine (the same path as `SHEN_PROLOG_ENGINE=legacy`). -* **Kernel bytecode cache + user fasl cache** — keyed by FNV-1a hashes that use - LuaJIT's `bit` library; without it both caches self-disable (pure perf - features — the kernel just recompiles on every boot, ~0.4s). +* **All three boot caches** — keyed by FNV-1a hashes that use LuaJIT's `bit` + library; without it they self-disable (pure perf features — the kernel just + recompiles on every boot, ~0.4s). * **Lua 5.3+ integer subtype** — Lua 5.3+ int64 arithmetic *wraps* on overflow, while the kernel assumes the IEEE-double model (LuaJIT/5.1); on 5.3+ the arithmetic primitives compute in the float domain, reproducing LuaJIT's diff --git a/boot.lua b/boot.lua index d37a0ae..d003e0e 100644 --- a/boot.lua +++ b/boot.lua @@ -218,7 +218,8 @@ P.GLOBALS["*release*"] = "0.1" -- port release; kernel *version* comes f -- select direct-call vs APP codegen), the file list, and the LuaJIT version/ -- arch (bytecode is not portable across either). SHEN_KERNEL_CACHE=off -- disables; any other value overrides the cache path. -local CACHE_FORMAT = "SHENKC2" +local CACHE_FORMAT = "SHENKC3" -- 3: per-chunk hoisted (declare ...) block + + -- gensym/inference counters -- LuaJIT's `bit` library drives the FNV-1a hashing behind both the kernel -- bytecode cache and the user fasl cache. PUC Lua has no `bit` (5.3+ has -- native bitwise operators, but this file must stay parseable by 5.1/LuaJIT), @@ -331,12 +332,22 @@ local function kdata_de(data, pos) error("bad KDATA tag: " .. tostring(tag)) end --- format: CACHE_FORMAT\n key\n nchunks\n { name\n #dump\n dump }* +-- format: CACHE_FORMAT\n key\n nchunks\n +-- { name\n #dump\n dump ndecl\n { dname\n #ddump\n ddump }* }* -- narities\n { arity SP fname\n }* nkdata\n { entry }* -local function write_cache(path, key, chunks, arity) +-- gensym\n infs\n +-- The per-chunk decl list is that kernel file's hoisted (declare ...) block: +-- one dumped prolog abstraction per signature, in file order. See +-- hoist_tail / record_declares / replay_declares below. +local function write_cache(path, key, chunks, arity, counters) local parts = { CACHE_FORMAT, "\n", key, "\n", tostring(#chunks), "\n" } for _, ch in ipairs(chunks) do parts[#parts+1] = ch.name .. "\n" .. #ch.dump .. "\n" .. ch.dump + local d = ch.decl or {} + parts[#parts+1] = #d .. "\n" + for _, e in ipairs(d) do + parts[#parts+1] = e.name .. "\n" .. #e.dump .. "\n" .. e.dump + end end local an = 0 for _ in pairs(arity) do an = an + 1 end @@ -348,6 +359,7 @@ local function write_cache(path, key, chunks, arity) for i = 1, #C.KDATA do kdata_ser(C.KDATA[i], parts) end + parts[#parts+1] = tostring(counters.gensym) .. "\n" .. tostring(counters.infs) .. "\n" local tmp = path .. ".tmp" local fh = io.open(tmp, "wb") if not fh then return end -- read-only dir: silently skip caching @@ -385,6 +397,16 @@ local function parse_cache(data, key) if not nm or not len or pos + len - 1 > #data then return nil end chunks[i] = { name = nm, dump = data:sub(pos, pos + len - 1) } pos = pos + len + local nd = tonumber(line() or ""); if not nd then return nil end + local decl = {} + for j = 1, nd do + local dn = line() + local dl = tonumber(line() or "") + if not dn or not dl or pos + dl - 1 > #data then return nil end + decl[j] = { name = dn, dump = data:sub(pos, pos + dl - 1) } + pos = pos + dl + end + chunks[i].decl = decl end local na = tonumber(line() or ""); if not na then return nil end local arity = {} @@ -402,7 +424,10 @@ local function parse_cache(data, key) end end) if not kok then return nil end - return { chunks = chunks, arity = arity, kdata = kdata } + local gensym = tonumber(line() or ""); if not gensym then return nil end + local infs = tonumber(line() or ""); if not infs then return nil end + return { chunks = chunks, arity = arity, kdata = kdata, + gensym = gensym, infs = infs } end local function read_cache(path, key) @@ -459,6 +484,116 @@ local function kernel_key() return k, sources end +-- ---- hoisted kernel type signatures --------------------------------------- +-- klambda/types.kl ends with 161 top-level `(declare Name Type)` forms, and +-- they are not cheap annotations: `declare` (types.kl) runs the type theory for +-- real on every one of them — +-- (a) shen.variancy over the signature under the Prolog machine, +-- (b) (eval-kl (shen.prolog-abstraction Type)) — a full KL->Lua compile plus +-- loadstring per signature, producing the closure stored in shen.*sigf*, +-- (c) (set shen.*sigf* (shen.assoc-> Name ...)). +-- Measured on arm64 LuaJIT that block is ~43 ms: ~30% of a warm boot and its +-- largest single item, recomputed on every start even though the kernel +-- bytecode cache was hit and nothing changed. +-- +-- (a) is a static check of the kernel's own signatures against the kernel's own +-- sources, and the cache key already covers every input to it; (b) is +-- deterministic given the signature. So a cached boot can skip both and keep +-- only (c), replaying the abstraction from dumped bytecode: +-- +-- hoist_tail pulls the trailing (declare ...) block out of a kernel +-- file's forms so boot.lua — not the opaque concatenated +-- chunk — is what runs it. Only a CONTIGUOUS TRAILING run is +-- hoisted, so hoisting can never reorder a file's effects; a +-- file that interleaves declares with other top-level forms +-- keeps them inline and caches nothing for them. +-- record_declares the cold path: runs the real `declare`, capturing each +-- eval-kl chunk through the ordinary FASL_REC recorder +-- (C.NO_KDATA keeps the dumps relocatable, exactly as for +-- the user fasl cache). +-- replay_declares the warm path: load dump, run it, assoc-> into +-- shen.*sigf* — the same final state, no type theory. +-- +-- The gensym and inference counters `declare` advances are recorded and +-- restored (load_cached below), so a cached boot's shen.*gensym* and +-- (inferences) match an uncached one exactly instead of lagging by the ~1000 +-- gensyms the skipped abstractions would have consumed. +local function is_declare_form(f) + return R.is_cons(f) and R.is_symbol(f[1]) and f[1].name == "declare" + and R.is_cons(f[2]) and R.is_cons(f[2][2]) and f[2][2][2] == R.NIL +end + +-- Split a kernel file's forms into (body, init forms, declares). Only a +-- TRAILING run of non-defun top-level forms is ever moved, and it is run +-- immediately after the body chunk, so hoisting cannot reorder anything. In +-- the 41.2 kernel exactly two files have such a run: types.kl (161 declares) +-- and declarations.kl (one form, (shen.build-lambda-table (external shen))). +-- Anything less tidy than [defuns...][inits...][declares...] is left inline. +local function hoist_tail(forms) + local last = #forms + local function is_defun(f) + return R.is_cons(f) and R.is_symbol(f[1]) and f[1].name == "defun" + end + while last > 0 and not is_defun(forms[last]) do last = last - 1 end + if last == #forms then return forms, nil, nil end -- no trailing run + -- the trailing run is [init forms][declare forms]; find the split + local d0 = #forms + 1 + while d0 > last + 1 and is_declare_form(forms[d0 - 1]) do d0 = d0 - 1 end + for i = last + 1, d0 - 1 do + if is_declare_form(forms[i]) then return forms, nil, nil end -- interleaved + end + local kept, inits, decls = {}, {}, {} + for i = 1, last do kept[i] = forms[i] end + for i = last + 1, d0 - 1 do inits[#inits + 1] = forms[i] end + for i = d0, #forms do + decls[#decls + 1] = { name = forms[i][2][1], typ = forms[i][2][2][1] } + end + return kept, (#inits > 0 and inits or nil), (#decls > 0 and decls or nil) +end + +local function record_declares(decls) + local rec = { n = 0, in_chunk = false } + local saved_rec, saved_nokdata = P.FASL_REC, C.NO_KDATA + P.FASL_REC = rec + C.NO_KDATA = true -- recorded chunks must be relocatable + local out, done = {}, 0 + local ok, err = pcall(function() + for _, d in ipairs(decls) do + local n0 = rec.n + P.F["declare"](d.name, d.typ) + done = done + 1 + -- `declare` must have produced exactly one top-level eval-kl chunk (the + -- prolog abstraction). Anything else and we do not understand what was + -- just recorded: cache nothing rather than cache a half-truth. + if rec.n ~= n0 + 1 or rec[rec.n].k ~= "c" then + error("shen-lua: unexpected declare recording", 0) + end + out[#out + 1] = { name = d.name.name, dump = rec[rec.n].dump } + end + end) + P.FASL_REC = saved_rec + C.NO_KDATA = saved_nokdata + if not ok then + -- Not a fatal condition: the declares run either way, they just cannot be + -- cached. Finish the block uncached and record nothing for it. + if err == "shen-lua: unexpected declare recording" then + for i = done + 1, #decls do P.F["declare"](decls[i].name, decls[i].typ) end + return nil + end + error(err, 0) + end + return out +end + +local function replay_declares(decl) + local sigf = R.intern("shen.*sigf*") + local assoc, set = P.F["shen.assoc->"], P.F["set"] + for _, e in ipairs(decl) do + local fn = P.load_chunk(e.dump, "declare:" .. e.name) + set(sigf, assoc(R.intern(e.name), fn(), P.GLOBALS["shen.*sigf*"])) + end +end + -- Load (don't run) every cached dump first, so a corrupt/foreign-arch cache -- falls back to the full compile before any chunk has executed. Returns true -- on success, false if any dump refused to load. @@ -473,12 +608,35 @@ local function load_cached(cached, verbose, tag) -- reads KDATA[i]. Mutate C.KDATA in place — ENV.KDATA aliases it. for i, v in ipairs(cached.kdata) do C.KDATA[i] = v end for i, fn in ipairs(fns) do + -- A hoisted ":init" chunk is a kernel file's trailing top-level block. The + -- only reason it is a separate chunk is so the native shen.lambda-entry can + -- be in place before declarations.kl's (shen.build-lambda-table (external + -- shen)) runs — otherwise that one form runs the whole compiler ~280 times, + -- once per external symbol, and it is 2/3 of what is left of a cached + -- kernel load. See prims.install_native_lambda_entry. + if cached.chunks[i].name:find(":init", 1, true) then + P.install_native_lambda_entry() + end local rok, err = pcall(fn) if not rok then error("load error in "..cached.chunks[i].name..tag..": "..tostring(err)) end + -- the file's hoisted signature block, in its original position + local decl = cached.chunks[i].decl + if decl and #decl > 0 then replay_declares(decl) end if verbose then io.stderr:write(" loaded "..cached.chunks[i].name..tag.."\n") end end + -- Fast-forward the counters `declare` would have advanced had the type theory + -- actually run (see replay_declares), so a cached boot is indistinguishable + -- from an uncached one at the Shen level. + if cached.gensym and type(P.GLOBALS["shen.*gensym*"]) == "number" + and cached.gensym > P.GLOBALS["shen.*gensym*"] then + P.GLOBALS["shen.*gensym*"] = cached.gensym + end + if cached.infs and type(P.GLOBALS["shen.*infs*"]) == "number" + and cached.infs > P.GLOBALS["shen.*infs*"] then + P.GLOBALS["shen.*infs*"] = cached.infs + end -- Restore defun arities harvested at compile time (prescan + cdefun); -- runtime compilation of user code needs them for direct-call codegen. for name, ar in pairs(cached.arity) do C.ARITY[name] = ar end @@ -502,20 +660,31 @@ local function compile_kernel(extsources, path, key, verbose) -- order as per-form loading (every top-level form compiles to a single -- self-contained `do ... end` statement), but loadstring'd once and -- dumpable for the bytecode cache. - local parts = {} - for i,f in ipairs(all[nm]) do - parts[i] = C.compile_top(f) - end - local src = table.concat(parts, "\n") - local fn = P.load_chunk(src, nm) - local ok, err = pcall(fn) - if not ok then - error("load error in "..nm..": "..tostring(err)) + -- The file's trailing top-level block is hoisted out (hoist_tail) into a + -- separate ":init" chunk and, for signatures, into a recorded declare + -- block; both run right after the body, in file order. + local forms, inits, decls = hoist_tail(all[nm]) + local function emit(name, fs) + local parts = {} + for i,f in ipairs(fs) do parts[i] = C.compile_top(f) end + local fn = P.load_chunk(table.concat(parts, "\n"), name) + if name:find(":init", 1, true) then P.install_native_lambda_entry() end + local ok, err = pcall(fn) + if not ok then error("load error in "..name..": "..tostring(err)) end + chunks[#chunks+1] = { name = name, dump = string.dump(fn) } + return chunks[#chunks] end - chunks[#chunks+1] = { name = nm, dump = string.dump(fn) } + emit(nm, forms) + if inits then emit(nm .. ":init", inits) end + if decls then chunks[#chunks].decl = record_declares(decls) end if verbose then io.stderr:write(" loaded "..nm.."\n") end end - if path then write_cache(path, key, chunks, C.ARITY) end + if path then + write_cache(path, key, chunks, C.ARITY, { + gensym = type(P.GLOBALS["shen.*gensym*"]) == "number" and P.GLOBALS["shen.*gensym*"] or 0, + infs = type(P.GLOBALS["shen.*infs*"]) == "number" and P.GLOBALS["shen.*infs*"] or 0, + }) + end end local function load_kernel(verbose) @@ -580,12 +749,15 @@ end -- Known: (destroy ...) at the REPL between loads is not in the key. -- SHEN_FASL=off disables; SHEN_FASL_DIR overrides ~/.cache/shen-lua-fasl; -- SHEN_FASL_DEBUG=1 logs hits/misses to stderr. -local FASL_FORMAT = "SHENFASL5" -- 5: "lt" (shen.*lambdatable* delta by name); +local FASL_FORMAT = "SHENFASL6" -- 6: "dv" (shen.*datatypes* by name) replaces + -- "dt" (re-run shen.process-datatype); + -- 5: "lt" (shen.*lambdatable* delta by name); -- 4: "e" (per-form value/type echo) -- records; 3: "pc" (shen.compile-prolog) local FASL_STACK = {} local FASL_ROLL = 2166136261 local FASL_DEBUG = os.getenv("SHEN_FASL_DEBUG") == "1" +local FASL_INSTALLED = false -- install_fasl() ran: the recorder is live local function fasl_dir() if not bit then return nil end -- PUC Lua: no `bit` -> no fasl keys @@ -634,7 +806,7 @@ end -- rebuilt by name via shen.lambda-entry) -- | G\n }* (set ...) outside any chunk -- narity\n {ar SP name\n}* kbase\n nkdata\n entries gensym\n -local function fasl_write(path, rec, arity0) +local function fasl_serialize(rec, arity0) if rec.uncacheable then error(rec.uncacheable) end local parts = { FASL_FORMAT, "\n", tostring(rec.n), "\n" } for i = 1, rec.n do @@ -654,10 +826,10 @@ local function fasl_write(path, rec, arity0) elseif r.k == "lt" then parts[#parts+1] = "A\n" kdata_ser(r.names, parts) - elseif r.k == "dt" then + elseif r.k == "dv" then parts[#parts+1] = "T\n" - kdata_ser(r.name, parts) - kdata_ser(r.rules, parts) + kdata_ser(r.global, parts) + kdata_ser(r.names, parts) elseif r.k == "pc" then parts[#parts+1] = "Q\n" kdata_ser(r.name, parts) @@ -689,18 +861,27 @@ local function fasl_write(path, rec, arity0) for _, d in ipairs(delta) do parts[#parts+1] = d .. "\n" end local g = P.GLOBALS["shen.*gensym*"] parts[#parts+1] = tostring(type(g) == "number" and g or 0) .. "\n" + return table.concat(parts) +end + +local function atomic_write(path, blob) local tmp = path .. ".tmp" local fh = io.open(tmp, "wb") - if not fh then return end - fh:write(table.concat(parts)); fh:close() + if not fh then return end -- read-only dir: silently skip caching + fh:write(blob); fh:close() os.remove(path) os.rename(tmp, path) end -local function fasl_read(path) - local data = read_file(path) - if not data then return nil end - local pos = 1 +local function fasl_write(path, rec, arity0) + atomic_write(path, fasl_serialize(rec, arity0)) +end + +-- Parse a fasl record stream out of `data` starting at `pos`. Returns the +-- record table and the position just past the stream, or nil on any +-- malformation (a miss, never an error). The stdlib boot image (below) embeds +-- one of these after its own header, which is why this takes a position. +local function fasl_parse(data, pos) local function line() local e = data:find("\n", pos, true) if not e then return nil end @@ -741,7 +922,7 @@ local function fasl_read(path) recs[i] = { k = "lt", names = v[1] } elseif k == "T" then local v = de_n(2); if not v then return nil end - recs[i] = { k = "dt", name = v[1], rules = v[2] } + recs[i] = { k = "dv", global = v[1], names = v[2] } elseif k == "Q" then local v = de_n(2); if not v then return nil end recs[i] = { k = "pc", name = v[1], rules = v[2] } @@ -770,7 +951,13 @@ local function fasl_read(path) arity[name] = tonumber(ar) end local gensym = tonumber(line() or ""); if not gensym then return nil end - return { recs = recs, arity = arity, gensym = gensym } + return { recs = recs, arity = arity, gensym = gensym }, pos +end + +local function fasl_read(path) + local data = read_file(path) + if not data then return nil end + return (fasl_parse(data, 1)) end local function fasl_replay(cached) @@ -815,8 +1002,14 @@ local function fasl_replay(cached) end names = names[2] end - elseif r.k == "dt" then - P.F["shen.process-datatype"](r.name, r.rules) + elseif r.k == "dv" then + -- shen.*datatypes* / shen.*alldatatypes*: rebuild (Name . (fn Name)) + -- for each recorded name, in order (see the `set` recorder). + local fn, out, rev = P.F["fn"], R.NIL, {} + local t = r.names + while R.is_cons(t) do rev[#rev + 1] = t[1]; t = t[2] end + for i = #rev, 1, -1 do out = R.cons(R.cons(rev[i], fn(rev[i])), out) end + P.F["set"](r.global, out) elseif r.k == "sy" then P.F["shen.process-synonyms"](r.syns) elseif r.k == "pc" then @@ -934,16 +1127,14 @@ local function install_fasl() wrap_recorded("shen.record-macro", function(rec, name, fn) return { k = "m", name = name } end) - -- (datatype ...) and (synonyms ...) do ALL their work at macroexpansion - -- time (shen.macros dispatches to these; the expansion result is just the - -- type name). Their state — *datatypes*/*alldatatypes* assoc entries with - -- compiled-closure leaves — can't serialize, but their ARGUMENTS are pure - -- reader output. Record the call; replay re-executes it (recompiling the - -- datatype is much cheaper than the typechecking the replay skips). The - -- in_chunk dance suppresses all their internal chunks/sets/puts. - wrap_recorded("shen.process-datatype", function(rec, name, rules) - return { k = "dt", name = name, rules = rules } - end) + -- (synonyms ...) does ALL its work at macroexpansion time (shen.macros + -- dispatches to it; the expansion result is just the type name). Its state — + -- *synonyms* assoc entries — can't serialize, but its ARGUMENTS are pure + -- reader output. Record the call; replay re-executes it. The in_chunk dance + -- suppresses all its internal chunks/sets/puts. + -- + -- (datatype ...) is deliberately NOT handled this way: see the + -- shen.*datatypes* case in the `set` recorder below. wrap_recorded("shen.process-synonyms", function(rec, syns) return { k = "sy", syns = syns } end) @@ -1002,6 +1193,37 @@ local function install_fasl() end return { k = "lt", names = names } end + if nm == "shen.*datatypes*" or nm == "shen.*alldatatypes*" then + -- (datatype ...) is processed at MACROEXPANSION time and the only state + -- it leaves outside its own eval-kl chunks is these two assoc lists, + -- whose entries are all (TypeName . (fn TypeName)) — sequent.kl + -- shen.remember-datatype — with preclude/include shuffling whole entries + -- between the two lists. The fn leaf can't serialize, but it is exactly + -- reconstructible from the type name, so record the NAMES in order and + -- rebuild the list on replay. Recording the whole list rather than a + -- delta is what makes (preclude-all-but ...) — which SHRINKS + -- shen.*datatypes* — replay correctly. + -- + -- This is what lets a datatype be replayed from its recorded chunks + -- instead of re-run: shen.process-datatype pushes the rules through the + -- shen. yacc parser and the type theory, ~17 ms per datatype on + -- arm64 LuaJIT and the largest single item in a warm standard-library + -- load, and none of it is needed to reach the same state. + local rev = {} + local t = val + while R.is_cons(t) do + local e = t[1] + if not (R.is_cons(e) and R.is_symbol(e[1])) then + rec.uncacheable = "unrecognised " .. nm .. " entry" + return nil + end + rev[#rev + 1] = e[1] + t = t[2] + end + local names = R.NIL + for i = #rev, 1, -1 do names = R.cons(rev[i], names) end + return { k = "dv", global = name, names = names } + end return { k = "g", name = name, val = val } end) @@ -1040,20 +1262,58 @@ local function install_fasl() end end + -- A nested load's records go to the INNER recording, so an enclosing one + -- (the standard-library boot image, below) would otherwise see a hole where + -- the nested load was. Copy the inner stream into the enclosing one when the + -- inner load finishes — from its fasl file on a hit, from the live recording + -- on a miss — so the outer stream stays a complete description of everything + -- the outer span did, in order. An inner recording that could not be + -- serialized poisons the outer one for the same reason. + local function splice_into_outer(recs, uncacheable, deps) + local outer = FASL_STACK[#FASL_STACK] + if not outer then return end + for _, r in ipairs(recs) do + outer.n = outer.n + 1 + outer[outer.n] = r + end + if uncacheable then outer.uncacheable = outer.uncacheable or uncacheable end + if outer.deps and deps then + for _, d in ipairs(deps) do outer.deps[#outer.deps + 1] = d end + end + end + local orig_load = F["load"] F["load"] = function(fname) if type(fname) ~= "string" then return orig_load(fname) end local fh = io.open(fname, "rb") if not fh then return orig_load(fname) end -- let the kernel error local content = fh:read("*a"); fh:close() + -- Every file a recorded span loads is an input to that span's cache key; + -- the boot image stores them so it can verify them all on the next boot. + local outer = FASL_STACK[#FASL_STACK] + if outer and outer.deps then + outer.deps[#outer.deps + 1] = { path = fname, content = content } + end local key = fasl_key(content) local path = dir .. "/" .. key .. ".fasl" local cached = fasl_read(path) if cached then + -- A replay drives the very functions the recorder wraps (put, + -- record-macro, set, ...), so an ENCLOSING recording would capture them a + -- second time — and capture them wrong, since a replay reinstates chunks + -- through load_chunk rather than compile_and_load and so contributes no + -- "c" records. Mark the enclosing span as in-chunk for the duration: its + -- copy of this load is the spliced record stream below, not what the + -- replay happens to call. + local outer0 = FASL_STACK[#FASL_STACK] + local saved_in_chunk = outer0 and outer0.in_chunk + if outer0 then outer0.in_chunk = true end local ok, err = pcall(fasl_replay, cached) + if outer0 then outer0.in_chunk = saved_in_chunk end if ok then fasl_log("hit " .. fname .. " " .. key) FASL_ROLL = fnv1a(content, FASL_ROLL) + splice_into_outer(cached.recs, nil, nil) return R.intern("loaded") end os.remove(path) -- stale beyond what the key caught: recompile next run @@ -1074,8 +1334,11 @@ local function install_fasl() local wok, werr = pcall(fasl_write, path, rec, arity0) if not wok then fasl_log("uncacheable " .. fname .. ": " .. tostring(werr)) end FASL_ROLL = fnv1a(content, FASL_ROLL) + splice_into_outer(rec, (not wok) and tostring(werr) or nil, rec.deps) return res end + + FASL_INSTALLED = true end -- ---- initialise ---------------------------------------------------------- @@ -1104,6 +1367,10 @@ end -- SHEN_NO_STDLIB=1 skips the whole thing (a kernel-only embed); SHEN_STDLIB_DIR -- overrides the location. local STDLIB_LOADED = false +-- set when the stdlib was materialised to a fresh temp directory (single-file +-- bundle): its paths differ on every boot, so a path-keyed boot image would +-- miss every time AND leave a new multi-megabyte file behind on each run. +local STDLIB_EPHEMERAL = false local function find_stdlib_dir() local env = os.getenv("SHEN_STDLIB_DIR") if env and env ~= "" then return env end @@ -1121,6 +1388,7 @@ local function find_stdlib_dir() -- whole tree as P.STDLIB_SOURCES (relpath -> content). Materialise it once to -- a temp dir and load from there (reuses the ordinary file-based load path). if P.STDLIB_SOURCES then + STDLIB_EPHEMERAL = true local base = os.tmpname(); os.remove(base) os.execute("mkdir -p '" .. base .. "'") for rel, content in pairs(P.STDLIB_SOURCES) do @@ -1135,6 +1403,93 @@ local function find_stdlib_dir() return nil end +-- ---- standard-library boot image ------------------------------------------ +-- Everything above caches a PIECE of the boot. This caches the whole standard +-- library phase as one artifact — the closest a Lua host gets to shen-cl's +-- save-lisp-and-die, which is why it starts so much faster: it does not rebuild +-- anything. +-- +-- A warm stdlib load was, before this, ~20 separate fasl hits plus the +-- install.shen driver around them, and the driver is not free: reading +-- install.shen through the kernel reader alone costs ~12 ms, and the trailing +-- (external stlib) / systemf / preclude-all-but block another ~11 ms, none of +-- which any per-file cache could ever capture because it does not happen inside +-- a file. The image records the ENTIRE span — driver forms and nested loads +-- alike, in stream order — as one fasl record stream (the nested loads splice +-- their own streams into it; see splice_into_outer), and replays it in one go. +-- +-- Invalidation is by construction rather than by convention: the file name is +-- keyed on the kernel key + the record format + the Prolog engine + the +-- rewritten install.shen text, and the image itself carries the path and +-- content hash of EVERY file the recorded span loaded. A stale or edited +-- standard-library file fails its hash and the image is a miss. The per-file +-- fasl caches are still written on a miss, so if the image cannot be +-- serialized for any reason the next boot is exactly as fast as it was before +-- this existed. SHEN_STDLIB_IMAGE=off disables it. +local IMAGE_FORMAT = "SHENIMG1" + +-- Keyed on the install.shen text as it is ON DISK, deliberately NOT on the +-- rewritten script: the rewrite bakes in the absolute stdlib directory, and +-- boot.lua resolves that differently depending on how it was itself located +-- ("./lib/StLib" from a repo-root run, an absolute path from a package.path +-- run), which would give the same checkout several images of a megabyte each. +-- The directory is not dropped from the key so much as checked more strictly: +-- the recorded dependency paths must all still hash to what they did, so an +-- image recorded against one tree simply misses against another. +local function image_path(raw_script) + local d = fasl_dir() + if not d or not FASL_INSTALLED then return nil end + local v = os.getenv("SHEN_STDLIB_IMAGE") + if v == "off" or v == "0" or STDLIB_EPHEMERAL then return nil end + local env = IMAGE_FORMAT .. "|" .. FASL_FORMAT + .. "|" .. (os.getenv("SHEN_PROLOG_ENGINE") or "native") + return d .. "/stdlib-" + .. bit.tohex(fnv1a(raw_script, fnv1a(env, fnv1a((kernel_key()))))) .. ".img" +end + +-- header: IMAGE_FORMAT\n ndeps\n { #path\n path #content\n hash\n }* +-- followed by a fasl record stream (fasl_serialize). +local function image_write(path, rec, arity0) + local parts = { IMAGE_FORMAT, "\n", tostring(#rec.deps), "\n" } + for _, d in ipairs(rec.deps) do + parts[#parts+1] = #d.path .. "\n" .. d.path + .. #d.content .. "\n" .. bit.tohex(fnv1a(d.content)) .. "\n" + end + parts[#parts+1] = fasl_serialize(rec, arity0) + atomic_write(path, table.concat(parts)) +end + +-- Returns the parsed record stream, or nil if the image is absent, malformed, +-- or any recorded dependency no longer hashes to what it did. Also returns the +-- dependency contents, in load order, for the FASL_ROLL fold. +local function image_read(path) + local data = read_file(path) + if not data then return nil end + local pos = 1 + local function line() + local e = data:find("\n", pos, true) + if not e then return nil end + local s = data:sub(pos, e - 1); pos = e + 1 + return s + end + if line() ~= IMAGE_FORMAT then return nil end + local nd = tonumber(line() or ""); if not nd then return nil end + local contents = {} + for i = 1, nd do + local plen = tonumber(line() or ""); if not plen then return nil end + if pos + plen - 1 > #data then return nil end + local dpath = data:sub(pos, pos + plen - 1); pos = pos + plen + local clen = tonumber(line() or ""); if not clen then return nil end + local hash = line(); if not hash then return nil end + local c = read_file(dpath) + if not c or #c ~= clen or bit.tohex(fnv1a(c)) ~= hash then return nil end + contents[i] = c + end + local cached = fasl_parse(data, pos) + if not cached then return nil end + return cached, contents +end + local function load_stdlib(verbose) if STDLIB_LOADED then return end if os.getenv("SHEN_NO_STDLIB") == "1" then return end @@ -1143,8 +1498,9 @@ local function load_stdlib(verbose) if verbose then io.stderr:write(" stdlib: lib/StLib not found; skipping (kernel-only)\n") end return end - local script = read_file(dir .. "/install.shen") - if not script then return end + local raw_script = read_file(dir .. "/install.shen") + if not raw_script then return end + local script = raw_script -- Rewrite the relative (load "X") targets to absolute so no chdir is needed. -- All install.shen load paths are relative; the replacement text is escaped -- for gsub's % handling. @@ -1153,12 +1509,60 @@ local function load_stdlib(verbose) script = script:gsub("%(tc %+%)", "(tc -)") -- load without typechecking (see above) local hush0 = P.GLOBALS["*hush*"] P.GLOBALS["*hush*"] = true -- suppress the ~20 "loaded" echoes - local ok, err = pcall(function() + + -- The driver: read install.shen and run its forms. A top-level (load "X") is + -- dispatched straight to `load` rather than through `eval`, which is what it + -- would compile to anyway — it saves a chunk compile per file, and it keeps + -- the recorded image free of chunks that would re-run the load it is meant to + -- have replaced. + local function run_driver() local forms = P.F["read-from-string"](script) while R.is_cons(forms) do - P.F["eval"](forms[1]) + local f = forms[1] + if R.is_cons(f) and R.is_symbol(f[1]) and f[1].name == "load" + and R.is_cons(f[2]) and type(f[2][1]) == "string" and f[2][2] == R.NIL then + P.F["load"](f[2][1]) + else + P.F["eval"](f) + end forms = forms[2] end + end + + local path = image_path(raw_script) + local ok, err = pcall(function() + if path then + local cached, contents = image_read(path) + if cached then + local rok, rerr = pcall(fasl_replay, cached) + if not rok then + os.remove(path) -- stale beyond what the hashes caught + error(rerr, 0) + end + fasl_log("image hit " .. path) + -- Fold the same content into the rolling key the per-file path would + -- have, in the same order, so a user program's fasl key is unchanged + -- whether the stdlib came from the image or from its 20 fasl files. + for _, c in ipairs(contents) do FASL_ROLL = fnv1a(c, FASL_ROLL) end + return + end + fasl_log("image miss " .. path) + local rec = { n = 0, in_chunk = false, deps = {} } + local arity0 = {} + for k, v in pairs(C.ARITY) do arity0[k] = v end + FASL_STACK[#FASL_STACK + 1] = rec + P.FASL_REC = rec + C.NO_KDATA = true -- recorded chunks must be relocatable + local dok, derr = pcall(run_driver) + FASL_STACK[#FASL_STACK] = nil + P.FASL_REC = FASL_STACK[#FASL_STACK] + C.NO_KDATA = P.FASL_REC ~= nil + if not dok then error(derr, 0) end + local wok, werr = pcall(image_write, path, rec, arity0) + if not wok then fasl_log("image uncacheable: " .. tostring(werr)) end + return + end + run_driver() end) P.GLOBALS["*hush*"] = hush0 if not ok then diff --git a/prims.lua b/prims.lua index 4f2c737..1936ac6 100644 --- a/prims.lua +++ b/prims.lua @@ -637,6 +637,60 @@ end -- function, so the (multi-line) simple-error messages stay byte-identical without -- transcription. None of these touch shen.*infs* except shen.incinfs (which is -- kept arithmetically identical), so the typecheck inference count is unchanged. +-- ---- native shen.lambda-entry (installed EARLY; see boot.lua) -------------- +-- shen.lambda-entry (declarations.kl) : +-- (let A (arity Name) +-- (if (or (= A -1) (= A 0)) () +-- (cons Name (eval-kl (shen.lambda-function (cons Name ()) A))))) +-- shen.lambda-function (reader.kl) builds the KL term +-- (lambda Y1 (lambda Y2 ... (Name Y1 ... Yn))) +-- and eval-kl then runs the WHOLE KL->Lua compiler plus loadstring on it — to +-- produce, verbatim, +-- MKFUN(1, function(a) return MKFUN(1, function(b) return F[Name](a,b) end) end) +-- i.e. a curried chain over a late-bound F lookup and nothing else. That is one +-- Lua chunk compiled per lambda table entry, and an entry is built for every +-- `define` (shen.update-lambdatable), for every name a fasl replay rebuilds +-- (~285 in a warm standard-library load) and for every external kernel symbol +-- at boot (~280, from declarations.kl's (shen.build-lambda-table (external +-- shen))). Build the chain directly instead. +-- +-- The innermost call goes through APP on the name SYMBOL rather than calling +-- F[Name] directly, which is what the compiled form does for a name whose arity +-- is not known at codegen time: same late binding, and an arity that no longer +-- matches the property (a redefinition between entry build and call) curries or +-- over-applies exactly as APP always does instead of silently passing the wrong +-- argument count. +-- +-- This one is deliberately NOT part of install_native_stdlib: that runs after +-- the whole kernel is loaded, which is far too late for the boot-time +-- build-lambda-table. It has no dependency on the compiled original — `arity` +-- returns an integer or -1 for every input, so every branch is reachable +-- natively — so boot.lua installs it the moment declarations.kl has defined +-- `arity` and the lambda table is about to be built. +local NATIVE_LAMBDA_ENTRY = false +local function curried(sym, need, got) + return MKFUN(1, function(x) + local n = #got + local nxt = {} + for i = 1, n do nxt[i] = got[i] end + nxt[n + 1] = x + if need == 1 then return APP(sym, unpack(nxt, 1, n + 1)) end + return curried(sym, need - 1, nxt) + end) +end +function P.install_native_lambda_entry() + if NATIVE_LAMBDA_ENTRY then return end + if type(F["arity"]) ~= "function" then return end + local function lambda_entry(name) + local ar = F["arity"](name) + if type(ar) ~= "number" or ar <= 0 or ar ~= math.floor(ar) then return NIL end + return cons(name, curried(name, ar, {})) + end + F["shen.lambda-entry"] = lambda_entry + FA[lambda_entry] = 1 + NATIVE_LAMBDA_ENTRY = true +end + function P.install_native_stdlib() local fail_sym = intern("shen.fail!") @@ -687,6 +741,47 @@ function P.install_native_stdlib() end end + -- shen.assoc-> (reader.kl) : functional assoc-list update — + -- (cond ((= () L) (cons (cons K V) ())) + -- ((and (cons? L) (and (cons? (hd L)) (= K (hd (hd L))))) + -- (cons (cons (hd (hd L)) V) (tl L))) + -- ((cons? L) (cons (hd L) (shen.assoc-> K V (tl L)))) + -- (true (simple-error "implementation error in shen.assoc->"))) + -- i.e. replace the matching entry in place (keeping the STORED key object, + -- not the probe) or append a new one at the end, copying the prefix. + -- Like `append` the KL is non-tail-recursive: one stack frame and one + -- F-table lookup per entry scanned. It is the update primitive behind + -- shen.*lambdatable* (every `define`, and every entry a fasl replay + -- rebuilds), shen.*sigf* (every `declare`) and shen.*datatypes*, all of + -- which are assoc lists several hundred entries long by the time the + -- standard library is loaded — so a boot walks it O(n^2). Native: copy the + -- prefix iteratively, splice the tail. Fresh cells are unshared until we + -- return, so in-place tail assignment is unobservable; an improper list + -- delegates to the original for the identical simple-error. + local orig_assoc_to = F["shen.assoc->"] + local function assoc_to(k, v, l) + local orig = l + local head, last + while true do + if l == NIL then + local cell = cons(cons(k, v), NIL) + if last then last[2] = cell; return head end + return cell + end + if not is_cons(l) then return orig_assoc_to(k, v, orig) end + local pair = l[1] + if is_cons(pair) and equal(k, pair[1]) then + local cell = cons(cons(pair[1], v), l[2]) + if last then last[2] = cell; return head end + return cell + end + local cell = cons(pair, NIL) + if last then last[2] = cell else head = cell end + last = cell + l = l[2] + end + end + -- shen.reverse-help (and reverse, its only caller) : accumulate-reverse. local orig_revh = F["shen.reverse-help"] local function reverse_help(lst, acc) @@ -1005,11 +1100,13 @@ function P.install_native_stdlib() install("shen.incinfs", incinfs, 0) install("element?", element_q, 2) install("assoc", assoc, 2) + install("shen.assoc->", assoc_to, 3) install("append", append, 2) install("shen.reverse-help", reverse_help, 2) install("reverse", reverse, 1) install("shen.map-h", map_h, 3) install("map", map, 2) + P.install_native_lambda_entry() -- no-op if boot.lua already did it -- shen.x host SHA-256 (OpenSSL libcrypto). See pyrex41/shen-extensions. -- Disable with SHEN_X_SHA256=pure. diff --git a/scripts/run-tests.lua b/scripts/run-tests.lua index 8c58758..35d4974 100644 --- a/scripts/run-tests.lua +++ b/scripts/run-tests.lua @@ -29,6 +29,7 @@ end -- Discover specs deterministically (sorted) so the run order is stable. local specs = { + "test/boot_cache_spec.lua", "test/cli_spec.lua", "test/engine_spec.lua", "test/error_robustness_spec.lua", diff --git a/test/boot_cache_spec.lua b/test/boot_cache_spec.lua new file mode 100644 index 0000000..3dcc330 --- /dev/null +++ b/test/boot_cache_spec.lua @@ -0,0 +1,281 @@ +-- test/boot_cache_spec.lua — PORT-AUTHORED coverage for the boot caches +-- (pyrex41/shen-lua#46). +-- +-- Three layers of the boot are cached, and each replaces work that used to be +-- redone on every single start: +-- +-- * the kernel bytecode cache (.shen-kernel-cache..bin, SHENKC3) now +-- also carries klambda/types.kl's 161 hoisted type signatures as dumped +-- prolog abstractions, plus the gensym / inference counters `declare` +-- advances; +-- * the standard-library boot image (/stdlib-.img) records the +-- WHOLE stdlib phase — install.shen's own forms and the ~20 nested loads +-- alike — as one record stream; +-- * two kernel functions that used to run the compiler at boot, +-- shen.lambda-entry and shen.assoc->, are native. +-- +-- The single property that makes all of that legitimate is that a CACHED boot +-- and an UNCACHED one must be indistinguishable at the Shen level. That is what +-- this spec pins, end to end, by booting subprocesses in every cache +-- configuration and diffing a state fingerprint — plus the two natives against +-- the compiled-KL definitions they replace, in process. +-- +-- luajit test/boot_cache_spec.lua + +local npass, nfail = 0, 0 +local function check(cond, name) + if cond then npass = npass + 1 + else + nfail = nfail + 1 + io.write("FAIL: ", name, "\n") + end +end + +local here = arg[0]:gsub("test/[^/]*$", "") +if here == "" then here = "./" end + +local function sh_quote(s) return "'" .. tostring(s):gsub("'", "'\\''") .. "'" end + +local function run(cmd) + local h = io.popen(cmd .. " 2>&1") + if not h then return "", -1 end + local out = h:read("*a") or "" + h:close() + return out +end + +-- --------------------------------------------------------------------------- +-- Part 1 — a cached boot is indistinguishable from an uncached one. +-- +-- The fingerprint covers exactly the state the caches reconstruct rather than +-- recompute: shen.*sigf* (the 161 signatures, by name AND order — assoc-> order +-- is observable), the lambda table size, the datatype tables, and the two +-- counters (`declare` and shen.lambda-function used to consume gensyms that a +-- cached boot never spends, so they are recorded and restored). It also runs a +-- real typecheck, so a signature closure that replayed to something merely +-- shaped right still fails here. +-- --------------------------------------------------------------------------- +local FINGERPRINT = [[ +package.path = %s .. "?.lua;" .. package.path +local R = require("runtime") +local P = require("boot") +P.load_kernel(false); P.initialise() +local function names(l) + local out = {} + while R.is_cons(l) do + local e = l[1] + out[#out+1] = R.is_cons(e) and (R.is_symbol(e[1]) and e[1].name or "?") + or (R.is_symbol(e) and e.name or "?") + l = l[2] + end + return out +end +local sig = names(P.GLOBALS["shen.*sigf*"]) +print("sigf " .. #sig .. " " .. table.concat(sig, ",")) +print("lambdatable " .. #names(P.GLOBALS["shen.*lambdatable*"])) +print("alldatatypes " .. table.concat(names(P.GLOBALS["shen.*alldatatypes*"]), ",")) +print("datatypes " .. table.concat(names(P.GLOBALS["shen.*datatypes*"]), ",")) +print("gensym " .. tostring(P.GLOBALS["shen.*gensym*"])) +print("infs " .. tostring(P.GLOBALS["shen.*infs*"])) +P.GLOBALS["*hush*"] = true +local forms = P.F["read-from-string"]( + [==[(tc +) (define bcs-sq {number --> number} X -> (* X X)) (bcs-sq 7)]==]) +local last +while R.is_cons(forms) do last = P.F["eval"](forms[1]); forms = forms[2] end +print("typecheck " .. tostring(last)) +]] + +do + local script = os.tmpname() .. ".lua" + local h = io.open(script, "w") + h:write(FINGERPRINT:format(string.format("%q", here))) + h:close() + + -- Every configuration gets a private fasl dir, so "cold" really is cold and + -- the developer's ~/.cache state cannot make this pass or fail. + local function fresh() local d = os.tmpname(); os.remove(d); return d end + local kcache = os.tmpname(); os.remove(kcache) + local function boot(env) + return run("env " .. env .. " luajit " .. sh_quote(script)) + end + + local d1, d2, d3, d4 = fresh(), fresh(), fresh(), fresh() + -- (a) nothing cached at all: the reference + local ref = boot("SHEN_KERNEL_CACHE=off SHEN_FASL=off") + -- (b) kernel bytecode cache cold, then warm (exercises SHENKC3 write + read) + local kc = "SHEN_KERNEL_CACHE=" .. sh_quote(kcache) + local kcold = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d1)) + local kwarm = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d1)) + -- (c) stdlib boot image cold, then warm + local icold = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d2)) + local iwarm = boot(kc .. " SHEN_FASL_DIR=" .. sh_quote(d2)) + -- (d) image explicitly disabled: the per-file fasl path must still agree + local noimg = boot(kc .. " SHEN_STDLIB_IMAGE=off SHEN_FASL_DIR=" .. sh_quote(d3)) + + check(ref:find("sigf 178 ", 1, true) ~= nil, + "#46: uncached boot registers the kernel signatures") + check(ref:find("typecheck 49", 1, true) ~= nil, + "#46: uncached boot typechecks a user definition") + check(kcold == ref, "#46: cold kernel-bytecode-cache boot == uncached boot") + check(kwarm == ref, "#46: WARM kernel-bytecode-cache boot == uncached boot") + check(icold == ref, "#46: stdlib image miss == uncached boot") + check(iwarm == ref, "#46: stdlib image HIT == uncached boot") + check(noimg == ref, "#46: SHEN_STDLIB_IMAGE=off == uncached boot") + + -- The image must actually have been exercised — otherwise the checks above + -- would pass vacuously if it silently never engaged. + local dbg = run("env " .. kc .. " SHEN_FASL_DIR=" .. sh_quote(d2) + .. " SHEN_FASL_DEBUG=1 luajit " .. sh_quote(script)) + check(dbg:find("image hit", 1, true) ~= nil, + "#46: the third run really is a stdlib image HIT") + local dbg4 = run("env " .. kc .. " SHEN_FASL_DIR=" .. sh_quote(d4) + .. " SHEN_FASL_DEBUG=1 luajit " .. sh_quote(script)) + check(dbg4:find("image miss", 1, true) ~= nil, + "#46: a fresh fasl dir is a stdlib image MISS") + + -- Invalidation: the image carries the path and content hash of every file the + -- recorded span loaded, so editing one must miss even though install.shen and + -- the kernel are untouched. Done against a COPY of the tree (SHEN_STDLIB_DIR) + -- so the checkout is never mutated, not even transiently. + do + local tree = os.tmpname(); os.remove(tree) + os.execute("mkdir -p " .. sh_quote(tree)) + os.execute("cp -R " .. sh_quote(here .. "lib/StLib") .. "/. " .. sh_quote(tree)) + local d5 = fresh() + local cp = kc .. " SHEN_STDLIB_DIR=" .. sh_quote(tree) + .. " SHEN_FASL_DIR=" .. sh_quote(d5) .. " SHEN_FASL_DEBUG=1 " + local first = run("env " .. cp .. "luajit " .. sh_quote(script)) + local second = run("env " .. cp .. "luajit " .. sh_quote(script)) + check(first:find("image miss", 1, true) ~= nil, + "#46: first boot against a copied stdlib tree records an image") + check(second:find("image hit", 1, true) ~= nil, + "#46: second boot against the copied tree hits it") + local w = io.open(tree .. "/Lists/lists.shen", "ab") + w:write("\n\\\\ boot_cache_spec probe\n"); w:close() + local edited = run("env " .. cp .. "luajit " .. sh_quote(script)) + check(edited:find("image miss", 1, true) ~= nil, + "#46: editing a standard-library file invalidates the boot image") + os.execute("rm -rf " .. sh_quote(tree) .. " " .. sh_quote(d5)) + end + + os.remove(script); os.remove(kcache) + for _, d in ipairs({ d1, d2, d3, d4 }) do os.execute("rm -rf " .. sh_quote(d)) end +end + +-- --------------------------------------------------------------------------- +-- Part 2 — the two natives against the compiled-KL definitions they replace. +-- +-- shen.assoc-> (reader.kl) and shen.lambda-entry (declarations.kl) are now Lua. +-- Both are load-bearing for shen.*lambdatable* / shen.*sigf* / shen.*datatypes*, +-- so compile the kernel's own definitions under an alias and compare. +-- --------------------------------------------------------------------------- +package.path = here .. "?.lua;" .. package.path +local R = require("runtime") +local C = require("compiler") +local P = require("boot") +P.load_kernel(false) +P.initialise() +local F = P.F + +do + -- shen.assoc->: compile the kernel definition under an alias name. + local src = assert(io.open(here .. "klambda/reader.kl", "rb")):read("*a") + for _, f in ipairs(R.read_all(src)) do + if R.is_cons(f) and R.is_symbol(f[1]) and f[1].name == "defun" + and R.is_cons(f[2]) and R.is_symbol(f[2][1]) + and f[2][1].name == "shen.assoc->" then + P.load_chunk(C.compile_top(f):gsub("shen%.assoc%->", "spec.assoc->"), "alias")() + end + end + local kl = F["spec.assoc->"] + check(kl ~= nil, "#46: kernel shen.assoc-> compiled under an alias") + + local S = R.intern + local function list(...) + local t, a = R.NIL, {...} + for i = #a, 1, -1 do t = R.cons(a[i], t) end + return t + end + local pair = R.cons + local cases = { + { S"a", 1, R.NIL }, -- empty list + { S"a", 1, list(pair(S"a", 9)) }, -- replace only + { S"b", 2, list(pair(S"a", 9)) }, -- append at end + { S"c", 3, list(pair(S"a",9), pair(S"b",8), pair(S"c",7), pair(S"d",6)) }, + { S"a", 3, list(pair(S"a",9), pair(S"b",8), pair(S"a",7)) }, -- first wins + { S"z", 3, list(pair(S"a",9), pair(S"b",8)) }, + { S"z", 3, list(S"not-a-pair", pair(S"b",8)) }, -- non-pair entry + { 5, 3, list(pair(5,9), pair(6,8)) }, -- numeric keys + { "s", 3, list(pair("s",9)) }, -- string keys + { S"a", 1, R.cons(pair(S"b",1), S"improper") }, -- improper tail + { S"a", 1, S"improper" }, -- not a list + } + local bad = 0 + for i, c in ipairs(cases) do + local ok1, r1 = pcall(kl, c[1], c[2], c[3]) + local ok2, r2 = pcall(F["shen.assoc->"], c[1], c[2], c[3]) + -- errors: both must fail (the message names the alias in one case, so the + -- comparison is on success/failure plus the value) + if ok1 ~= ok2 then bad = bad + 1 + elseif ok1 and R.to_str(r1) ~= R.to_str(r2) then bad = bad + 1 end + if bad > 0 and i == #cases then break end + end + check(bad == 0, "#46: native shen.assoc-> matches the compiled-KL definition") +end + +do + -- shen.lambda-entry: rebuild the KL result (eval-kl of shen.lambda-function) + -- and compare full application, partial application, and the arity 0 / -1 + -- cases, over a spread of live arities. + local function kl_entry(name) + local ar = F["arity"](name) + if ar == -1 or ar == 0 then return R.NIL end + return R.cons(name, F["eval-kl"]( + F["shen.lambda-function"](R.cons(name, R.NIL), ar))) + end + local probes = { + { "hd", { R.cons(1, R.cons(2, R.NIL)) } }, + { "cons", { 1, R.NIL } }, + { "append", { R.cons(1, R.NIL), R.cons(2, R.NIL) } }, + { "shen.assoc->", { R.intern("k"), 1, R.NIL } }, + { "reverse", { R.cons(1, R.cons(2, R.NIL)) } }, + { "nth", { 1, R.cons(7, R.NIL) } }, + { "map", { R.intern("hd"), R.cons(R.cons(1, R.NIL), R.NIL) } }, + { "+", { 2, 3 } }, + } + local bad, npartial, nprobed = 0, 0, 0 + for _, p in ipairs(probes) do + local sym = R.intern(p[1]) + local a, b = kl_entry(sym), F["shen.lambda-entry"](sym) + if not (R.is_cons(a) and R.is_cons(b)) then + -- both must agree that this name has no lambda table entry + if R.is_cons(a) ~= R.is_cons(b) then bad = bad + 1 end + goto continue + end + nprobed = nprobed + 1 + local function apply_all(fn) + local cur = fn + for _, x in ipairs(p[2]) do cur = P.APP(cur, x) end + return cur + end + local ok1, r1 = pcall(apply_all, a[2]) + local ok2, r2 = pcall(apply_all, b[2]) + if ok1 ~= ok2 or (ok1 and R.to_str(r1) ~= R.to_str(r2)) then bad = bad + 1 end + if #p[2] > 1 then + -- a partial application must still be a function on both sides + npartial = npartial + 1 + if type(P.APP(a[2], p[2][1])) ~= type(P.APP(b[2], p[2][1])) then bad = bad + 1 end + end + ::continue:: + end + check(bad == 0, "#46: native shen.lambda-entry matches the compiled-KL definition") + check(nprobed >= 6, "#46: lambda-entry differential covered the probe set (" .. nprobed .. ")") + check(npartial > 0, "#46: lambda-entry partial application was exercised") + check(F["shen.lambda-entry"](R.intern("stinput")) == R.NIL, + "#46: lambda-entry is () for an arity-0 name") + check(F["shen.lambda-entry"](R.intern("no-such-function-xyz")) == R.NIL, + "#46: lambda-entry is () for an unknown name") +end + +io.write(("boot_cache_spec: %d pass, %d fail\n"):format(npass, nfail)) +os.exit(nfail == 0 and 0 or 1)