machinechecked 0.1.0__py3-none-any.whl

prooflens/config.py

@@ -0,0 +1,145 @@
+"""The project configuration, `prooflens.toml`."""
+
+from __future__ import annotations
+
+import re
+import tomllib
+from dataclasses import dataclass, field
+from pathlib import Path
+
+STANDARD_AXIOMS = ["propext", "Classical.choice", "Quot.sound"]
+
+
+class ConfigError(ValueError):
+    pass
+
+
+@dataclass
+class Publish:
+    """What of a paper may appear in a public export. Everything defaults to private."""
+
+    pdf: bool = False
+    source_text: bool = False
+    lean: bool = False
+    reviews: bool = False
+
+
+@dataclass
+class Paper:
+    id: str
+    title: str
+    source: dict
+    root: str | None = None
+    pdf: str | None = None
+    commit: str | None = None
+    envs: list[str] | None = None
+    publish: Publish = field(default_factory=Publish)
+
+
+@dataclass
+class Config:
+    path: Path
+    name: str
+    lean_root: Path
+    modules: list[str]
+    scope_roots: list[str]
+    spec_prefix: str
+    accept_prefix: str
+    allowed_axioms: list[str]
+    inventory: Path
+    reviews: list[Path]
+    statement_authors: list[str]
+    ai_reviewers: list[str]
+    dismissals: Path | None
+    comparator_log: Path | None
+    papers: list[Paper]
+    out_dir: Path
+    review_check: str | None = None
+    display: Path | None = None
+    issues: str | None = None         # "owner/repo" where the reader's "Raise issue" opens issues
+    site_url: str | None = None       # the public address of the published site, for permalinks
+    author: str | None = None         # the name the audit is published under (audit.json)
+    repository: str | None = None     # "owner/repo" of the Lean source, if not the git remote
+    repository_private: bool = False  # the reader does not show the repository's name
+
+    @property
+    def root(self) -> Path:
+        return self.path.parent
+
+    def paper(self, pid: str) -> Paper:
+        for p in self.papers:
+            if p.id == pid:
+                return p
+        raise ConfigError(f"no paper {pid!r} in {self.path}")
+
+
+CONFIG_NAMES = ("machinechecked.toml", "prooflens.toml")
+
+
+def work_dir_name(base: Path) -> str:
+    """The working directory's name: `.machinechecked`, or `.prooflens` where one exists."""
+    return ".prooflens" if (base / ".prooflens").is_dir() and \
+        not (base / ".machinechecked").is_dir() else ".machinechecked"
+
+
+def issue_repo(value: str | None, where: str) -> str | None:
+    """A GitHub repository given as `owner/repo` (or its URL), checked."""
+    if not value:
+        return None
+    v = re.sub(r"^(https?://)?(www\.)?github\.com/", "", value.strip()).rstrip("/")
+    v = re.sub(r"\.git$", "", v)
+    if not re.fullmatch(r"[A-Za-z0-9][\w.-]*/[\w.-]+", v):
+        raise ConfigError(f"{where}: issues must be a GitHub repository, owner/repo: {value!r}")
+    return v
+
+
+def _req(d: dict, key: str, where: str):
+    if key not in d:
+        raise ConfigError(f"{where}: missing `{key}`")
+    return d[key]
+
+
+def load(path: str | Path) -> Config:
+    path = Path(path).resolve()
+    with open(path, "rb") as f:
+        raw = tomllib.load(f)
+    base = path.parent
+    proj = _req(raw, "project", str(path))
+    papers = []
+    for p in raw.get("paper", []):
+        src = _req(p, "source", "paper")
+        if not any(k in src for k in ("path", "git", "arxiv")):
+            raise ConfigError(f"paper {p.get('id')}: source needs one of path, git, arxiv")
+        papers.append(Paper(
+            id=_req(p, "id", "paper"), title=p.get("title", p["id"]), source=src,
+            root=p.get("root"), pdf=p.get("pdf"), commit=src.get("rev"), envs=p.get("envs"),
+            publish=Publish(**p.get("publish", {}))))
+    return Config(
+        path=path,
+        name=_req(proj, "name", "project"),
+        lean_root=(base / proj.get("lean_root", ".")).resolve(),
+        modules=_req(proj, "modules", "project"),
+        scope_roots=_req(proj, "scope_roots", "project"),
+        spec_prefix=_req(proj, "spec_prefix", "project"),
+        accept_prefix=_req(proj, "accept_prefix", "project"),
+        allowed_axioms=proj.get("allowed_axioms", STANDARD_AXIOMS),
+        inventory=(base / _req(proj, "inventory", "project")).resolve(),
+        reviews=[(base / r).resolve() for r in proj.get("reviews", [])],
+        statement_authors=proj.get("statement_authors", []),
+        ai_reviewers=proj.get("ai_reviewers", []),
+        dismissals=(base / proj["dismissals"]).resolve() if "dismissals" in proj else None,
+        comparator_log=(base / proj["comparator_log"]).resolve()
+        if "comparator_log" in proj else None,
+        papers=papers,
+        out_dir=(base / proj.get("out_dir", work_dir_name(base))).resolve(),
+        # A command run after promoting reviews (from the configuration's directory): the
+        # project's own acceptance checker, if it has one.
+        review_check=raw.get("review", {}).get("check"),
+        # Display corrections (TeX descriptions, printed numbers), outside the inventory.
+        display=(base / proj["display"]).resolve() if "display" in proj else None,
+        issues=issue_repo(proj.get("issues"), str(path)),
+        site_url=proj.get("site_url"),
+        author=proj.get("author"),
+        repository=issue_repo(proj.get("repository"), str(path)),
+        repository_private=bool(proj.get("repository_private", False)),
+    )

