793b55f1f3
5d: document the seed↔overlay boundary and add a drift check. core fns split across a Janet seed (core-X, registered in core-bindings) and a Clojure overlay; five names (char?/sorted?/sorted-map?/sorted-set?/transduce) carry a defn in both, with the overlay copy authoritative and the seed copy internal-only. The into-vs-transduce home asymmetry was undocumented. Adds docs/seed-overlay-registry.md, SEED-TWIN: comments at the five seed sites, and a build-time drift check (test/unit/seed-overlay-registry-test.janet) that recomputes the twin set from source and fails if it diverges or a twin leaks into core-bindings. 5e: rep↔API pointer comments in pv/plist/phm/phs/lazyseq (representation lives here; Clojure-facing ops dispatch in core_coll/core_types) and back-pointers in core_coll. No behavior change — comments, docs, one source-analysis test. Full gate green (suite ≥4695 pass / ≥88 clean files), drift check passes.
104 lines
4.2 KiB
Text
104 lines
4.2 KiB
Text
# Drift check for the seed ↔ overlay boundary (refactor phase 5d).
|
|
#
|
|
# Recomputes the dispatch-twin set from source and asserts it matches what
|
|
# docs/seed-overlay-registry.md documents. A twin is a name with BOTH a seed
|
|
# `core-X` defn (src/jolt/*.janet) and an overlay `(defn X …)`
|
|
# (jolt-core/clojure/core/*.clj). If you add, remove, or re-home a twin, update
|
|
# the doc table and the EXPECTED-TWINS set below together.
|
|
#
|
|
# This is source analysis, not Clojure eval — a plain Janet test (no harness).
|
|
|
|
(def repo-root
|
|
# test/unit/<this> -> repo root is two levels up
|
|
(let [d (os/cwd)] d))
|
|
|
|
(defn- slurp-safe [path]
|
|
(try (slurp path) ([_] nil)))
|
|
|
|
(defn- files-with-ext [dir ext]
|
|
(def acc @[])
|
|
(each name (os/dir dir)
|
|
(def full (string dir "/" name))
|
|
(case (os/stat full :mode)
|
|
:directory (array/concat acc (files-with-ext full ext))
|
|
:file (when (string/has-suffix? ext name) (array/push acc full))))
|
|
acc)
|
|
|
|
# Collect bare names from `(defn NAME` / `(defn- NAME`, optionally stripping a
|
|
# `prefix` (e.g. "core-") and keeping only those that had the prefix.
|
|
(defn- defn-names [src prefix]
|
|
(def names @{})
|
|
(def pat (peg/compile
|
|
~{:sym (capture (some (+ (range "az" "AZ" "09") (set "*?!<>=+/.&_-"))))
|
|
:defn (* "(defn" (? "-") (some (set " \t")) :sym)
|
|
:main (some (+ :defn 1))}))
|
|
(each m (or (peg/match pat src) @[])
|
|
(when (string? m)
|
|
(if prefix
|
|
(when (string/has-prefix? prefix m)
|
|
(put names (string/slice m (length prefix)) true))
|
|
(put names m true))))
|
|
names)
|
|
|
|
(defn- merge-into [dst src] (eachk k src (put dst k true)) dst)
|
|
|
|
# --- seed core-X names across src/jolt/*.janet ---
|
|
(def seed-names @{})
|
|
(each f (files-with-ext (string repo-root "/src/jolt") ".janet")
|
|
(merge-into seed-names (defn-names (slurp f) "core-")))
|
|
|
|
# --- overlay public defns across jolt-core/clojure/core/*.clj ---
|
|
(def overlay-names @{})
|
|
(each f (files-with-ext (string repo-root "/jolt-core/clojure/core") ".clj")
|
|
(merge-into overlay-names (defn-names (slurp f) nil)))
|
|
|
|
# --- twins = intersection ---
|
|
(def twins @{})
|
|
(eachk k seed-names (when (get overlay-names k) (put twins k true)))
|
|
|
|
(def EXPECTED-TWINS
|
|
{"char?" true "sorted?" true "sorted-map?" true "sorted-set?" true
|
|
"transduce" true})
|
|
|
|
(defn- keyset [t] (sort (keys t)))
|
|
|
|
(unless (deep= (keyset twins) (keyset EXPECTED-TWINS))
|
|
(error (string "seed↔overlay twin drift!\n"
|
|
" computed: " (string/join (keyset twins) ", ") "\n"
|
|
" expected: " (string/join (keyset EXPECTED-TWINS) ", ") "\n"
|
|
" Update docs/seed-overlay-registry.md and EXPECTED-TWINS together.")))
|
|
|
|
# --- core-bindings registered keys (the public/dispatch registration table) ---
|
|
(def core-src (slurp (string repo-root "/src/jolt/core.janet")))
|
|
(def bind-start (string/find "@{" core-src (string/find "core-bindings" core-src)))
|
|
# brace-match from the `@{` to its close
|
|
(defn- match-brace [src open]
|
|
(var depth 0) (var i open) (var end nil)
|
|
(while (and (< i (length src)) (nil? end))
|
|
(case (src i)
|
|
(chr "{") (++ depth)
|
|
(chr "}") (do (-- depth) (when (= depth 0) (set end i))))
|
|
(++ i))
|
|
end)
|
|
(def bind-end (match-brace core-src (+ bind-start 1)))
|
|
(def bind-region (string/slice core-src bind-start (+ bind-end 1)))
|
|
(def registered @{})
|
|
(each m (or (peg/match ~(some (+ (* "\"" (capture (some (if-not "\"" 1))) "\"") 1)) bind-region) @[])
|
|
(put registered m true))
|
|
|
|
# Twins must NOT be registered — the overlay copy shadows; the seed copy is
|
|
# internal-only. A twin sneaking into core-bindings means the seed copy is
|
|
# masquerading as the public binding.
|
|
(eachk t EXPECTED-TWINS
|
|
(when (get registered t)
|
|
(error (string "twin '" t "' is registered in core-bindings — it should be "
|
|
"overlay-public only (see docs/seed-overlay-registry.md)"))))
|
|
|
|
# The seed-public anchors must stay registered (guards the into/transduce
|
|
# asymmetry the registry documents).
|
|
(each anchor ["into" "reduce"]
|
|
(unless (get registered anchor)
|
|
(error (string "seed-public anchor '" anchor "' missing from core-bindings"))))
|
|
|
|
(print "seed↔overlay registry: " (length (keys twins)) " twins, "
|
|
(length (keys registered)) " registered bindings — OK")
|