|
| 1 | +/- |
| 2 | +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. |
| 3 | +Released under Apache 2.0 license as described in the file LICENSE. |
| 4 | +Authors: Kim Morrison |
| 5 | +-/ |
| 6 | + |
| 7 | +module |
| 8 | + |
| 9 | +public import Lean |
| 10 | +public import HexInterval.Experiment.SemanticReplay |
| 11 | + |
| 12 | +@[expose] public section |
| 13 | + |
| 14 | +/-! |
| 15 | +# Extensible goal reification |
| 16 | +
|
| 17 | +This experiment derives a typed expression program and checker input from Lean |
| 18 | +expressions without a central case split over mathematical functions. Each |
| 19 | +package owns one operation signature and a recognizer for that operation. |
| 20 | +Reification tries all packages with the requested output domain, rejects |
| 21 | +ambiguous matches, recursively reifies arguments in signature order, and |
| 22 | +performs exact-expression common-subexpression elimination. |
| 23 | +
|
| 24 | +Fact parsing is a separate adapter. It maps caller propositions to a term, |
| 25 | +domain, and fact. Unrecognized hypotheses are ignored, while the target must |
| 26 | +be recognized exactly. This division lets interval domains choose their own |
| 27 | +open/closed fact language without putting it in the expression-DAG builder. |
| 28 | +-/ |
| 29 | + |
| 30 | +namespace Hex.Interval.Experiment.GoalFrontend |
| 31 | + |
| 32 | +open Lean Meta |
| 33 | +open Propagator SemanticReplay |
| 34 | + |
| 35 | +/-- Deterministic bounds for package discovery and recursive graph building. -/ |
| 36 | +structure Limits where |
| 37 | + maxPackages : Nat |
| 38 | + maxNodes : Nat |
| 39 | + maxDepth : Nat |
| 40 | + deriving DecidableEq, Repr |
| 41 | + |
| 42 | +/-- One package-owned Lean-syntax view of an opaque engine operation. |
| 43 | +
|
| 44 | +Nullary packages represent caller variables or constants. A recognizer must |
| 45 | +return arguments in the exact order declared by `operation.inputs`. -/ |
| 46 | +structure Package where |
| 47 | + operation : Operation |
| 48 | + recognize : Expr → MetaM (Option (List Expr)) |
| 49 | + |
| 50 | +/-- A validated operation/recognizer registry. -/ |
| 51 | +structure Registry where |
| 52 | + private mk :: |
| 53 | + limits : Limits |
| 54 | + packages : Array Package |
| 55 | + operations : Array Operation |
| 56 | + |
| 57 | +private def makeRegistry (limits : Limits) (packages : Array Package) |
| 58 | + (operations : Array Operation) : Registry := |
| 59 | + { limits, packages, operations } |
| 60 | + |
| 61 | +namespace Registry |
| 62 | + |
| 63 | +private def uniqueKeys : List Operation → Bool |
| 64 | + | [] => true |
| 65 | + | operation :: rest => |
| 66 | + !(rest.any fun other => other.key == operation.key) && uniqueKeys rest |
| 67 | + |
| 68 | +/-- Validate finite package assembly before inspecting a goal. -/ |
| 69 | +opaque build (limits : Limits) (packages : Array Package) : |
| 70 | + Except String Registry := do |
| 71 | + if packages.size > limits.maxPackages then |
| 72 | + throw "too many goal-reification packages" |
| 73 | + let operations := packages.map (fun package => package.operation) |
| 74 | + if !uniqueKeys operations.toList then |
| 75 | + throw "duplicate goal-reification operation key" |
| 76 | + pure (makeRegistry limits packages operations) |
| 77 | + |
| 78 | +end Registry |
| 79 | + |
| 80 | +/-- One exact Lean expression already assigned to a graph node and domain. -/ |
| 81 | +structure TermRef where |
| 82 | + expression : Expr |
| 83 | + domain : DomainId |
| 84 | + node : NodeId |
| 85 | + |
| 86 | +/-- Mutable-by-return graph construction state. -/ |
| 87 | +structure State where |
| 88 | + nodes : Array Node := #[] |
| 89 | + terms : Array TermRef := #[] |
| 90 | + |
| 91 | +/-- A proposition parsed into one fact about one Lean term. -/ |
| 92 | +structure Claim (Fact : Type) where |
| 93 | + expression : Expr |
| 94 | + domain : DomainId |
| 95 | + fact : Fact |
| 96 | + |
| 97 | +/-- Domain-specific recognition of hypotheses and the requested target. -/ |
| 98 | +structure Parser (Fact : Type) where |
| 99 | + parse : Expr → MetaM (Option (Claim Fact)) |
| 100 | + |
| 101 | +/-- One caller proposition contributing to a version-zero meet. -/ |
| 102 | +structure Assumption (Fact : Type) where |
| 103 | + fact : Fact |
| 104 | + proof : Expr |
| 105 | + |
| 106 | +/-- Complete provenance for one caller-owned version-zero fact. |
| 107 | +
|
| 108 | +The empty list denotes domain top. Each later entry must be combined in order |
| 109 | +through the fact-domain meet theorem, so several hypotheses about the same |
| 110 | +expression cannot overwrite one another's proof dependency. -/ |
| 111 | +structure Seed (Fact : Type) where |
| 112 | + assumptions : List (Assumption Fact) := [] |
| 113 | + |
| 114 | +/-- Exact frontend result, including the syntax-to-node map needed to connect |
| 115 | +kernel expressions to the opaque program. -/ |
| 116 | +structure Result (Fact : Type) where |
| 117 | + input : CheckerInput Fact |
| 118 | + baseFacts : List (NodeFact Fact) |
| 119 | + seeds : Array (Seed Fact) |
| 120 | + terms : Array TermRef |
| 121 | + |
| 122 | +def State.find? (state : State) (expression : Expr) (domain : DomainId) : |
| 123 | + Option NodeId := do |
| 124 | + let found ← state.terms.toList.find? fun term => |
| 125 | + term.domain == domain && term.expression == expression |
| 126 | + pure found.node |
| 127 | + |
| 128 | +/-- Select exactly one package for an expression and expected output domain. |
| 129 | +No matching package is ordinary absence; malformed or ambiguous matches remain |
| 130 | +hard errors. -/ |
| 131 | +def select? (registry : Registry) (expression : Expr) (domain : DomainId) : |
| 132 | + MetaM (Option (Nat × Package × List Expr)) := do |
| 133 | + let mut selected : Option (Nat × Package × List Expr) := none |
| 134 | + for index in [0:registry.packages.size] do |
| 135 | + let some package := registry.packages[index]? |
| 136 | + | throwError "interval goal frontend: package index escaped its registry" |
| 137 | + if package.operation.output == domain then |
| 138 | + let match? ← withoutModifyingState <| package.recognize expression |
| 139 | + match match? with |
| 140 | + | none => pure () |
| 141 | + | some arguments => |
| 142 | + if arguments.length != package.operation.inputs.length then |
| 143 | + throwError |
| 144 | + "interval goal frontend: package returned the wrong argument count" |
| 145 | + if selected.isSome then |
| 146 | + throwError "interval goal frontend: ambiguous expression package" |
| 147 | + selected := some (index, package, arguments) |
| 148 | + pure selected |
| 149 | + |
| 150 | +/-- Recursively append one expression and its dependencies to the SSA graph. |
| 151 | +Absence means that the expression is unsupported or exceeds the graph budget; |
| 152 | +the input state is immutable, so a caller may discard the whole attempt. -/ |
| 153 | +partial def reifyTerm? (registry : Registry) (expression : Expr) |
| 154 | + (domain : DomainId) (depth : Nat) (state : State) : |
| 155 | + MetaM (Option (NodeId × State)) := do |
| 156 | + if registry.limits.maxDepth < depth then |
| 157 | + return none |
| 158 | + if let some node := state.find? expression domain then |
| 159 | + return some (node, state) |
| 160 | + let some (operationIndex, package, arguments) ← |
| 161 | + select? registry expression domain |
| 162 | + | return none |
| 163 | + let mut state := state |
| 164 | + let mut nodes := [] |
| 165 | + for (argument, argumentDomain) in arguments.zip package.operation.inputs do |
| 166 | + let some (node, next) ← |
| 167 | + reifyTerm? registry argument argumentDomain (depth + 1) state |
| 168 | + | return none |
| 169 | + state := next |
| 170 | + nodes := nodes.concat node |
| 171 | + if registry.limits.maxNodes ≤ state.nodes.size then |
| 172 | + return none |
| 173 | + let node : NodeId := { index := state.nodes.size } |
| 174 | + let instruction : Node := |
| 175 | + { domain |
| 176 | + op := { index := operationIndex } |
| 177 | + args := nodes } |
| 178 | + pure <| some |
| 179 | + (node, |
| 180 | + { nodes := state.nodes.push instruction |
| 181 | + terms := state.terms.push { expression, domain, node } }) |
| 182 | + |
| 183 | +private def installedFact (domain : FactDomain Fact) (nodeDomain : DomainId) |
| 184 | + (current proposed : Fact) : Except String Fact := |
| 185 | + match domain.narrow nodeDomain current proposed with |
| 186 | + | .noChange => pure current |
| 187 | + | .improved installed | .contradiction installed => pure installed |
| 188 | + | .malformed _ => throw "malformed caller interval fact" |
| 189 | + | .resourceLimit _ => throw "caller interval fact exceeded its resource bound" |
| 190 | + |
| 191 | +/-- Reify a target and all recognized local hypotheses into one checker input. |
| 192 | +
|
| 193 | +The target is traversed first, so its node and dependencies have stable early |
| 194 | +identifiers. Later hypotheses reuse those nodes by exact-expression CSE and |
| 195 | +may append additional expressions needed only by their facts. -/ |
| 196 | +opaque reify (registry : Registry) (factDomain : FactDomain Fact) |
| 197 | + (parser : Parser Fact) (hypotheses : List (Expr × Expr)) (target : Expr) : |
| 198 | + MetaM (Result Fact) := do |
| 199 | + let some targetClaim ← withoutModifyingState <| parser.parse target |
| 200 | + | throwError "interval goal frontend: target is not an interval claim" |
| 201 | + let some (targetNode, initial) ← |
| 202 | + reifyTerm? registry targetClaim.expression targetClaim.domain 0 {} |
| 203 | + | throwError "interval goal frontend: target expression is unsupported or exceeds its resource bound" |
| 204 | + let mut state := initial |
| 205 | + let mut assumed : List (NodeFact Fact × Expr) := [] |
| 206 | + for (proposition, proof) in hypotheses do |
| 207 | + let parsed ← withoutModifyingState <| parser.parse proposition |
| 208 | + match parsed with |
| 209 | + | none => pure () |
| 210 | + | some claim => |
| 211 | + match ← reifyTerm? registry claim.expression claim.domain 0 state with |
| 212 | + | none => pure () |
| 213 | + | some (node, next) => |
| 214 | + state := next |
| 215 | + assumed := assumed.concat ({ node, fact := claim.fact }, proof) |
| 216 | + let program : Program := |
| 217 | + { operations := registry.operations |
| 218 | + nodes := state.nodes } |
| 219 | + unless program.check do |
| 220 | + throwError "interval goal frontend: reified program failed structural validation" |
| 221 | + let mut facts := #[] |
| 222 | + let mut seeds := #[] |
| 223 | + for index in [0:state.nodes.size] do |
| 224 | + let some instruction := state.nodes[index]? |
| 225 | + | throwError "interval goal frontend: node index escaped the graph" |
| 226 | + facts := facts.push (factDomain.top instruction.domain) |
| 227 | + seeds := seeds.push {} |
| 228 | + for (fact, proof) in assumed do |
| 229 | + let some instruction := state.nodes[fact.node.index]? |
| 230 | + | throwError "interval goal frontend: assumption node escaped the graph" |
| 231 | + let some current := facts[fact.node.index]? |
| 232 | + | throwError "interval goal frontend: assumption fact escaped the graph" |
| 233 | + let some seed := seeds[fact.node.index]? |
| 234 | + | throwError "interval goal frontend: assumption seed escaped the graph" |
| 235 | + let installed ← |
| 236 | + match installedFact factDomain instruction.domain current fact.fact with |
| 237 | + | .ok installed => pure installed |
| 238 | + | .error message => throwError "interval goal frontend: {message}" |
| 239 | + facts := facts.set! fact.node.index installed |
| 240 | + seeds := seeds.set! fact.node.index |
| 241 | + { assumptions := seed.assumptions.concat { fact := fact.fact, proof } } |
| 242 | + let targetFact : NodeFact Fact := |
| 243 | + { node := targetNode, fact := targetClaim.fact } |
| 244 | + pure |
| 245 | + { input := |
| 246 | + { baseProgram := program |
| 247 | + initialFacts := facts |
| 248 | + target := targetFact } |
| 249 | + baseFacts := |
| 250 | + List.ofFn fun index : Fin facts.size => |
| 251 | + { node := { index := index.val }, fact := facts[index] } |
| 252 | + seeds |
| 253 | + terms := state.terms } |
| 254 | + |
| 255 | +end Hex.Interval.Experiment.GoalFrontend |
0 commit comments