prooflens/data/ProofLensProbe.lean

@@ -0,0 +1,469 @@
+/-!
+# The ProofLens probe
+
+Body of the probe that `prooflens probe` runs inside a Lean project. The CLI prepends
+`import Lean` and the project's modules and runs the result with `lake env lean`, so this file
+has no imports of its own and is not built as part of any library.
+
+Input: the JSON query named by `PROOFLENS_QUERY`. Output: JSON lines written to the file named
+by `PROOFLENS_OUT`, one record per request and one per declaration of the definition closure.
+
+For a specification the record holds two representations of the proposition:
+
+* the verification representation: the declaration, its axioms, the constants it uses, its
+  structural hashes (`legacy_hash`, a 128-bit structural hash kept for compatibility with
+  existing review markers, and `canon`, a canonical serialisation the CLI hashes with SHA-256);
+* the inspection representation: the body of the definition split into a quantifier prefix
+  (universal variables, hypotheses, instances, existential witnesses) and a conclusion, each
+  pretty-printed with the constants it mentions marked for navigation.
+-/
+
+open Lean Meta Elab
+
+namespace ProofLensProbe
+
+/-! ## The query -/
+
+structure Request where
+  kind : String
+  name : String
+  spec : Option String := none
+  deriving FromJson, Inhabited
+
+structure Query where
+  scope_roots : Array String
+  spec_prefix : String
+  accept_prefix : String
+  allowed_axioms : Array String
+  requests : Array Request
+  deriving FromJson, Inhabited
+
+/-! ## Environment helpers -/
+
+def moduleOf (env : Environment) (n : Name) : Name :=
+  match env.getModuleIdxFor? n with
+  | some idx => env.header.moduleNames[idx.toNat]!
+  | none => `«this file»
+
+def inScope (roots : Array Name) (env : Environment) (n : Name) : Bool :=
+  roots.contains (moduleOf env n).getRoot
+
+def kindOf : ConstantInfo → String
+  | .thmInfo _ => "theorem" | .defnInfo _ => "def" | .inductInfo _ => "inductive"
+  | .ctorInfo _ => "ctor" | .opaqueInfo _ => "opaque" | .recInfo _ => "rec"
+  | .axiomInfo _ => "axiom" | .quotInfo _ => "quot"
+
+def rangeJson (n : Name) : MetaM Json := do
+  match ← findDeclarationRanges? n with
+  | some r => return Json.mkObj [("line", r.range.pos.line), ("end_line", r.range.endPos.line)]
+  | none => return Json.null
+
+/-! ## Proof erasure and fingerprints -/
+
+/-- The expression with every proof replaced by one constant, so that hashes see statements and
+data only. -/
+def erase (e : Expr) : MetaM Expr := do
+  let e ← instantiateMVars e
+  transform e (pre := fun x => do
+    if x.isFVar || x.isBVar || x.isSort then return .continue
+    let p ← try isProof x catch _ => pure false
+    if p then return .done (mkConst `«erased proof»)
+    return .continue)
+
+/-- A 64-bit structural hash, blind to binder
+names and metadata; its form is fixed so that existing review markers keep matching. -/
+partial def deepHash (e : Expr) : StateM (Std.HashMap Expr UInt64) UInt64 := do
+  if let some h := (← get)[e]? then return h
+  let h ← match e with
+    | .bvar i => pure (mixHash 11 (hash i))
+    | .fvar i => pure (mixHash 13 (hash i.name.toString))
+    | .mvar i => pure (mixHash 17 (hash i.name.toString))
+    | .sort l => pure (mixHash 19 (hash (toString l)))
+    | .const n ls => pure (mixHash 23 (mixHash (hash n.toString) (hash (toString ls))))
+    | .lit (.natVal k) => pure (mixHash 29 (hash k))
+    | .lit (.strVal t) => pure (mixHash 31 (hash t))
+    | .mdata _ b => deepHash b
+    | .app f a => do pure (mixHash 37 (mixHash (← deepHash f) (← deepHash a)))
+    | .lam _ t b bi => do
+      pure (mixHash 41 (mixHash (hash (toString (repr bi)))
+        (mixHash (← deepHash t) (← deepHash b))))
+    | .forallE _ t b bi => do
+      pure (mixHash 43 (mixHash (hash (toString (repr bi)))
+        (mixHash (← deepHash t) (← deepHash b))))
+    | .letE _ t v b _ => do
+      pure (mixHash 47 (mixHash (← deepHash t) (mixHash (← deepHash v) (← deepHash b))))
+    | .proj s i b => do
+      pure (mixHash 53 (mixHash (hash s.toString) (mixHash (hash i) (← deepHash b))))
+  modify (·.insert e h)
+  return h
+
+def hex (h : UInt64) : String :=
+  let s := String.ofList (Nat.toDigits 16 h.toNat)
+  "".pushn '0' (16 - s.length) ++ s
+
+/-- State of the canonical serialisation: the index of every node already emitted. -/
+structure CanonState where
+  ids : Std.HashMap Expr Nat := {}
+  lines : Array String := #[]
+
+/-- Canonical serialisation of an expression as a table of shared nodes, in post-order. Binder
+names and metadata are omitted; binder kinds, constants, universe levels and literals are kept.
+The table form keeps the size linear in the number of distinct subterms. -/
+partial def canon (e : Expr) : StateM CanonState Nat := do
+  if let some i := (← get).ids[e]? then return i
+  let line ← match e with
+    | .bvar i => pure s!"bvar {i}"
+    | .fvar i => pure s!"fvar {i.name}"
+    | .mvar i => pure s!"mvar {i.name}"
+    | .sort l => pure s!"sort {l}"
+    | .const n ls => pure s!"const {n} {ls}"
+    | .lit (.natVal k) => pure s!"nat {k}"
+    | .lit (.strVal t) => pure s!"str {(toJson t).compress}"
+    | .mdata _ b => return ← canon b
+    | .app f a => do pure s!"app {← canon f} {← canon a}"
+    | .lam _ t b bi => do pure s!"lam {repr bi} {← canon t} {← canon b}"
+    | .forallE _ t b bi => do pure s!"pi {repr bi} {← canon t} {← canon b}"
+    | .letE _ t v b _ => do pure s!"let {← canon t} {← canon v} {← canon b}"
+    | .proj s i b => do pure s!"proj {s} {i} {← canon b}"
+  let s ← get
+  let i := s.lines.size
+  set ({ ids := s.ids.insert e i, lines := s.lines.push line } : CanonState)
+  return i
+
+def canonString (ty : Expr) (val : Option Expr) : String :=
+  let act : StateM CanonState (Nat × Option Nat) := do
+    let t ← canon ty
+    let v ← match val with | some v => some <$> canon v | none => pure none
+    return (t, v)
+  let ((t, v), s) := act.run {}
+  let root := match v with | some v => s!"root {t} {v}" | none => s!"root {t}"
+  "\n".intercalate (s.lines.push root).toList
+
+/-- Fingerprint data of a constant with its proofs erased, and the constants it uses. -/
+def constPrint (ci : ConstantInfo) : MetaM (String × String × Array Name) := do
+  let ty ← erase ci.type
+  let mut used := ty.getUsedConstants
+  let mut vh : UInt64 := 0
+  let mut val : Option Expr := none
+  match ci with
+  | .defnInfo d =>
+    let v ← erase d.value
+    vh := (deepHash v).run' {}
+    val := some v
+    used := used ++ v.getUsedConstants
+  | .inductInfo i => used := used ++ i.ctors.toArray
+  | .ctorInfo c => used := used.push c.induct
+  | _ => pure ()
+  let lvls := " ".intercalate (ci.levelParams.map toString)
+  let c := s!"levels {lvls}\n" ++ canonString ty val
+  return (hex ((deepHash ty).run' {}) ++ hex vh, c, used)
+
+/-! ## Pretty-printing with navigation -/
+
+/-- Flatten tagged code into segments; a segment carries the constant it names when the
+innermost subexpression around it is a constant. -/
+partial def segments (t : Widget.CodeWithInfos) (ref : Option Name) (acc : Array Json) : Array Json :=
+  match t with
+  | Widget.TaggedText.text s =>
+    match ref with
+    | some n => acc.push (Json.mkObj [("t", s), ("ref", n.toString)])
+    | none => acc.push (Json.mkObj [("t", s)])
+  | Widget.TaggedText.append xs => xs.foldl (fun a x => segments x ref a) acc
+  | Widget.TaggedText.tag info sub =>
+    let r := match info.info.val.info with
+      | .ofTermInfo ti => if let .const n _ := ti.expr then some n else none
+      | _ => none
+    segments sub (r <|> none) acc
+
+/-- The pretty-printed expression with navigable constants; plain text if tagging fails, and a
+marker if printing fails, so that one large term cannot stop the probe. -/
+def ppJson (e : Expr) : MetaM Json := do
+  try
+    let code ← Widget.ppExprTagged e
+    let text := toString (← ppExpr e)
+    return Json.mkObj [("text", text), ("segments", Json.arr (segments code none #[]))]
+  catch _ =>
+    try
+      return Json.mkObj [("text", toString (← ppExpr e))]
+    catch err =>
+      return Json.mkObj [("text", "(not printable)"), ("error", toString (← err.toMessageData.toString))]
+
+/-! ## The inspection representation -/
+
+def isExistsApp (e : Expr) : Option (Name × Expr) :=
+  if e.isAppOfArity ``Exists 2 then
+    match e.appArg! with
+    | .lam n _ _ _ => some (n, e.appArg!)
+    | _ => none
+  else none
+
+/-- Split a proposition into its quantifier prefix and its conclusion. Universal binders are
+`forall` (data), `hypothesis` (a proposition) or `instance`; existential binders are `exists`.
+Definitions are not unfolded: the prefix is the one written in the specification. -/
+partial def telescope (e : Expr) (acc : Array Json) : MetaM (Array Json × Json) := do
+  match e with
+  | .forallE n t body bi =>
+    let isHyp ← isProp t
+    let role :=
+      if bi.isInstImplicit then "instance" else if isHyp then "hypothesis" else "forall"
+    let tj ← ppJson t
+    withLocalDecl n bi t fun x => do
+      let hyps := (acc.filter fun j => j.getObjValD "role" == Json.str "hypothesis").size
+      let nm := if n.hasMacroScopes || n.isAnonymous then s!"h{hyps + 1}"
+        else n.toString
+      let j := Json.mkObj [("role", role), ("name", nm),
+        ("type", tj), ("binder", binderStr bi)]
+      telescope (body.instantiate1 x) (acc.push j)
+  | _ =>
+    match isExistsApp e with
+    | some (_, .lam n t body bi) =>
+      let tj ← ppJson t
+      withLocalDecl n bi t fun x => do
+        let j := Json.mkObj [("role", "exists"), ("name", n.eraseMacroScopes.toString),
+          ("type", tj), ("binder", binderStr bi)]
+        telescope (body.instantiate1 x) (acc.push j)
+    | _ => return (acc, ← ppJson e)
+where
+  binderStr : BinderInfo → String
+    | .default => "explicit" | .implicit => "implicit"
+    | .strictImplicit => "strict-implicit" | .instImplicit => "instance"
+
+/-- Constants of the project that `e` uses directly. -/
+def projectConsts (roots : Array Name) (e : Expr) : MetaM (Array String) := do
+  let env ← getEnv
+  return e.getUsedConstants.filter (inScope roots env) |>.map toString
+
+/-! ## Records -/
+
+def emit (h : IO.FS.Handle) (j : Json) : IO Unit := h.putStrLn j.compress
+
+def declRecord (roots : Array Name) (n : Name) (ci : ConstantInfo) : MetaM (Json × Array Name) := do
+  let env ← getEnv
+  let (lh, c, used) ← constPrint ci
+  let sig ← ppJson ci.type
+  let value ← match ci with
+    | .defnInfo d =>
+      if (← isProp ci.type) then pure Json.null
+      else do
+        let v ← ppJson d.value
+        pure (if v.compress.length > 20000 then Json.null else v)
+    | _ => pure Json.null
+  let doc ← findDocString? env n
+  let j := Json.mkObj [
+    ("record", "decl"), ("name", n.toString), ("kind", kindOf ci),
+    ("module", (moduleOf env n).toString), ("range", ← rangeJson n),
+    ("doc", match doc with | some d => Json.str d | none => Json.null),
+    ("legacy_hash", lh), ("canon", c), ("signature", sig), ("value", value),
+    ("uses", Json.arr ((used.filter fun u => inScope roots env u && !u.isInternal).map
+      (Json.str ·.toString)))]
+  return (j, used)
+
+def emitClosure (h : IO.FS.Handle) (roots : Array Name) (root : Name) (used : Array Name)
+    (seen : IO.Ref NameSet) : MetaM (Array String) := do
+  let env ← getEnv
+  let mut stack := used
+  let mut members : Array String := #[]
+  let mut visited : NameSet := {}
+  while !stack.isEmpty do
+    let n := stack.back!
+    stack := stack.pop
+    if visited.contains n || n == root then continue
+    visited := visited.insert n
+    unless inScope roots env n do continue
+    let some c := env.find? n | continue
+    members := members.push n.toString
+    let (j, more) ← declRecord roots n c
+    unless (← seen.get).contains n do
+      seen.modify (·.insert n)
+      emit h j
+    stack := stack ++ more
+  return members.qsort (· < ·)
+
+def disallowed (allowed : Array Name) (axs : Array Name) : Array Name :=
+  axs.filter (!allowed.contains ·)
+
+def specRecord (h : IO.FS.Handle) (q : Query) (roots : Array Name) (seen : IO.Ref NameSet)
+    (spec : Name) : MetaM Unit := do
+  let env ← getEnv
+  let some ci := env.find? spec
+    | emit h (Json.mkObj [("record", "spec"), ("name", spec.toString), ("errors", toJson #["missing"])])
+  let mut errs : Array String := #[]
+  unless ci matches .defnInfo _ do errs := errs.push "not-a-def"
+  unless ci.type == .sort .zero do errs := errs.push "type-not-Prop"
+  unless q.spec_prefix.toName.isPrefixOf (moduleOf env spec) do errs := errs.push "outside-spec-layer"
+  let axs ← collectAxioms spec
+  let bad := disallowed (q.allowed_axioms.map (·.toName)) axs
+  unless bad.isEmpty do errs := errs.push s!"axioms={bad.toList}"
+  let (j, used) ← declRecord roots spec ci
+  let (binders, concl) ← match ci with
+    | .defnInfo d => telescope d.value #[]
+    | _ => pure (#[], Json.null)
+  let closure ← emitClosure h roots spec used seen
+  let direct ← match ci with
+    | .defnInfo d => projectConsts roots d.value
+    | _ => pure #[]
+  let consts := match ci with
+    | .defnInfo d => d.value.getUsedConstants.map toString
+    | _ => #[]
+  emit h (Json.mkObj [("record", "spec"), ("name", spec.toString), ("errors", toJson errs),
+    ("axioms", toJson (axs.map toString)), ("decl", j),
+    ("binders", Json.arr binders), ("conclusion", concl),
+    ("direct", toJson direct), ("consts", toJson consts), ("closure", toJson closure)])
+
+def levelsMatch (ls : List Level) (params : List Name) : Bool :=
+  let ps := ls.filterMap fun l => match l with | .param p => some p | _ => none
+  ps.length == ls.length && ps.eraseDups.length == ps.length && ps.length == params.length
+    && params.all ps.contains
+
+/-- `accept`: the type is exactly the specification; `refute`: exactly its negation; `witness`:
+any theorem of the acceptance layer. -/
+def proofRecord (h : IO.FS.Handle) (q : Query) (kind : String) (thm : Name)
+    (spec : Option Name) : MetaM Unit := do
+  let env ← getEnv
+  let some ci := env.find? thm
+    | emit h (Json.mkObj [("record", kind), ("name", thm.toString), ("errors", toJson #["missing"])])
+  let mut errs : Array String := #[]
+  unless ci matches .thmInfo _ do errs := errs.push "not-a-theorem"
+  unless q.accept_prefix.toName.isPrefixOf (moduleOf env thm) do
+    errs := errs.push "outside-accept-layer"
+  match kind, spec with
+  | "accept", some s =>
+    match ci.type with
+    | .const c ls => unless c == s && levelsMatch ls ci.levelParams do errs := errs.push "type-not-spec"
+    | _ => errs := errs.push "type-not-spec"
+  | "refute", some s =>
+    match ci.type with
+    | .app (.const ``Not []) (.const c _) => unless c == s do errs := errs.push "type-not-negated-spec"
+    | .forallE _ (.const c _) (.const ``False []) _ =>
+      unless c == s do errs := errs.push "type-not-negated-spec"
+    | _ => errs := errs.push "type-not-negated-spec"
+  | _, _ => pure ()
+  let axs ← collectAxioms thm
+  let bad := disallowed (q.allowed_axioms.map (·.toName)) axs
+  unless bad.isEmpty do errs := errs.push s!"axioms={bad.toList}"
+  let ty ← ppJson ci.type
+  emit h (Json.mkObj [("record", kind), ("name", thm.toString),
+    ("spec", match spec with | some s => Json.str s.toString | none => Json.null),
+    ("errors", toJson errs), ("axioms", toJson (axs.map toString)),
+    ("type", ty), ("module", (moduleOf env thm).toString), ("range", ← rangeJson thm),
+    ("sorry", toJson (axs.contains ``sorryAx))])
+
+/-- Whether a name is one a reader looks for: not generated by the compiler or elaborator. -/
+def userFacing (n : Name) : Bool :=
+  !n.isInternal && !(n.components.any fun c =>
+    let s := c.toString
+    s.startsWith "_" || s.startsWith "match_" || s.startsWith "proof_" || s == "eq_def"
+      || s.startsWith "eq_" && (s.drop 3).all Char.isDigit)
+
+/-- Every user-facing theorem, definition and type declared in the modules of `roots`: name,
+kind, module, line, docstring and statement as text. -/
+def indexRecords (h : IO.FS.Handle) (roots : Array Name) : MetaM Unit := do
+  let env ← getEnv
+  let names := env.header.moduleNames
+  for i in [:names.size] do
+    let mod := names[i]!
+    unless roots.contains mod.getRoot do continue
+    for n in env.header.moduleData[i]!.constNames do
+      unless userFacing n do continue
+      let some ci := env.find? n | continue
+      let kind := match ci with
+        | .thmInfo _ => some "theorem" | .defnInfo _ => some "def"
+        | .inductInfo _ => some "inductive" | .opaqueInfo _ => some "opaque"
+        | .axiomInfo _ => some "axiom" | _ => none
+      let some k := kind | continue
+      if k == "def" && (← isInstance n) then continue
+      let ty ← try pure (toString (← ppExpr ci.type)) catch _ => pure "(not printable)"
+      let doc ← findDocString? env n
+      emit h (Json.mkObj [("record", "index"), ("name", n.toString), ("kind", k),
+        ("module", mod.toString), ("range", ← rangeJson n),
+        ("doc", match doc with | some d => Json.str d | none => Json.null),
+        ("type", if ty.length > 4000 then (ty.take 4000).toString ++ " …" else ty)])
+
+/-- A theorem of a link: its statement split like a specification, and its axioms. -/
+def linkRecord (h : IO.FS.Handle) (q : Query) (roots : Array Name) (seen : IO.Ref NameSet)
+    (n : Name) : MetaM Unit := do
+  let env ← getEnv
+  let some ci := env.find? n
+    | emit h (Json.mkObj [("record", "link"), ("name", n.toString), ("errors", toJson #["missing"])])
+  -- A theorem whose type is a closed proposition (a locked statement) shows that proposition.
+  let stmt ← match ci.type with
+    | .const c _ => match env.find? c with
+      | some (.defnInfo d) => if d.type == .sort .zero then pure d.value else pure ci.type
+      | _ => pure ci.type
+    | _ => pure ci.type
+  let (binders, concl) ← telescope stmt #[]
+  let axs ← collectAxioms n
+  let bad := disallowed (q.allowed_axioms.map (·.toName)) axs
+  let (j, used) ← declRecord roots n ci
+  let closure ← emitClosure h roots n used seen
+  emit h (Json.mkObj [("record", "link"), ("name", n.toString), ("kind", kindOf ci),
+    ("errors", toJson (if bad.isEmpty then #[] else #[s!"axioms={bad.toList}"])),
+    ("axioms", toJson (axs.map toString)), ("sorry", toJson (axs.contains ``sorryAx)),
+    ("decl", j), ("binders", Json.arr binders), ("conclusion", concl),
+    ("closure", toJson closure)])
+
+/-- Every module of the specification layer that imports a module of the acceptance layer. -/
+def layering (h : IO.FS.Handle) (q : Query) : CoreM Unit := do
+  let env ← getEnv
+  let names := env.header.moduleNames
+  let mut violations : Array Json := #[]
+  for i in [:names.size] do
+    let mod := names[i]!
+    unless q.spec_prefix.toName.isPrefixOf mod do continue
+    let mut seen : NameSet := {}
+    let mut stack : Array Name := #[mod]
+    while !stack.isEmpty do
+      let m := stack.back!
+      stack := stack.pop
+      if seen.contains m then continue
+      seen := seen.insert m
+      if q.accept_prefix.toName.isPrefixOf m then
+        violations := violations.push (Json.mkObj [("module", mod.toString), ("imports", m.toString)])
+      let some idx := env.getModuleIdx? m | continue
+      for imp in env.header.moduleData[idx.toNat]!.imports do
+        stack := stack.push imp.module
+  emit h (Json.mkObj [("record", "layering"), ("violations", Json.arr violations)])
+
+end ProofLensProbe
+
+open ProofLensProbe in
+#eval show MetaM Unit from do
+  let some qpath ← IO.getEnv "PROOFLENS_QUERY" | throwError "PROOFLENS_QUERY unset"
+  let some opath ← IO.getEnv "PROOFLENS_OUT" | throwError "PROOFLENS_OUT unset"
+  let q ← match (Json.parse (← IO.FS.readFile qpath)) >>= fromJson? (α := Query) with
+    | .ok q => pure q
+    | .error e => throwError s!"bad query: {e}"
+  let roots := q.scope_roots.map (·.toName)
+  let seen ← IO.mkRef ({} : NameSet)
+  let h ← IO.FS.Handle.mk opath .write
+  do
+    emit h (Json.mkObj [("record", "env"), ("lean", Lean.versionString),
+      ("githash", Lean.githash)])
+    layering h q
+    for r in q.requests do
+      -- Each request has its own heartbeat budget.
+      try withCurrHeartbeats <|
+        match r.kind with
+        | "spec" => specRecord h q roots seen r.name.toName
+        | "accept" | "refute" => proofRecord h q r.kind r.name.toName (r.spec.map (·.toName))
+        | "witness" => proofRecord h q "witness" r.name.toName none
+        | "index" => indexRecords h roots
+        | "link" => linkRecord h q roots seen r.name.toName
+        | "decl" => do
+          let env ← getEnv
+          if let some ci := env.find? r.name.toName then
+            let (j, used) ← declRecord roots r.name.toName ci
+            seen.modify (·.insert r.name.toName)
+            emit h j
+            let members ← emitClosure h roots r.name.toName used seen
+            emit h (Json.mkObj [("record", "defclosure"), ("name", r.name),
+              ("closure", toJson members)])
+          else
+            emit h (Json.mkObj [("record", "defclosure"), ("name", r.name),
+              ("errors", toJson #["missing"])])
+        | _ => pure ()
+      catch err =>
+        emit h (Json.mkObj [("record", if r.kind == "decl" then "defclosure" else r.kind),
+          ("name", r.name), ("spec", match r.spec with | some x => Json.str x | none => Json.null),
+          ("errors", toJson #[s!"probe-error: {← err.toMessageData.toString}"])])
+    emit h (Json.mkObj [("record", "done")])