From 0fe83f69458605bed63f14ddef3bfdd5d5054cc2 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Wed, 15 Jul 2026 10:09:32 +0000 Subject: [PATCH 01/35] feat: support join points in vcgen via synthetic backward rules This PR adds `+jp` shared-continuation handling to `vcgen`: when the branches of an `if`/`match` share a trailing continuation (a `__do_jp` join point), the continuation is verified once instead of being duplicated into every branch, avoiding the exponential growth in verification conditions on nested splits. At a `let __do_jp := fun args => body; rest` whose `rest` is a splitter, `tryJoinPointDef` registers a synthetic `Triple` spec for `__do_jp` keyed on `@fv joinParams` and splits into the join-point body and the rest; each jump `__do_jp args` then discharges through the normal `applySpec` pipeline, with `tryAssignJPHyps` filling the alt-specific precondition and `tryRwSplitterRHS` reducing the resulting `Pjp args`. The join-point fvar is re-marked nondep after introduction so its spec keys on the fvar rather than the zeta-reduced body. Tests: `tests/elab/vcgenJPs.lean` exercises `vcgen +jp` on multi-`if` pure and stateful programs; `tests/elab/symZetaJPMwe.lean` isolates the `Sym.introN`/`preprocessType` zeta; `tests/bench/vcgen` adds an `IfsJP` bench case. --- .../Tactic/Do/Internal/VCGen/Context.lean | 25 +- .../Elab/Tactic/Do/Internal/VCGen/Driver.lean | 9 +- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 263 ++++++++++++++---- src/Std/Internal/Do/Triple/Gadget.lean | 5 + tests/bench/vcgen/cases/Cases.lean | 1 + tests/bench/vcgen/cases/Cases/IfsJP.lean | 31 +++ tests/bench/vcgen/lakefile.lean | 2 +- tests/bench/vcgen/vcgen_ifs_jp.lean | 20 ++ tests/elab/symZetaJPMwe.lean | 39 +++ tests/elab/vcgenJPs.lean | 43 +++ 10 files changed, 379 insertions(+), 59 deletions(-) create mode 100644 tests/bench/vcgen/cases/Cases/IfsJP.lean create mode 100644 tests/bench/vcgen/vcgen_ifs_jp.lean create mode 100644 tests/elab/symZetaJPMwe.lean create mode 100644 tests/elab/vcgenJPs.lean diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index 76be1ea1ceb1..e5ca0f7aa2f0 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -7,6 +7,7 @@ module prelude public import Lean.Elab.Tactic.Do.VCGen.Basic +public import Lean.Elab.Tactic.Do.VCGen.Split public import Lean.Elab.Tactic.Do.Internal.VCGen.SpecDB public import Lean.Elab.Tactic.Do.Internal.VCGen.FrameProc public import Lean.Meta.Sym.Apply @@ -134,11 +135,27 @@ public structure VCGen.Context where once the program in `wp⟦e⟧` matches `pat`, before applying a spec. -/ untilPat? : Option Sym.Pattern := none +/-- Definition-site info for a `__do_jp` synthetic spec, indexed by the JP's let-fvar. + +Recorded by `tryJoinPointDef` when it registers the JP's synthetic spec, and consulted by +`tryAssignJPHyps` at each jump site to assign the alt-specific precondition mvar +`hypsMVars[altIdx]` to an existential closure over the jump site's local context. -/ +public structure JPDefInfo where + /-- Per-alt synthetic-opaque precondition mvars. Each has type + `(joinParams ++ altParams) → Pred`, assigned at the corresponding jump site. -/ + hypsMVars : Array MVarId + /-- The join point's continuation splitter; its discriminant selects the alt at each jump site. -/ + splitInfo : Lean.Elab.Tactic.Do.SplitInfo + /-- Size of the local context at the JP definition site. Locals introduced beyond this index + are alt-local and get existentially closed when building the jump-site `φ`. -/ + outerLCtxSize : Nat + deriving Inhabited + public structure VCGen.Scope where /-- Spec database in scope: globals plus locals from in-scope hypotheses. -/ specs : SpecTheorems - /-- `__do_jp` fvars currently in scope. -/ - jps : FVarIdMap JumpSiteInfo := {} + /-- `__do_jp` fvars currently in scope, mapped to their def-site info. -/ + jps : FVarIdMap JPDefInfo := {} /-- The most recently lifted pure precondition. `tryLiftedHyp` closes handoff VCs against it without walking the local context. -/ lastLiftedPre? : Option FVarId := none @@ -212,10 +229,10 @@ public abbrev VCGenM := ReaderT VCGen.Context (StateRefT VCGen.State Grind.Grind namespace VCGen -public def Scope.registerJP (s : Scope) (fv : FVarId) (info : JumpSiteInfo) : Scope := +public def Scope.registerJP (s : Scope) (fv : FVarId) (info : JPDefInfo) : Scope := { s with jps := s.jps.insert fv info } -public def Scope.knownJP? (s : Scope) (fv : FVarId) : Option JumpSiteInfo := +public def Scope.knownJP? (s : Scope) (fv : FVarId) : Option JPDefInfo := s.jps.get? fv public def Scope.insertSpec (s : Scope) (thm : SpecTheorem) : Scope := diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean index f40d2df51a1f..6f7d8efe700b 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean @@ -111,17 +111,18 @@ public def work (scope : Scope) (goal : Grind.Goal) : VCGenM Unit := do match ← solve s.scope goal.mvarId with | .stop _reason => emitVC goal - | .goals scope subgoals => + | .goals scopedSubgoals => -- Handle invariant subgoals eagerly here, so that VC subgoals popped -- from the worklist later see the invariant MVar already assigned. -- Non-invariant subgoals go to the worklist as usual and will eventually go through `emitVC`. - let subgoals ← handleInvariantSubgoals subgoals + let mvarIds ← handleInvariantSubgoals (scopedSubgoals.map Prod.snd) let goal ← - if subgoals.size > 1 then + if mvarIds.size > 1 then processHypotheses goal else pure goal - worklist := worklist ++ subgoals.reverse.map (fun mv => + let kept := scopedSubgoals.filter (fun (_, mv) => mvarIds.contains mv) + worklist := worklist ++ kept.reverse.toArray.map (fun (scope, mv) => { goal := { goal with mvarId := mv }, scope }) public structure Result where diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 21332e35c5b0..40666184d994 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -44,11 +44,15 @@ public inductive SolveResult.StopReason where /-- The result of one `solve` step of VC generation. -/ public inductive SolveResult where - /-- Successfully decomposed the goal. These are the subgoals, sharing `scope`. -/ - | goals (scope : VCGen.Scope) (subgoals : List MVarId) + /-- Successfully decomposed the goal. Each subgoal carries its own scope. -/ + | goals (subgoals : List (VCGen.Scope × MVarId)) /-- No further progress possible; emit the current goal as a VC. -/ | stop (reason : SolveResult.StopReason) +/-- Decomposition result whose subgoals all share `scope`. -/ +public def SolveResult.goalsInScope (scope : VCGen.Scope) (subgoals : List MVarId) : SolveResult := + .goals (subgoals.map (scope, ·)) + private def isDuplicable (e : Expr) : Bool := match e with | .bvar .. | .mvar .. | .fvar .. | .const .. | .lit .. | .sort .. => true | .mdata _ e | .proj _ _ e => isDuplicable e @@ -73,19 +77,10 @@ private def forallIntro? (goal : MVarId) (target : Expr) : VCGenM (Option (List throwError "Failed to intro forall target {goal}" return some [goal'] -private def throwIfUnsupportedJP (name : Name) (val : Expr) : VCGenM Unit := do - if (← read).useJP && Lean.Elab.Tactic.Do.isJP name && val.isLambda then - throwError "vcgen: shared-continuation handling for `__do_jp` is not yet \ - implemented. Detection point reached at {name}; the upstream \ - `Lean.Elab.Tactic.Do.onJoinPoint` (`src/Lean/Elab/Tactic/Do/VCGen.lean:215`) \ - needs to be ported to the worklist style. Drop `(jp := true)` to fall back \ - to the default zeta-unfold behaviour." - /-- Strategy 2: zeta-substitute a duplicable top-level `let` in the target, otherwise introduce it into the local context. -/ private def targetLetIntro? (goal : MVarId) (target : Expr) : VCGenM (Option MVarId) := do let .letE name _ val body _ := target | return none - throwIfUnsupportedJP name val if isDuplicable val then trace[Elab.Tactic.Do.vcgen] "let-zeta-dup: {name}" return some (← goal.replaceTargetDefEqFast (← Sym.instantiateRevBetaS body #[val])) @@ -221,11 +216,92 @@ private def wpConsumeMData? (goal : MVarId) (info : WPApp) : VCGenM (Option MVar let .mdata .. := info.prog | return none return some (← replaceProgDefEq goal info info.prog.consumeMData) +/-- Hoist a program-head `let` to the goal target and introduce it, returning the introduced fvar +and the new goal. -/ +private def hoistProgLetIntro (goal : MVarId) (info : WPApp) : + VCGenM (Option (FVarId × MVarId)) := do + let .letE name type val body nondep := info.prog.getAppFn | return none + let prog ← betaRevS body info.prog.getAppRevArgs + let wp ← mkAppNS info.head <| info.args.set! 7 prog + let rhs ← mkAppNS wp info.excessArgs + let target ← goal.getType + let relArgs := target.getAppArgs + let target ← mkAppNS target.getAppFn (relArgs.set! (relArgs.size - 1) rhs) + let hoisted ← goal.replaceTargetDefEqFast (Expr.letE name type val target nondep) + let .goal newDecls newGoal ← Sym.intros hoisted | return none + let some fvId := newDecls[0]? | return none + return some (fvId, newGoal) + +/-- `+jp`: when the program is `let __do_jp := fun args => body; rest` with `rest` an `if`/`match`, +register a `Triple` spec for `__do_jp` and return two subgoals, `body` and `rest`. Then `body` is +proved once and each jump `__do_jp args` in `rest` closes via `applySpec`, rather than inlining +`body` at every jump. + +The spec's precondition splits the same way as `rest`: in branch `i` it is a fresh metavariable +`?Hᵢ`, which the jump in that branch fills in with the facts that hold there. -/ +private def tryJoinPointDef (scope : Scope) (goal : MVarId) (info : WPApp) : + VCGenM (Option SolveResult) := do + unless (← read).useJP do return none + let .letE name _ val _ _ := info.prog.getAppFn | return none + unless Lean.Elab.Tactic.Do.isJP name do return none + unless val.isLambda do return none + let some (fvId, newGoal) ← hoistProgLetIntro goal info | return none + -- `Sym.intros` introduces every `let` as a dependent decl; restore the `have`'s nondep-ness so + -- the spec keys on `@fv joinParams` rather than zeta-reducing to the body. + newGoal.modifyLCtx fun lctx => + if let some decl := lctx.find? fvId then + lctx.modifyLocalDecl fvId fun _ => decl.setNondep true + else lctx + newGoal.withContext do + let fv := mkFVar fvId + + let newTarget ← newGoal.getType + let_expr PartialOrder.rel _α _inst _pre rhs := newTarget + | return some (.goalsInScope scope [newGoal]) + let some info' := isWPApp? rhs + | return some (.goalsInScope scope [newGoal]) + let Q := info'.post + let some sinfo ← liftMetaM <| Lean.Elab.Tactic.Do.getSplitInfo? info'.prog + | return some (.goalsInScope scope [newGoal]) + let some resTy := sinfo.resTy + | return some (.goalsInScope scope [newGoal]) + let Pred := info'.Pred + let joinTy ← liftMetaM <| Meta.inferType fv + let numJoinParams ← liftMetaM <| Lean.Elab.Tactic.Do.getNumJoinParams joinTy resTy + + -- Create the `?Hᵢ` mvars in the outer local context so the rule construction's `abstractMVars` + -- keeps them shared across jump sites instead of lifting the splitter telescope into each. + let outerLCtx ← liftMetaM getLCtx + let outerLocalInsts ← liftMetaM getLocalInstances + let (bodyTy, hypsMVars) ← liftMetaM <| + Meta.forallBoundedTelescope joinTy numJoinParams fun joinParams _ => do + let hypsMVarsRef ← IO.mkRef (#[] : Array MVarId) + let pjpBody ← sinfo.splitWith Pred (useSplitter := true) + fun _name _expAltType _idx altFVars => do + let allBinders := joinParams ++ altFVars.all + let mvarTy ← Meta.mkForallFVars allBinders Pred + let hypsMVar ← Meta.mkFreshExprMVarAt outerLCtx outerLocalInsts mvarTy .syntheticOpaque + hypsMVarsRef.modify (·.push hypsMVar.mvarId!) + pure (mkAppN hypsMVar allBinders) + let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple + #[info'.Pred, info'.EPred, info'.Prog, info'.Value, info'.args[4]!, info'.args[5]!, + mkAppN fv joinParams, info'.instWP, pjpBody, Q, info'.args[9]!] + pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get) + + let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← newGoal.getTag) + let some joinSpec ← liftMetaM <| SpecAttr.mkSpecTheoremFromStx (← getRef) bodyMV + | return some (.goalsInScope scope [newGoal]) + + let outerLCtxSize := (← newGoal.getDecl).lctx.numIndices + let jpDefInfo : JPDefInfo := { hypsMVars, splitInfo := sinfo, outerLCtxSize } + -- `bodyMV` keeps the original scope so its own head is not treated as a JP. + let restScope := (scope.insertSpec joinSpec).registerJP fvId jpDefInfo + return some (.goals [(restScope, newGoal), (scope, bodyMV.mvarId!)]) + /-- Strategy 11a: hoist or zeta-substitute a `let` from the program head. -/ private def wpLet? (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) := do - let .letE name type val body nondep := info.prog.getAppFn | return none + let .letE name _type val body _nondep := info.prog.getAppFn | return none let appArgs := info.prog.getAppRevArgs - throwIfUnsupportedJP name val if isDuplicable val then trace[Elab.Tactic.Do.vcgen] "let-zeta-dup: {name}" let body' ← Sym.instantiateRevBetaS body #[val] @@ -233,15 +309,7 @@ private def wpLet? (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) := do return some (← replaceProgDefEq goal info prog) else trace[Elab.Tactic.Do.vcgen] "let-hoist: {name}" - let prog ← mkAppRevS body appArgs - let wp ← mkAppNS info.head <| info.args.set! 7 prog - let rhs ← mkAppNS wp info.excessArgs - let target ← goal.getType - let relArgs := target.getAppArgs - let target ← mkAppNS target.getAppFn (relArgs.set! (relArgs.size - 1) rhs) - let target := Expr.letE name type val target nondep - let goal ← goal.replaceTargetDefEqFast target - let .goal _ goal ← Sym.intros goal + let some (_, goal) ← hoistProgLetIntro goal info | throwError "Failed to intro hoisted let" return some goal @@ -264,12 +332,13 @@ private def wpMatch? (goal : MVarId) (info : WPApp) : | .closed => continue return some simpGoals.toList -/-- Strategy 11c: zeta-unfold a local let-bound fvar used as the program head. -/ -private def wpFVarZeta? (goal : MVarId) (info : WPApp) : +/-- Strategy 11c: zeta-unfold a let-bound fvar used as the program head, unless it is a registered JP. -/ +private def wpFVarZeta? (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) := do let f := info.prog.getAppFn let some fvarId := f.fvarId? | return none - let some val ← fvarId.getValue? | return none + if (scope.knownJP? fvarId).isSome then return none + let some val ← fvarId.getValue? (allowNondep := true) | return none trace[Elab.Tactic.Do.vcgen] "fvar-zeta: {(← fvarId.getUserName)}" let prog ← shareCommonInc (val.betaRev info.prog.getAppRevArgs) return some (← replaceProgDefEq goal info prog) @@ -296,6 +365,61 @@ private def stopOrErrorOnMissingSpec (prog monad : Expr) (thms : Array SpecTheor throwError "No spec matching the monad {monad} found for program {prog}. \ Candidates were {thms.map (·.proof)}." +/-- At a JP jump site `__do_jp args`, assign the applicable alt's precondition mvar `?Hᵢ` to an +existential closure of the join-argument equalities over the jump site's local context. -/ +private def tryAssignJPHyps (jpInfo : JPDefInfo) (e Pred : Expr) : VCGenM Unit := do + let info := jpInfo.splitInfo + let joinArgs := e.getAppArgs + -- The applicable alt is the one whose discriminant `rwIfOrMatcher` succeeds on here. + let mut altIdx? : Option Nat := none + for idx in [:info.altInfos.size] do + let resOpt ← liftMetaM <| try + some <$> Lean.Elab.Tactic.Do.rwIfOrMatcher idx info.expr + catch _ => pure none + let some res := resOpt | continue + if res.proof?.isNone then continue + altIdx? := some idx + break + let some altIdx := altIdx? | return + unless altIdx < jpInfo.hypsMVars.size do return + let hypsMVar := jpInfo.hypsMVars[altIdx]! + if ← hypsMVar.isAssigned then return + trace[Elab.Tactic.Do.vcgen] "JP jump: alt {altIdx} args={joinArgs}" + liftMetaM do + let mvarTy ← hypsMVar.getType + let lctx ← getLCtx + let newLocalDecls := lctx.decls.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push + |>.filterMap id + |>.filter (fun decl => !decl.isImplementationDetail) + let newLocals := newLocalDecls.map LocalDecl.toExpr + -- Telescope only the mvar's own binders (joinParams ++ altFVars); `Pred` itself may be a + -- function (e.g. `σ → Prop`) whose arguments must not be captured as extra binders. + let predArity ← Meta.forallTelescopeReducing Pred fun xs _ => pure xs.size + let mvarArity ← Meta.forallTelescopeReducing mvarTy fun xs _ => pure (xs.size - predArity) + Meta.forallBoundedTelescope mvarTy mvarArity fun allBinders _ => do + let numJP := joinArgs.size + unless numJP ≤ allBinders.size do return + let jpBinders := allBinders.extract 0 numJP + -- `⌜jpBinders = joinArgs⌝`, existentially/let-closed over the alt-local decls to be valid in + -- the mvar's def-site context. + let eqs ← (jpBinders.mapIdx fun i jp => (jp, i)).mapM fun (jp, i) => Meta.mkEq jp joinArgs[i]! + let φProp := (mkAndN eqs.toList).abstract newLocals + let (_, φPropClosed) ← newLocalDecls.foldrM (init := (newLocals, φProp)) + fun decl (locals, φ) => do + let locals := locals.pop + let type := (← instantiateMVars decl.type).abstract locals + match decl.value? with + | some v => + let val := (← instantiateMVars v).abstract locals + return (locals, Lean.mkLet decl.userName type val φ (nondep := decl.isNondep)) + | none => + let typeLevel ← Meta.getLevel decl.type + return (locals, mkApp2 (mkConst ``Exists [typeLevel]) type (Expr.lam decl.userName type φ .default)) + -- Embed `φ_prop : Prop` as an assertion of type `Pred` via `⌜·⌝ = CompleteLattice.ofProp`. + let instCL ← Meta.synthInstance (← Meta.mkAppM ``Lean.Order.CompleteLattice #[Pred]) + let φPred ← Meta.mkAppOptM ``Lean.Order.CompleteLattice.ofProp #[Pred, instCL, φPropClosed] + hypsMVar.assign (← Meta.mkLambdaFVars allBinders φPred) + /-- Select the highest-priority `@[spec]` theorem matching `prog`, or a stop result when none matches. Hands `findSpecs` the sole reference to the spec database so its in-place pattern internalization does not copy the discrimination tree, then threads the updated database back into the returned scope. -/ @@ -321,9 +445,15 @@ a stop result when no rule matches the goal's monad. Reached from `applyFrameOrS private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm : SpecTheorem) : VCGenM SolveResult := do trace[Elab.Tactic.Do.vcgen] "Applying spec {thm.proof} for {info.prog}. Excess args: {info.excessArgs}" + -- At a JP jump site, assign its alt precondition, then build the rule at a fresh mvar depth so the + -- synthetic body/precondition mvars survive `abstractMVars` as constants (shared across jump sites). + let jpInfo? := info.prog.getAppFn.fvarId?.bind scope.knownJP? + if let some jpInfo := jpInfo? then + tryAssignJPHyps jpInfo info.prog info.Pred let some rule ← try - mkBackwardRuleFromSpecCached thm info |>.run + let build := (mkBackwardRuleFromSpecCached thm info).run + if jpInfo?.isSome then Meta.withNewMCtxDepth (allowLevelAssignments := false) build else build catch ex => throwError "Failed to construct rule {thm.proof} for {indentExpr info.prog}\n\ error: {ex.toMessageData}\n\ @@ -344,7 +474,7 @@ private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm Pred:{indentExpr info.Pred}\n\ excessArgs: {info.excessArgs}\n\ rule type:{indentExpr ruleType}" - return .goals scope goals + return .goalsInScope scope goals /-- True iff the program matches the `until` pattern, in which case VC generation stops at this goal. -/ @@ -459,29 +589,55 @@ private def applyFrameOrSpec (scope : VCGen.Scope) (goal : MVarId) (pre : Expr) let thm ← match spec with | .ok thm => pure thm | .error res => return res - if thm.conjunctivePre || isFramedPost info.post then + -- A JP jump site applies its synthetic spec directly, bypassing framing. + let isJP := (info.prog.getAppFn.fvarId?.bind scope.knownJP?).isSome + if thm.conjunctivePre || isFramedPost info.post || isJP then return ← applySpec scope goal info thm let procs := (← read).frameProcs.byProg let fp := info.M.getAppFn.constName?.bind (procs[·]?) |>.getD meetFrameProc let resourceTy ← fp.resourceTy info if let some F ← matchFrame? resourceTy info then - return .goals scope (← applyFrameRule goal info fp F) + return .goalsInScope scope (← applyFrameRule goal info fp F) let some proc := fp.proc | return ← applySpec scope goal info thm -- Apply the spec speculatively, then let the frame procedure inspect its precondition VC. No frame -- keeps the application; a frame rolls it back and frames instead. let saved ← Meta.saveState - let .goals _ subgoals ← applySpec scope goal info thm + let .goals scopedSubgoals ← applySpec scope goal info thm | throwError "vcgen: speculative spec application for{indentExpr info.prog} did not produce goals" + let subgoals := scopedSubgoals.map Prod.snd let frame? ← match ← specPreOf? subgoals with | some specPre => proc resourceTy pre info specPre | none => pure none - let some F := frame? | return .goals scope subgoals + let some F := frame? | return .goals scopedSubgoals -- Capture the frame before rolling back: `saved.restore` un-assigns the speculative metavariables, -- so instantiate `F` against them now (and reshare). let F ← instantiateMVarsS F trace[Elab.Tactic.Do.vcgen] "`@[frameproc]` matched {info.prog}; frame:{indentExpr F}" saved.restore - return .goals scope (← applyFrameRule goal info fp F) + return .goalsInScope scope (← applyFrameRule goal info fp F) + +/-- Rewrite a splitter on the entailment RHS (`relFn α inst pre _`) with the alt's discriminant +evidence, reducing a jump site's `Pjp args` precondition to its alt component. -/ +private def tryRwSplitterRHS (goal : MVarId) (relFn α inst pre rhs : Expr) : + VCGenM (Option MVarId) := do + let some info ← liftMetaM <| Lean.Elab.Tactic.Do.getSplitInfo? rhs | return none + for idx in [:info.altInfos.size] do + let res? ← liftMetaM <| try + some <$> Lean.Elab.Tactic.Do.rwIfOrMatcher idx rhs + catch _ => pure none + let some res := res? | continue + let some _ := res.proof? | continue + trace[Elab.Tactic.Do.vcgen] "rw-splitter-rhs: alt {idx} → {res.expr}" + let rhsTy ← liftMetaM <| Meta.inferType rhs + let motive ← liftMetaM <| Meta.withLocalDeclD `t rhsTy fun t => + Meta.mkLambdaFVars #[t] (mkAppN relFn #[α, inst, pre, t]) + let res' ← liftMetaM <| Lean.Meta.Simp.mkCongrArg motive res + let some eqProof' := res'.proof? | continue + -- Beta-reduce the `(fun t => pre ⊑ t) res.expr` redex so the emitted VC is the clean + -- `pre ⊑ ?Hᵢ_body[…]`. + let newTarget ← liftMetaM (Core.betaReduce res'.expr : CoreM _) + return some (← goal.replaceTargetEq newTarget eqProof') + return none /-- The main VC generation step. Operates on a plain `MVarId` with no knowledge of grind. @@ -515,12 +671,12 @@ public def solve (scope : VCGen.Scope) (goal : MVarId) : VCGenM SolveResult := g trace[Elab.Tactic.Do.vcgen] "🎯 Target: {target}" -- Phase 1: simplify `target` until it is of the form `pre ⊑ rhs`. - if let some g ← consumeMData? goal target then return .goals scope [g] - if let some gs ← forallIntro? goal target then return .goals scope gs - if let some g ← targetLetIntro? goal target then return .goals scope [g] - if let some g ← tripleUnfold? goal target then return .goals scope [g] - if let some g ← bareWPToLe? goal target then return .goals scope [g] - if let some gs ← liftedHypBare? scope goal target then return .goals scope gs + if let some g ← consumeMData? goal target then return .goalsInScope scope [g] + if let some gs ← forallIntro? goal target then return .goalsInScope scope gs + if let some g ← targetLetIntro? goal target then return .goalsInScope scope [g] + if let some g ← tripleUnfold? goal target then return .goalsInScope scope [g] + if let some g ← bareWPToLe? goal target then return .goalsInScope scope [g] + if let some gs ← liftedHypBare? scope goal target then return .goalsInScope scope gs let_expr PartialOrder.rel α inst pre rhs := target | return .stop (.noEntailment target) @@ -533,8 +689,8 @@ public def solve (scope : VCGen.Scope) (goal : MVarId) : VCGenM SolveResult := g -- Phase 2: close reflexive goals, then drive `pre` toward `⊤`, lifting any pure content so a -- later spec application sees a `⊤` precondition. - if let some gs ← rfl? goal then return .goals scope gs - if let some (scope, gs) ← normalizePre? scope goal α pre target then return .goals scope gs + if let some gs ← rfl? goal then return .goalsInScope scope gs + if let some (scope, gs) ← normalizePre? scope goal α pre target then return .goalsInScope scope gs -- Collect new local specs before any strategy that may emit multiple subgoals -- (`wpMatch?`, `splitLatticeOp?`) or apply a registered spec (`applySpec`). @@ -542,10 +698,10 @@ public def solve (scope : VCGen.Scope) (goal : MVarId) : VCGenM SolveResult := g -- Phase 3: shape the `rhs` (reduce an EPost projection, decompose a lattice connective or a -- forall, then discharge a residual entailment against the lifted hypothesis). - if let some g ← reduceEPostHead? goal target α inst pre rhs then return .goals scope [g] - if let some gs ← splitLatticeOp? goal rhs then return .goals scope gs - if let some gs ← splitForallLe? goal rhs then return .goals scope gs - if let some gs ← liftedHyp? scope goal α pre rhs then return .goals scope gs + if let some g ← reduceEPostHead? goal target α inst pre rhs then return .goalsInScope scope [g] + if let some gs ← splitLatticeOp? goal rhs then return .goalsInScope scope gs + if let some gs ← splitForallLe? goal rhs then return .goalsInScope scope gs + if let some gs ← liftedHyp? scope goal α pre rhs then return .goalsInScope scope gs -- Phase 4: wp decomposition. The program-shape steps below all consume one unit of fuel -- (the `stepLimit` config option) when they make progress. @@ -555,25 +711,32 @@ public def solve (scope : VCGen.Scope) (goal : MVarId) : VCGenM SolveResult := g if ← matchesUntilPattern info.prog then return .stop (.untilPatternMatched info.M) if let some g ← wpConsumeMData? goal info then - return .goals scope [g] + return .goalsInScope scope [g] + if let some r ← tryJoinPointDef scope goal info then + VCGen.burnOne + return r if let some g ← wpLet? goal info then VCGen.burnOne - return .goals scope [g] + return .goalsInScope scope [g] if let some gs ← wpMatch? goal info then VCGen.burnOne - return .goals scope gs - if let some g ← wpFVarZeta? goal info then + return .goalsInScope scope gs + if let some g ← wpFVarZeta? scope goal info then VCGen.burnOne - return .goals scope [g] + return .goalsInScope scope [g] if let some g ← wpHeadReduce? goal info then VCGen.burnOne - return .goals scope [g] + return .goalsInScope scope [g] let f := info.prog.getAppFn if f.isConst || f.isFVar then VCGen.burnOne return ← applyFrameOrSpec scope goal pre info throwError "Failed to decompose weakest precondition for {info.prog}. This should not happen." + -- Reduce a jump site's `Pjp args` splitter precondition before classifying the goal as a VC. + if let some g ← tryRwSplitterRHS goal target.getAppFn α inst pre rhs then + return .goalsInScope scope [g] + return .stop (.noProgress pre rhs) end VCGen diff --git a/src/Std/Internal/Do/Triple/Gadget.lean b/src/Std/Internal/Do/Triple/Gadget.lean index 92ed594a0d31..99406f116626 100644 --- a/src/Std/Internal/Do/Triple/Gadget.lean +++ b/src/Std/Internal/Do/Triple/Gadget.lean @@ -37,6 +37,11 @@ theorem Spec.assertGadget (name : Name) (as : Pred) [∀ a : Pred, PreservesSup (Triple.pure (m := m) (pre := as ⊓ (as ⇨ post ⟨⟩)) (post := post) (epost := epost) (a := ⟨⟩) (h := meet_himp_le)) +set_option linter.unusedVariables false in +/-- The identity on `x`, tagging it with the join-point function `fv` so `vcgen +jp` can recognize +the continuation `x` of a shared join point. -/ +def jpGadget.{ua, ub} {α : Sort ua} {β : Sort ub} (fv : β) (x : α) : α := x + end Std.Internal.Do end -- public section diff --git a/tests/bench/vcgen/cases/Cases.lean b/tests/bench/vcgen/cases/Cases.lean index ec1eb08ac18b..50d6b2286374 100644 --- a/tests/bench/vcgen/cases/Cases.lean +++ b/tests/bench/vcgen/cases/Cases.lean @@ -3,6 +3,7 @@ import Cases.AddSubCancelDeep import Cases.AddSubCancelSimp import Cases.DiteSplit import Cases.GetThrowSet +import Cases.IfsJP import Cases.LetBinding import Cases.MatchIota import Cases.MatchSplit diff --git a/tests/bench/vcgen/cases/Cases/IfsJP.lean b/tests/bench/vcgen/cases/Cases/IfsJP.lean new file mode 100644 index 000000000000..13890817e99a --- /dev/null +++ b/tests/bench/vcgen/cases/Cases/IfsJP.lean @@ -0,0 +1,31 @@ +import Lean +import Std.Tactic.Do + +/-! +Several `if`s with a shared continuation. Each `if` makes the do-elaborator emit a `__do_jp` for +its trailing code, so `vcgen +jp` proves each continuation once instead of zeta-unfolding it into +both branches. Without `+jp` the VC count grows exponentially in the number of `if`s. +-/ + +open Lean Meta Order Std.Internal.Do + +namespace IfsJP + +set_option mvcgen.warning false + +def step (v : Nat) : StateM Nat Unit := do + let s ← get + let mut x := s + if x > 0 then x := x + v else x := x + (v + 1) + if x > 1 then x := x + v else x := x + (v + 1) + if x > 2 then x := x + v else x := x + (v + 1) + set x + +def loop (n : Nat) : StateM Nat Unit := do + match n with + | 0 => pure () + | n+1 => step n; loop n + +def Goal (n : Nat) : Prop := ⦃fun _ => True⦄ loop n ⦃fun _ s => 0 < s⦄ + +end IfsJP diff --git a/tests/bench/vcgen/lakefile.lean b/tests/bench/vcgen/lakefile.lean index 299d86794cf3..63b8f7846ace 100644 --- a/tests/bench/vcgen/lakefile.lean +++ b/tests/bench/vcgen/lakefile.lean @@ -17,7 +17,7 @@ lean_lib Cases where lean_lib VCGenBench where roots := #[`vcgen_add_sub_cancel, `vcgen_add_sub_cancel_deep, `vcgen_add_sub_cancel_simp, `vcgen_get_throw_set, `vcgen_get_throw_set_grind, `vcgen_pure_precond, - `vcgen_reader_state, `vcgen_match_split] + `vcgen_reader_state, `vcgen_match_split, `vcgen_ifs_jp] moreLeanArgs := #["--tstack=102400"] -- 100 MB in KB @[default_target] diff --git a/tests/bench/vcgen/vcgen_ifs_jp.lean b/tests/bench/vcgen/vcgen_ifs_jp.lean new file mode 100644 index 000000000000..233266f165a3 --- /dev/null +++ b/tests/bench/vcgen/vcgen_ifs_jp.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sebastian Graf +-/ +import Cases.IfsJP +import Driver + +set_option mvcgen.warning false + +open Lean Order Parser Meta Elab Tactic Sym Std Internal.Do +open IfsJP + +set_option maxRecDepth 10000 +set_option maxHeartbeats 10000000 + +-- `+jp` shares each trailing continuation across the splitter alts; without it every alt +-- zeta-unfolds the `__do_jp` body and the VC count grows exponentially in the number of `if`s. +#eval runBenchUsingTactic ``Goal [``loop, ``step] `(tactic| vcgen +jp) `(tactic| sorry) + [3] diff --git a/tests/elab/symZetaJPMwe.lean b/tests/elab/symZetaJPMwe.lean new file mode 100644 index 000000000000..5e37f21269eb --- /dev/null +++ b/tests/elab/symZetaJPMwe.lean @@ -0,0 +1,39 @@ +import Lean.Meta.Sym.Pattern +import Lean.Meta.Sym.Intro + +/-! MWE for the zeta that `+jp` spec construction hits. + +`Sym.introN` introduces a nondep `let` (`have`) as a *dependent* ldecl: `Intro.lean` calls +`mkLetDecl` without threading the letE's `nondep` flag. `mkSpecTheorem` then runs +`Sym.preprocessType`, whose `zetaReduce` unfolds the dependent fvar, so a spec keyed on +`@fv joinParams` is re-keyed on the join-point body. Marking the fvar nondep preserves it. -/ + +open Lean Meta Sym + +/-- +info: [Sym.introN: isNondep=false] preprocessType: 3 = 3 +--- +info: [fixed: isNondep=true] preprocessType: f✝ 3 = f✝ 3 +-/ +#guard_msgs in +run_meta do + let nat := mkConst ``Nat + let arrow : Expr := .forallE `_ nat nat .default -- Nat → Nat + let val ← withLocalDeclD `x nat fun x => mkLambdaFVars #[x] x -- `fun x => x` + let target := Expr.letE `f arrow val (mkConst ``True) (nondep := true) -- nondep `have f` + let mvar ← mkFreshExprMVar target + SymM.run do + let .goal newDecls newGoal ← Sym.introN mvar.mvarId! 1 | return + -- (1) as `Sym.introN` leaves it: dependent, so `preprocessType` zeta-reduces `f 3` + newGoal.withContext do + let f := mkFVar newDecls[0]! + let ty ← mkEq (mkApp f (mkNatLit 3)) (mkApp f (mkNatLit 3)) + let nd := ((← getLCtx).find? newDecls[0]!).get!.isNondep + logInfo m!"[Sym.introN: isNondep={nd}] preprocessType: {← Sym.preprocessType ty}" + -- (2) with the fix (nondep): `preprocessType` preserves `f 3` + newGoal.modifyLCtx fun lctx => lctx.modifyLocalDecl newDecls[0]! (·.setNondep true) + newGoal.withContext do + let f := mkFVar newDecls[0]! + let ty ← mkEq (mkApp f (mkNatLit 3)) (mkApp f (mkNatLit 3)) + let nd := ((← getLCtx).find? newDecls[0]!).get!.isNondep + logInfo m!"[fixed: isNondep={nd}] preprocessType: {← Sym.preprocessType ty}" diff --git a/tests/elab/vcgenJPs.lean b/tests/elab/vcgenJPs.lean new file mode 100644 index 000000000000..eb68a4ed0138 --- /dev/null +++ b/tests/elab/vcgenJPs.lean @@ -0,0 +1,43 @@ +import Lean +import Std.Internal +import Std.Tactic.Do + +/-! Tests for `vcgen +jp`: shared-continuation (`__do_jp`) handling. A shared tail after an `if` +makes do-elaboration emit a `__do_jp`; `+jp` proves the tail once and discharges each jump through +a synthetic spec instead of inlining it. -/ + +open Lean Order Meta Elab Tactic Sym Std Internal.Do + +set_option grind.warning false +set_option mvcgen.warning false + +def ifs_pure (n : Nat) : Id Nat := do + let mut x := 0 + if n > 0 then x := x + 1 else x := x + 2 + if n > 1 then x := x + 3 else x := x + 4 + return x + +theorem ifs_pure_triple : ⦃ True ⦄ ifs_pure n ⦃ fun r => r > 0 ⦄ := by + unfold ifs_pure + vcgen +jp + all_goals grind + +def if_state (f : Nat → Bool) : StateM Nat Nat := do + let mut x := 0 + if f 0 then x := x + 1 else x := x + 2 + return x + +theorem if_state_triple : ⦃ fun _ => True ⦄ if_state f ⦃ fun r => ⌜r > 0⌝ ⦄ := by + unfold if_state + vcgen +jp + all_goals grind + +def ifs_pure_simple (n : Nat) : Id Nat := do + let mut x := 0 + if n > 0 then x := x + 1 else x := x + 2 + return x + +theorem ifs_pure_simple_triple : ⦃ True ⦄ ifs_pure_simple n ⦃ fun r => r > 0 ⦄ := by + unfold ifs_pure_simple + vcgen +jp + all_goals grind From 83cf71ac7d65eba82404d45e0d8cf79c8b00a45f Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Wed, 15 Jul 2026 10:15:27 +0000 Subject: [PATCH 02/35] refactor: route vcgen +jp through a jpGadget marker This PR reworks how `vcgen +jp` recognizes a join point: instead of hoisting and re-parsing the goal inside a single step, `tryMarkJP?` wraps the continuation of a `__do_jp` let in the identity gadget `jpGadget fv rest`, the usual `wpLet?` introduces the let, and `tryJPGadget?` then detects the gadget and registers the synthetic spec directly from the `WPApp` (no re-derivation of `Pred`/`post`/the splitter). This removes the bespoke `hoistProgLetIntro` helper and keeps the join-point setup on the ordinary `wp` decomposition path. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 124 +++++++++--------- 1 file changed, 62 insertions(+), 62 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 40666184d994..29c5d4d09be6 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -216,56 +216,69 @@ private def wpConsumeMData? (goal : MVarId) (info : WPApp) : VCGenM (Option MVar let .mdata .. := info.prog | return none return some (← replaceProgDefEq goal info info.prog.consumeMData) -/-- Hoist a program-head `let` to the goal target and introduce it, returning the introduced fvar -and the new goal. -/ -private def hoistProgLetIntro (goal : MVarId) (info : WPApp) : - VCGenM (Option (FVarId × MVarId)) := do +/-- `+jp`: wrap the continuation of a `__do_jp` let in `jpGadget`, tagging the join point so the +usual let-introduction runs (`wpLet?`) and `tryJPGadget?` then sets up the shared spec. -/ +private def tryMarkJP? (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) := do + unless (← read).useJP do return none + let .letE name ty val body nondep := info.prog.getAppFn | return none + unless Lean.Elab.Tactic.Do.isJP name do return none + unless val.isLambda do return none + if body.getAppFn.isConstOf ``Std.Internal.Do.jpGadget then return none + let uα ← liftMetaM <| Meta.getLevel info.Prog + let uβ ← liftMetaM <| Meta.getLevel ty + let wrapped := Expr.letE name ty val + (mkAppN (mkConst ``Std.Internal.Do.jpGadget [uα, uβ]) #[info.Prog, ty, .bvar 0, body]) nondep + return some (← replaceProgDefEq goal info (← mkAppRevS wrapped info.prog.getAppRevArgs)) + +/-- Strategy 11a: hoist or zeta-substitute a `let` from the program head. -/ +private def wpLet? (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) := do let .letE name type val body nondep := info.prog.getAppFn | return none - let prog ← betaRevS body info.prog.getAppRevArgs - let wp ← mkAppNS info.head <| info.args.set! 7 prog - let rhs ← mkAppNS wp info.excessArgs - let target ← goal.getType - let relArgs := target.getAppArgs - let target ← mkAppNS target.getAppFn (relArgs.set! (relArgs.size - 1) rhs) - let hoisted ← goal.replaceTargetDefEqFast (Expr.letE name type val target nondep) - let .goal newDecls newGoal ← Sym.intros hoisted | return none - let some fvId := newDecls[0]? | return none - return some (fvId, newGoal) + let appArgs := info.prog.getAppRevArgs + if isDuplicable val then + trace[Elab.Tactic.Do.vcgen] "let-zeta-dup: {name}" + let body' ← Sym.instantiateRevBetaS body #[val] + let prog ← mkAppRevS body' appArgs + return some (← replaceProgDefEq goal info prog) + else + trace[Elab.Tactic.Do.vcgen] "let-hoist: {name}" + let prog ← mkAppRevS body appArgs + let wp ← mkAppNS info.head <| info.args.set! 7 prog + let rhs ← mkAppNS wp info.excessArgs + let target ← goal.getType + let relArgs := target.getAppArgs + let target ← mkAppNS target.getAppFn (relArgs.set! (relArgs.size - 1) rhs) + let target := Expr.letE name type val target nondep + let goal ← goal.replaceTargetDefEqFast target + let .goal _ goal ← Sym.intros goal + | throwError "Failed to intro hoisted let" + return some goal -/-- `+jp`: when the program is `let __do_jp := fun args => body; rest` with `rest` an `if`/`match`, -register a `Triple` spec for `__do_jp` and return two subgoals, `body` and `rest`. Then `body` is -proved once and each jump `__do_jp args` in `rest` closes via `applySpec`, rather than inlining -`body` at every jump. +/-- `+jp`: at `wp⟦jpGadget fv rest⟧` with `rest` an `if`/`match`, register a `Triple` spec for the +join point `fv` and split into two subgoals, the JP body and the (gadget-stripped) `rest`. Then +`body` is proved once and each jump `fv args` in `rest` closes via `applySpec` rather than inlining +`body`. The spec's precondition splits the same way as `rest`: in branch `i` it is a fresh metavariable `?Hᵢ`, which the jump in that branch fills in with the facts that hold there. -/ -private def tryJoinPointDef (scope : Scope) (goal : MVarId) (info : WPApp) : +private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM (Option SolveResult) := do - unless (← read).useJP do return none - let .letE name _ val _ _ := info.prog.getAppFn | return none - unless Lean.Elab.Tactic.Do.isJP name do return none - unless val.isLambda do return none - let some (fvId, newGoal) ← hoistProgLetIntro goal info | return none - -- `Sym.intros` introduces every `let` as a dependent decl; restore the `have`'s nondep-ness so - -- the spec keys on `@fv joinParams` rather than zeta-reducing to the body. - newGoal.modifyLCtx fun lctx => + let_expr Std.Internal.Do.jpGadget _α _β fv rest := info.prog | return none + let some fvId := fv.fvarId? | return none + -- `Sym.intros` introduced the JP `have` as a dependent decl; restore its nondep-ness so the spec + -- keys on `@fv joinParams` rather than zeta-reducing to the body. + goal.modifyLCtx fun lctx => if let some decl := lctx.find? fvId then lctx.modifyLocalDecl fvId fun _ => decl.setNondep true else lctx - newGoal.withContext do - let fv := mkFVar fvId - - let newTarget ← newGoal.getType - let_expr PartialOrder.rel _α _inst _pre rhs := newTarget - | return some (.goalsInScope scope [newGoal]) - let some info' := isWPApp? rhs - | return some (.goalsInScope scope [newGoal]) - let Q := info'.post - let some sinfo ← liftMetaM <| Lean.Elab.Tactic.Do.getSplitInfo? info'.prog - | return some (.goalsInScope scope [newGoal]) + goal.withContext do + -- Strip the gadget for the rest subgoal. + let restGoal ← replaceProgDefEq goal info rest + let some sinfo ← liftMetaM <| Lean.Elab.Tactic.Do.getSplitInfo? rest + | return some (.goalsInScope scope [restGoal]) let some resTy := sinfo.resTy - | return some (.goalsInScope scope [newGoal]) - let Pred := info'.Pred + | return some (.goalsInScope scope [restGoal]) + let Q := info.post + let Pred := info.Pred let joinTy ← liftMetaM <| Meta.inferType fv let numJoinParams ← liftMetaM <| Lean.Elab.Tactic.Do.getNumJoinParams joinTy resTy @@ -284,34 +297,19 @@ private def tryJoinPointDef (scope : Scope) (goal : MVarId) (info : WPApp) : hypsMVarsRef.modify (·.push hypsMVar.mvarId!) pure (mkAppN hypsMVar allBinders) let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple - #[info'.Pred, info'.EPred, info'.Prog, info'.Value, info'.args[4]!, info'.args[5]!, - mkAppN fv joinParams, info'.instWP, pjpBody, Q, info'.args[9]!] + #[info.Pred, info.EPred, info.Prog, info.Value, info.args[4]!, info.args[5]!, + mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get) - let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← newGoal.getTag) + let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← goal.getTag) let some joinSpec ← liftMetaM <| SpecAttr.mkSpecTheoremFromStx (← getRef) bodyMV - | return some (.goalsInScope scope [newGoal]) + | return some (.goalsInScope scope [restGoal]) - let outerLCtxSize := (← newGoal.getDecl).lctx.numIndices + let outerLCtxSize := (← restGoal.getDecl).lctx.numIndices let jpDefInfo : JPDefInfo := { hypsMVars, splitInfo := sinfo, outerLCtxSize } -- `bodyMV` keeps the original scope so its own head is not treated as a JP. let restScope := (scope.insertSpec joinSpec).registerJP fvId jpDefInfo - return some (.goals [(restScope, newGoal), (scope, bodyMV.mvarId!)]) - -/-- Strategy 11a: hoist or zeta-substitute a `let` from the program head. -/ -private def wpLet? (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) := do - let .letE name _type val body _nondep := info.prog.getAppFn | return none - let appArgs := info.prog.getAppRevArgs - if isDuplicable val then - trace[Elab.Tactic.Do.vcgen] "let-zeta-dup: {name}" - let body' ← Sym.instantiateRevBetaS body #[val] - let prog ← mkAppRevS body' appArgs - return some (← replaceProgDefEq goal info prog) - else - trace[Elab.Tactic.Do.vcgen] "let-hoist: {name}" - let some (_, goal) ← hoistProgLetIntro goal info - | throwError "Failed to intro hoisted let" - return some goal + return some (.goals [(restScope, restGoal), (scope, bodyMV.mvarId!)]) /-- Strategy 11b: split an `ite`/`dite`/match program, or iota-reduce a matcher with a concrete discriminant. -/ @@ -712,9 +710,11 @@ public def solve (scope : VCGen.Scope) (goal : MVarId) : VCGenM SolveResult := g return .stop (.untilPatternMatched info.M) if let some g ← wpConsumeMData? goal info then return .goalsInScope scope [g] - if let some r ← tryJoinPointDef scope goal info then + if let some r ← tryJPGadget? scope goal info then VCGen.burnOne return r + if let some g ← tryMarkJP? goal info then + return .goalsInScope scope [g] if let some g ← wpLet? goal info then VCGen.burnOne return .goalsInScope scope [g] From 1dec75f43ab72282948b7dfae0ceebb56174f5f3 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Wed, 15 Jul 2026 11:09:33 +0000 Subject: [PATCH 03/35] test: wire IfsJP +jp case into the vcgen bench suite This PR adds the `IfsJP` shared-continuation case to `test_vcgen.lean`, run at n=10 with `vcgen +jp`, so the join-point path is covered by the vcgen test suite alongside the standalone `vcgen_ifs_jp` benchmark. --- tests/bench/vcgen/test_vcgen.lean | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/bench/vcgen/test_vcgen.lean b/tests/bench/vcgen/test_vcgen.lean index bfcd675d40a8..745a4d2d44d9 100644 --- a/tests/bench/vcgen/test_vcgen.lean +++ b/tests/bench/vcgen/test_vcgen.lean @@ -23,6 +23,7 @@ Each case exercises a different aspect of the VC generation: - `DiteSplit`: Dependent if-then-else (`if h : cond then ...`) - `MatchIota`: Pattern matching with concrete discriminants (iota-reduced, no split) - `MatchSplit`: Pattern matching with symbolic discriminant (state), exercising match split +- `IfsJP`: several `if`s with a shared continuation, exercising `vcgen +jp` -/ open Lean Order Parser Meta Elab Tactic Sym Std Internal.Do @@ -57,6 +58,10 @@ set_option maxHeartbeats 10000000 `(tactic| vcgen) `(tactic| sorry) [10] runBenchUsingTactic ``MatchSplit.Goal [``MatchSplit.loop, ``MatchSplit.step] `(tactic| vcgen) `(tactic| grind) [10] + -- `+jp` shares the trailing continuation across the splitter alts; without it the VC count + -- grows exponentially in the number of `if`s in `step`. + runBenchUsingTactic ``IfsJP.Goal [``IfsJP.loop, ``IfsJP.step] + `(tactic| vcgen +jp) `(tactic| grind) [3] -- Verify `simplifying_assumptions [Nat.add_assoc]` works end-to-end with `simp only` unfolding. /-- From 2bc5f4fe0da9cf0931c0f42151a8df4e06f9901f Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Wed, 15 Jul 2026 11:40:44 +0000 Subject: [PATCH 04/35] fix: handle chained join points in vcgen +jp This PR makes `vcgen +jp` work on sequenced/looping programs where one join point's continuation contains another (e.g. `do let a <- st x; let b <- st a`). The reflexivity step's unifier can throw on an un-decomposed program-head `let`; `rfl?` now treats that as "not reflexive here" (rolling back state) and lets `wp` decomposition handle the join point instead. --- src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 29c5d4d09be6..e2981dd1cf9f 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -108,7 +108,15 @@ Runs before the precondition lift so a spec handoff `pre ⊑ specPre` closes by than an assumption search. The pattern matcher keeps synthetic-opaque invariant holes rigid, so `⊤ ⊑ ?inv args` is left untouched. -/ private def rfl? (goal : MVarId) : VCGenM (Option (List MVarId)) := do - let .goals gs ← (← read).backwardRules.refl.apply goal | return none + -- Reflexivity is best-effort: the unifier can throw on an un-decomposed program-head `let` (e.g. a + -- chained `__do_jp`); treat that as "not reflexive here" and let `wp` decomposition handle it. + let saved ← Meta.saveState + let res ← try + (← read).backwardRules.refl.apply goal + catch _ => + saved.restore + return none + let .goals gs := res | return none trace[Elab.Tactic.Do.vcgen] "Solved by rfl {goal}" return some gs From 3c66b582625cea28aae1b194e2a6e9e09cae09c3 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Wed, 15 Jul 2026 12:36:18 +0000 Subject: [PATCH 05/35] fix: reduce match join points and lighten the chained-JP rfl fallback This PR extends `vcgen +jp` to `match`-based join points (not just `if`/`match`-on-`ite`): the synthetic precondition `Pjp` is now built with the matcher form (`useSplitter := false`) rather than the `.splitter`, so `tryRwSplitterRHS` can reduce it at each jump. Also drops the `saveState`/`restore` from the `rfl?` chained-JP fallback: a unifier throw leaves the goal unassigned, so `catch`-and-return-none suffices without the snapshot cost. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index e2981dd1cf9f..85e51d869a44 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -108,15 +108,11 @@ Runs before the precondition lift so a spec handoff `pre ⊑ specPre` closes by than an assumption search. The pattern matcher keeps synthetic-opaque invariant holes rigid, so `⊤ ⊑ ?inv args` is left untouched. -/ private def rfl? (goal : MVarId) : VCGenM (Option (List MVarId)) := do - -- Reflexivity is best-effort: the unifier can throw on an un-decomposed program-head `let` (e.g. a - -- chained `__do_jp`); treat that as "not reflexive here" and let `wp` decomposition handle it. - let saved ← Meta.saveState - let res ← try - (← read).backwardRules.refl.apply goal - catch _ => - saved.restore - return none - let .goals gs := res | return none + -- Reflexivity is best-effort: the unifier throws on an un-decomposed program-head `let` (e.g. a + -- chained `__do_jp`) rather than reporting "not equal". A throw leaves `goal` unassigned, so + -- treat it as "not reflexive here" and let `wp` decomposition handle the `let`. + let .goals gs ← try (← read).backwardRules.refl.apply goal catch _ => return none + | return none trace[Elab.Tactic.Do.vcgen] "Solved by rfl {goal}" return some gs @@ -297,7 +293,7 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let (bodyTy, hypsMVars) ← liftMetaM <| Meta.forallBoundedTelescope joinTy numJoinParams fun joinParams _ => do let hypsMVarsRef ← IO.mkRef (#[] : Array MVarId) - let pjpBody ← sinfo.splitWith Pred (useSplitter := true) + let pjpBody ← sinfo.splitWith Pred (useSplitter := false) fun _name _expAltType _idx altFVars => do let allBinders := joinParams ++ altFVars.all let mvarTy ← Meta.mkForallFVars allBinders Pred From 24918924b99e38cea9cf7ed089ffb2152956c4b4 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Thu, 16 Jul 2026 12:28:06 +0000 Subject: [PATCH 06/35] feat: support match and early-return join points in vcgen +jp MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Build the join-point precondition at `Prop` and close it over the excess state args the way the regular split path does (`fun s⃗ => match discrs => ?Hᵢ`), so applying the state β-reduces it to a bare `Prop` match that `grind` case-splits; this brings stateful match join points to parity with `mvcgen +jp`. Assign `False` to the precondition of a `rest` alt that never jumps to the join point, so an early `return` in one branch no longer leaves an unassigned metavariable. Drop the now-unreachable `tryRwSplitterRHS` strategy. Expand `tests/elab/vcgenJPs.lean` to the full `mvcgenJPs` port. The dependent-discriminant cases (`match h : …`) are commented out: they fail `vcgen`'s matcher transform on their own, independently of `+jp`. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 81 ++++------ tests/elab/vcgenJPs.lean | 141 +++++++++++++++++- 2 files changed, 166 insertions(+), 56 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 85e51d869a44..22f1367e436e 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -282,7 +282,6 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let some resTy := sinfo.resTy | return some (.goalsInScope scope [restGoal]) let Q := info.post - let Pred := info.Pred let joinTy ← liftMetaM <| Meta.inferType fv let numJoinParams ← liftMetaM <| Lean.Elab.Tactic.Do.getNumJoinParams joinTy resTy @@ -290,20 +289,36 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : -- keeps them shared across jump sites instead of lifting the splitter telescope into each. let outerLCtx ← liftMetaM getLCtx let outerLocalInsts ← liftMetaM getLocalInstances + let ssTypes ← liftMetaM <| info.excessArgs.mapM fun a => return (`s, ← Meta.inferType a) let (bodyTy, hypsMVars) ← liftMetaM <| Meta.forallBoundedTelescope joinTy numJoinParams fun joinParams _ => do let hypsMVarsRef ← IO.mkRef (#[] : Array MVarId) - let pjpBody ← sinfo.splitWith Pred (useSplitter := false) - fun _name _expAltType _idx altFVars => do - let allBinders := joinParams ++ altFVars.all - let mvarTy ← Meta.mkForallFVars allBinders Pred - let hypsMVar ← Meta.mkFreshExprMVarAt outerLCtx outerLocalInsts mvarTy .syntheticOpaque - hypsMVarsRef.modify (·.push hypsMVar.mvarId!) - pure (mkAppN hypsMVar allBinders) - let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple - #[info.Pred, info.EPred, info.Prog, info.Value, info.args[4]!, info.args[5]!, - mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] - pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get) + -- Split the precondition at `Prop` (each `?Hᵢ` produces a `Prop`) and close it over the excess + -- state args as the regular split path does: `fun s⃗ => match discrs => ?Hᵢ`. The `?Hᵢ` are + -- state-independent, so the state applied by `le_of_forall_le` β-reduces the precondition to the + -- bare `Prop` match `?Hᵢ`, which `grind` case-splits. + Meta.withLocalDeclsDND ssTypes fun ss => do + let propMatch ← sinfo.splitWith (mkSort .zero) (useSplitter := false) + fun _name _expAltType _idx altFVars => do + let allBinders := joinParams ++ altFVars.all + let mvarTy ← Meta.mkForallFVars allBinders (mkSort .zero) + let hypsMVar ← Meta.mkFreshExprMVarAt outerLCtx outerLocalInsts mvarTy .syntheticOpaque + hypsMVarsRef.modify (·.push hypsMVar.mvarId!) + pure (mkAppN hypsMVar allBinders) + let pjpBody ← Meta.mkLambdaFVars ss propMatch + let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple + #[info.Pred, info.EPred, info.Prog, info.Value, info.args[4]!, info.args[5]!, + mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] + pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get) + + -- A `rest` alt that never mentions `fv` cannot jump to the join point; the JP is unreachable + -- through it, so its precondition is `False`, discharging that branch of the body proof vacuously. + for idx in [:sinfo.altInfos.size] do + let (_, alt) := sinfo.altInfos[idx]! + if alt.hasAnyFVar (· == fvId) then continue + let mv := hypsMVars[idx]! + liftMetaM <| Meta.forallTelescopeReducing (← mv.getType) fun xs _ => do + mv.assign (← Meta.mkLambdaFVars xs (mkConst ``False)) let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← goal.getTag) let some joinSpec ← liftMetaM <| SpecAttr.mkSpecTheoremFromStx (← getRef) bodyMV @@ -369,7 +384,7 @@ private def stopOrErrorOnMissingSpec (prog monad : Expr) (thms : Array SpecTheor /-- At a JP jump site `__do_jp args`, assign the applicable alt's precondition mvar `?Hᵢ` to an existential closure of the join-argument equalities over the jump site's local context. -/ -private def tryAssignJPHyps (jpInfo : JPDefInfo) (e Pred : Expr) : VCGenM Unit := do +private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM Unit := do let info := jpInfo.splitInfo let joinArgs := e.getAppArgs -- The applicable alt is the one whose discriminant `rwIfOrMatcher` succeeds on here. @@ -394,10 +409,8 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e Pred : Expr) : VCGenM Unit : |>.filterMap id |>.filter (fun decl => !decl.isImplementationDetail) let newLocals := newLocalDecls.map LocalDecl.toExpr - -- Telescope only the mvar's own binders (joinParams ++ altFVars); `Pred` itself may be a - -- function (e.g. `σ → Prop`) whose arguments must not be captured as extra binders. - let predArity ← Meta.forallTelescopeReducing Pred fun xs _ => pure xs.size - let mvarArity ← Meta.forallTelescopeReducing mvarTy fun xs _ => pure (xs.size - predArity) + -- `?Hᵢ : joinParams → altFVars → Prop`; all binders are its own. + let mvarArity ← Meta.forallTelescopeReducing mvarTy fun xs _ => pure xs.size Meta.forallBoundedTelescope mvarTy mvarArity fun allBinders _ => do let numJP := joinArgs.size unless numJP ≤ allBinders.size do return @@ -417,10 +430,7 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e Pred : Expr) : VCGenM Unit : | none => let typeLevel ← Meta.getLevel decl.type return (locals, mkApp2 (mkConst ``Exists [typeLevel]) type (Expr.lam decl.userName type φ .default)) - -- Embed `φ_prop : Prop` as an assertion of type `Pred` via `⌜·⌝ = CompleteLattice.ofProp`. - let instCL ← Meta.synthInstance (← Meta.mkAppM ``Lean.Order.CompleteLattice #[Pred]) - let φPred ← Meta.mkAppOptM ``Lean.Order.CompleteLattice.ofProp #[Pred, instCL, φPropClosed] - hypsMVar.assign (← Meta.mkLambdaFVars allBinders φPred) + hypsMVar.assign (← Meta.mkLambdaFVars allBinders φPropClosed) /-- Select the highest-priority `@[spec]` theorem matching `prog`, or a stop result when none matches. Hands `findSpecs` the sole reference to the spec database so its in-place pattern internalization does @@ -451,7 +461,7 @@ private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm -- synthetic body/precondition mvars survive `abstractMVars` as constants (shared across jump sites). let jpInfo? := info.prog.getAppFn.fvarId?.bind scope.knownJP? if let some jpInfo := jpInfo? then - tryAssignJPHyps jpInfo info.prog info.Pred + tryAssignJPHyps jpInfo info.prog let some rule ← try let build := (mkBackwardRuleFromSpecCached thm info).run @@ -618,29 +628,6 @@ private def applyFrameOrSpec (scope : VCGen.Scope) (goal : MVarId) (pre : Expr) saved.restore return .goalsInScope scope (← applyFrameRule goal info fp F) -/-- Rewrite a splitter on the entailment RHS (`relFn α inst pre _`) with the alt's discriminant -evidence, reducing a jump site's `Pjp args` precondition to its alt component. -/ -private def tryRwSplitterRHS (goal : MVarId) (relFn α inst pre rhs : Expr) : - VCGenM (Option MVarId) := do - let some info ← liftMetaM <| Lean.Elab.Tactic.Do.getSplitInfo? rhs | return none - for idx in [:info.altInfos.size] do - let res? ← liftMetaM <| try - some <$> Lean.Elab.Tactic.Do.rwIfOrMatcher idx rhs - catch _ => pure none - let some res := res? | continue - let some _ := res.proof? | continue - trace[Elab.Tactic.Do.vcgen] "rw-splitter-rhs: alt {idx} → {res.expr}" - let rhsTy ← liftMetaM <| Meta.inferType rhs - let motive ← liftMetaM <| Meta.withLocalDeclD `t rhsTy fun t => - Meta.mkLambdaFVars #[t] (mkAppN relFn #[α, inst, pre, t]) - let res' ← liftMetaM <| Lean.Meta.Simp.mkCongrArg motive res - let some eqProof' := res'.proof? | continue - -- Beta-reduce the `(fun t => pre ⊑ t) res.expr` redex so the emitted VC is the clean - -- `pre ⊑ ?Hᵢ_body[…]`. - let newTarget ← liftMetaM (Core.betaReduce res'.expr : CoreM _) - return some (← goal.replaceTargetEq newTarget eqProof') - return none - /-- The main VC generation step. Operates on a plain `MVarId` with no knowledge of grind. Returns `.goals subgoals` when the goal was decomposed, or a classification result @@ -737,10 +724,6 @@ public def solve (scope : VCGen.Scope) (goal : MVarId) : VCGenM SolveResult := g return ← applyFrameOrSpec scope goal pre info throwError "Failed to decompose weakest precondition for {info.prog}. This should not happen." - -- Reduce a jump site's `Pjp args` splitter precondition before classifying the goal as a VC. - if let some g ← tryRwSplitterRHS goal target.getAppFn α inst pre rhs then - return .goalsInScope scope [g] - return .stop (.noProgress pre rhs) end VCGen diff --git a/tests/elab/vcgenJPs.lean b/tests/elab/vcgenJPs.lean index eb68a4ed0138..23070d6da09e 100644 --- a/tests/elab/vcgenJPs.lean +++ b/tests/elab/vcgenJPs.lean @@ -2,9 +2,9 @@ import Lean import Std.Internal import Std.Tactic.Do -/-! Tests for `vcgen +jp`: shared-continuation (`__do_jp`) handling. A shared tail after an `if` -makes do-elaboration emit a `__do_jp`; `+jp` proves the tail once and discharges each jump through -a synthetic spec instead of inlining it. -/ +/-! Tests for `vcgen +jp`: shared-continuation (`__do_jp`) handling. A shared tail after an +`if`/`match` makes do-elaboration emit a `__do_jp`; `+jp` proves the tail once and discharges each +jump through a synthetic spec instead of inlining it. Ported from `mvcgenJPs.lean`. -/ open Lean Order Meta Elab Tactic Sym Std Internal.Do @@ -15,6 +15,10 @@ def ifs_pure (n : Nat) : Id Nat := do let mut x := 0 if n > 0 then x := x + 1 else x := x + 2 if n > 1 then x := x + 3 else x := x + 4 + if n > 2 then x := x + 1 else x := x + 2 + if n > 3 then x := x + 1 else x := x + 2 + if n > 4 then x := x + 1 else x := x + 2 + if n > 5 then x := x + 1 else x := x + 2 return x theorem ifs_pure_triple : ⦃ True ⦄ ifs_pure n ⦃ fun r => r > 0 ⦄ := by @@ -22,9 +26,77 @@ theorem ifs_pure_triple : ⦃ True ⦄ ifs_pure n ⦃ fun r => r > 0 ⦄ := by vcgen +jp all_goals grind +def difs_pure (n : Nat) : Id Nat := do + let mut x := 0 + if h : n > 0 then x := x + 1 else x := x + 2 + if h : n > 1 then x := x + 3 else x := x + 4 + if h : n > 2 then x := x + 1 else x := x + 2 + if h : n > 3 then x := x + 1 else x := x + 2 + if h : n > 4 then x := x + 1 else x := x + 2 + if h : n > 5 then x := x + 1 else x := x + 2 + return x + +theorem difs_pure_triple : ⦃ True ⦄ difs_pure n ⦃ fun r => r > 0 ⦄ := by + unfold difs_pure + vcgen +jp + all_goals grind + +def matches_pure (f : Nat → Option Nat) : Id Nat := do + let mut x := 0 + match f 0 with | some y => x := x + y + 1 | none => x := x + 2 + match f 1 with | some y => x := x + y + 1 | none => x := x + 2 + match f 2 with | some y => x := x + y + 1 | none => x := x + 2 + match f 3 with | some y => x := x + y + 1 | none => x := x + 2 + match f 4 with | some y => x := x + y + 1 | none => x := x + 2 + match f 5 with | some y => x := x + y + 1 | none => x := x + 2 + return x + +theorem matches_pure_triple : ⦃ True ⦄ matches_pure f ⦃ fun r => r > 0 ⦄ := by + unfold matches_pure + vcgen +jp + all_goals grind + +/- Dependent-discriminant matches (`match h : …`) are rejected by `vcgen`'s matcher transform on +their own, independently of `+jp`. The following three cases are exercised once that support lands. +def dmatches_pure (f : Nat → Option Nat) : Id Nat := do + let mut x := 0 + match h : f 0 with | some y => x := x + (cast (congrArg (fun _ => Nat) h) y) + 1 | none => x := x + 2 + match h : f 1 with | some y => x := x + (cast (congrArg (fun _ => Nat) h) y) + 1 | none => x := x + 2 + match h : f 2 with | some y => x := x + (cast (congrArg (fun _ => Nat) h) y) + 1 | none => x := x + 2 + match h : f 3 with | some y => x := x + (cast (congrArg (fun _ => Nat) h) y) + 1 | none => x := x + 2 + match h : f 4 with | some y => x := x + (cast (congrArg (fun _ => Nat) h) y) + 1 | none => x := x + 2 + match h : f 5 with | some y => x := x + (cast (congrArg (fun _ => Nat) h) y) + 1 | none => x := x + 2 + return x + +theorem dmatches_pure_triple : ⦃ True ⦄ dmatches_pure f ⦃ fun r => r > 0 ⦄ := by + unfold dmatches_pure + vcgen +jp + all_goals grind + +def mixed_matches_pure (f : Nat → Option Nat) : Id Nat := do + let mut x := 0 + match h : f 0, f 10 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 + match h : f 1, f 11 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 + match h : f 2, f 12 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 + match h : f 3, f 13 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 + match h : f 4, f 14 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 + match h : f 5, f 15 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 + return x + +theorem mixed_matches_pure_triple : ⦃ True ⦄ mixed_matches_pure f ⦃ fun r => r > 0 ⦄ := by + unfold mixed_matches_pure + vcgen +jp + all_goals grind +-/ + def if_state (f : Nat → Bool) : StateM Nat Nat := do let mut x := 0 if f 0 then x := x + 1 else x := x + 2 + if f 1 then x := x + 1 else x := x + 2 + if f 2 then x := x + 1 else x := x + 2 + if f 3 then x := x + 1 else x := x + 2 + if f 4 then x := x + 1 else x := x + 2 + if f 5 then x := x + 1 else x := x + 2 return x theorem if_state_triple : ⦃ fun _ => True ⦄ if_state f ⦃ fun r => ⌜r > 0⌝ ⦄ := by @@ -32,12 +104,67 @@ theorem if_state_triple : ⦃ fun _ => True ⦄ if_state f ⦃ fun r => ⌜r > 0 vcgen +jp all_goals grind -def ifs_pure_simple (n : Nat) : Id Nat := do +def matches_state (f : Nat → Option Nat) : StateM Nat Nat := do let mut x := 0 - if n > 0 then x := x + 1 else x := x + 2 + match f 0 with | some y => x := x + y + 1 | none => x := x + 2 + match f 1 with | some y => x := x + y + 1 | none => x := x + 2 + match f 2 with | some y => x := x + y + 1 | none => x := x + 2 + match f 3 with | some y => x := x + y + 1 | none => x := x + 2 + match f 4 with | some y => x := x + y + 1 | none => x := x + 2 + match f 5 with | some y => x := x + y + 1 | none => x := x + 2 + return x + +theorem matches_state_triple : ⦃ fun _ => True ⦄ matches_state f ⦃ fun r => ⌜r > 0⌝ ⦄ := by + unfold matches_state + vcgen +jp + all_goals grind + +def set42 : StateM Nat Unit := set 42 + +@[spec] +theorem set42_triple : ⦃ fun _ => True ⦄ set42 ⦃ fun _ s => ⌜s > 13⌝ ⦄ := by + vcgen [set42] + grind + +-- Blocked on the same dependent-discriminant matcher-transform support. +/- +def mixed_matches_state (f : Nat → Option Nat) : StateM Nat Nat := do + set 42 + let mut x := 0 + match h : f 0, f 10 with + | some y, some z => + set y + set42 + x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 + | _, some _ => + x := x + 2 + | _, _ => + x := x + (← get) + match h : f 1, f 11 with + | some y, some z => + set y + x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 + | _, some _ => + set42 + x := x + 2 + | _, _ => + x := x + (← get) + return x + +theorem mixed_matches_state_triple : ⦃ fun _ => True ⦄ mixed_matches_state f ⦃ fun r => ⌜r > 0⌝ ⦄ := by + unfold mixed_matches_state + vcgen +jp + all_goals grind +-/ + +def early_return (f : Nat → Option Nat) : Id Nat := do + let mut x := 1 + match f 0 with | some _ => return x | none => x := x + 1 + match f 1 with | some y => x := x + y + 1 | none => return x + match f 2 with | some y => x := x + y + 1 | none => x := x + 1 return x -theorem ifs_pure_simple_triple : ⦃ True ⦄ ifs_pure_simple n ⦃ fun r => r > 0 ⦄ := by - unfold ifs_pure_simple +theorem early_return_triple : ⦃ True ⦄ early_return f ⦃ fun r => r > 0 ⦄ := by + unfold early_return vcgen +jp all_goals grind From 90038588c9fa433dce01674d7e9339af1fb49847 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Thu, 16 Jul 2026 19:38:05 +0000 Subject: [PATCH 07/35] test: enable dependent-discriminant match join point in vcgenJPs Rebased onto `master` (which now splits `match h : e` discriminant-equation matchers), so the single-discriminant `dmatches_pure` case discharges under `vcgen +jp`. The two `mixed_matches_*` cases stay commented: a multi-discriminant dependent match makes the jump-site precondition a proof-carrying existential that `grind` cannot witness, which needs the join point to construct the witness directly. --- tests/elab/vcgenJPs.lean | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/elab/vcgenJPs.lean b/tests/elab/vcgenJPs.lean index 23070d6da09e..2a3a3c2b353c 100644 --- a/tests/elab/vcgenJPs.lean +++ b/tests/elab/vcgenJPs.lean @@ -56,8 +56,6 @@ theorem matches_pure_triple : ⦃ True ⦄ matches_pure f ⦃ fun r => r > 0 ⦄ vcgen +jp all_goals grind -/- Dependent-discriminant matches (`match h : …`) are rejected by `vcgen`'s matcher transform on -their own, independently of `+jp`. The following three cases are exercised once that support lands. def dmatches_pure (f : Nat → Option Nat) : Id Nat := do let mut x := 0 match h : f 0 with | some y => x := x + (cast (congrArg (fun _ => Nat) h) y) + 1 | none => x := x + 2 @@ -73,6 +71,9 @@ theorem dmatches_pure_triple : ⦃ True ⦄ dmatches_pure f ⦃ fun r => r > 0 vcgen +jp all_goals grind +/- Multi-discriminant dependent matches make the jump-site precondition a proof-carrying existential +(`∃ … (h : …), … cast … h …`) that `grind` cannot witness; the two `mixed_matches_*` cases are +exercised once the join point constructs that witness directly. def mixed_matches_pure (f : Nat → Option Nat) : Id Nat := do let mut x := 0 match h : f 0, f 10 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 @@ -126,7 +127,7 @@ theorem set42_triple : ⦃ fun _ => True ⦄ set42 ⦃ fun _ s => ⌜s > 13⌝ vcgen [set42] grind --- Blocked on the same dependent-discriminant matcher-transform support. +-- Same proof-carrying-existential gap as `mixed_matches_pure`. /- def mixed_matches_state (f : Nat → Option Nat) : StateM Nat Nat := do set 42 From 7d9e1e4e6027a74a0b524efccf1fec780f214e53 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Thu, 16 Jul 2026 21:12:31 +0000 Subject: [PATCH 08/35] feat: discharge vcgen +jp jump-site preconditions by construction MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Prove each join-point jump's precondition VC directly instead of leaving it for `grind`: `tryAssignJPHyps` hands back the applicable alt and the jump's own locals, and `tryCloseJPPrecond` reduces the synthetic `⌜match discrs => ?Hᵢ⌝` precondition to that alt and witnesses the resulting existential. This brings multi-discriminant dependent-match join points to parity with `mvcgen +jp`, where `grind` could not witness the proof-carrying existentials, and cuts the emitted VC count sharply. Key the precondition on `⌜·⌝` so the witness closes generically via `ofProp_eq_top`, adding `CompleteLattice.le_ofProp`. Drop the `setNondep` re-marking now that `Sym.preprocessType` no longer zeta-reduces the join-point fvar, and remove the corresponding MWE. Complete `tests/elab/vcgenJPs.lean` to all ten `mvcgenJPs` cases. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 129 ++++++++++++------ src/Std/Internal/Do/Order/Lemmas.lean | 3 + tests/elab/symZetaJPMwe.lean | 39 ------ tests/elab/vcgenJPs.lean | 9 -- 4 files changed, 94 insertions(+), 86 deletions(-) delete mode 100644 tests/elab/symZetaJPMwe.lean diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 22f1367e436e..521cd6c0149a 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -268,12 +268,6 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM (Option SolveResult) := do let_expr Std.Internal.Do.jpGadget _α _β fv rest := info.prog | return none let some fvId := fv.fvarId? | return none - -- `Sym.intros` introduced the JP `have` as a dependent decl; restore its nondep-ness so the spec - -- keys on `@fv joinParams` rather than zeta-reducing to the body. - goal.modifyLCtx fun lctx => - if let some decl := lctx.find? fvId then - lctx.modifyLocalDecl fvId fun _ => decl.setNondep true - else lctx goal.withContext do -- Strip the gadget for the rest subgoal. let restGoal ← replaceProgDefEq goal info rest @@ -289,27 +283,25 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : -- keeps them shared across jump sites instead of lifting the splitter telescope into each. let outerLCtx ← liftMetaM getLCtx let outerLocalInsts ← liftMetaM getLocalInstances - let ssTypes ← liftMetaM <| info.excessArgs.mapM fun a => return (`s, ← Meta.inferType a) + let instCL ← liftMetaM <| Meta.synthInstance (← Meta.mkAppM ``Lean.Order.CompleteLattice #[info.Pred]) let (bodyTy, hypsMVars) ← liftMetaM <| Meta.forallBoundedTelescope joinTy numJoinParams fun joinParams _ => do let hypsMVarsRef ← IO.mkRef (#[] : Array MVarId) - -- Split the precondition at `Prop` (each `?Hᵢ` produces a `Prop`) and close it over the excess - -- state args as the regular split path does: `fun s⃗ => match discrs => ?Hᵢ`. The `?Hᵢ` are - -- state-independent, so the state applied by `le_of_forall_le` β-reduces the precondition to the - -- bare `Prop` match `?Hᵢ`, which `grind` case-splits. - Meta.withLocalDeclsDND ssTypes fun ss => do - let propMatch ← sinfo.splitWith (mkSort .zero) (useSplitter := false) - fun _name _expAltType _idx altFVars => do - let allBinders := joinParams ++ altFVars.all - let mvarTy ← Meta.mkForallFVars allBinders (mkSort .zero) - let hypsMVar ← Meta.mkFreshExprMVarAt outerLCtx outerLocalInsts mvarTy .syntheticOpaque - hypsMVarsRef.modify (·.push hypsMVar.mvarId!) - pure (mkAppN hypsMVar allBinders) - let pjpBody ← Meta.mkLambdaFVars ss propMatch - let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple - #[info.Pred, info.EPred, info.Prog, info.Value, info.args[4]!, info.args[5]!, - mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] - pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get) + -- Split the precondition at `Prop` (each `?Hᵢ` produces a `Prop`) and embed the match via `⌜·⌝`. + -- Each jump discharges its instance by construction (`ofProp_eq_top` of the witnessed alt); the + -- body proof case-splits the bare `Prop` match that `⌜φ⌝ s` reduces to. + let propMatch ← sinfo.splitWith (mkSort .zero) (useSplitter := false) + fun _name _expAltType _idx altFVars => do + let allBinders := joinParams ++ altFVars.all + let mvarTy ← Meta.mkForallFVars allBinders (mkSort .zero) + let hypsMVar ← Meta.mkFreshExprMVarAt outerLCtx outerLocalInsts mvarTy .syntheticOpaque + hypsMVarsRef.modify (·.push hypsMVar.mvarId!) + pure (mkAppN hypsMVar allBinders) + let pjpBody ← Meta.mkAppOptM ``Lean.Order.CompleteLattice.ofProp #[info.Pred, instCL, propMatch] + let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple + #[info.Pred, info.EPred, info.Prog, info.Value, info.args[4]!, info.args[5]!, + mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] + pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get) -- A `rest` alt that never mentions `fv` cannot jump to the join point; the JP is unreachable -- through it, so its precondition is `False`, discharging that branch of the body proof vacuously. @@ -383,8 +375,10 @@ private def stopOrErrorOnMissingSpec (prog monad : Expr) (thms : Array SpecTheor Candidates were {thms.map (·.proof)}." /-- At a JP jump site `__do_jp args`, assign the applicable alt's precondition mvar `?Hᵢ` to an -existential closure of the join-argument equalities over the jump site's local context. -/ -private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM Unit := do +existential closure of the join-argument equalities over the jump site's local context. Returns +`(altIdx, witnesses)` where `witnesses` are the actual locals for those `∃` binders, so the jump's +precondition VC can be discharged by construction. -/ +private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM (Option (Nat × Array Expr)) := do let info := jpInfo.splitInfo let joinArgs := e.getAppArgs -- The applicable alt is the one whose discriminant `rwIfOrMatcher` succeeds on here. @@ -397,10 +391,9 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM Unit := do if res.proof?.isNone then continue altIdx? := some idx break - let some altIdx := altIdx? | return - unless altIdx < jpInfo.hypsMVars.size do return + let some altIdx := altIdx? | return none + unless altIdx < jpInfo.hypsMVars.size do return none let hypsMVar := jpInfo.hypsMVars[altIdx]! - if ← hypsMVar.isAssigned then return trace[Elab.Tactic.Do.vcgen] "JP jump: alt {altIdx} args={joinArgs}" liftMetaM do let mvarTy ← hypsMVar.getType @@ -409,17 +402,15 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM Unit := do |>.filterMap id |>.filter (fun decl => !decl.isImplementationDetail) let newLocals := newLocalDecls.map LocalDecl.toExpr - -- `?Hᵢ : joinParams → altFVars → Prop`; all binders are its own. let mvarArity ← Meta.forallTelescopeReducing mvarTy fun xs _ => pure xs.size Meta.forallBoundedTelescope mvarTy mvarArity fun allBinders _ => do let numJP := joinArgs.size - unless numJP ≤ allBinders.size do return + unless numJP ≤ allBinders.size do return none let jpBinders := allBinders.extract 0 numJP - -- `⌜jpBinders = joinArgs⌝`, existentially/let-closed over the alt-local decls to be valid in - -- the mvar's def-site context. + -- `∃ locals, joinParams = joinArgs`, existentially/let-closing the alt-local decls to be valid + -- in the mvar's def-site context. let eqs ← (jpBinders.mapIdx fun i jp => (jp, i)).mapM fun (jp, i) => Meta.mkEq jp joinArgs[i]! - let φProp := (mkAndN eqs.toList).abstract newLocals - let (_, φPropClosed) ← newLocalDecls.foldrM (init := (newLocals, φProp)) + let (_, φPropClosed) ← newLocalDecls.foldrM (init := (newLocals, (mkAndN eqs.toList).abstract newLocals)) fun decl (locals, φ) => do let locals := locals.pop let type := (← instantiateMVars decl.type).abstract locals @@ -430,7 +421,62 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM Unit := do | none => let typeLevel ← Meta.getLevel decl.type return (locals, mkApp2 (mkConst ``Exists [typeLevel]) type (Expr.lam decl.userName type φ .default)) - hypsMVar.assign (← Meta.mkLambdaFVars allBinders φPropClosed) + unless ← hypsMVar.isAssigned do + hypsMVar.assign (← Meta.mkLambdaFVars allBinders φPropClosed) + -- The `∃` binders are exactly the non-let locals, in order; hand them back as witnesses. + return some (altIdx, (newLocalDecls.filter (·.value?.isNone)).map LocalDecl.toExpr) + +/-- Prove `∃ locals, ⋀ joinArgs = joinArgs` by supplying each `∃` binder from `witnesses` (the actual +locals) and closing the residual equalities by `rfl`. -/ +private partial def fillJPExists (g : MVarId) (witnesses : List Expr) : MetaM Unit := do + let ty ← Meta.whnfR (← g.getType) + match_expr ty with + | Exists α p => + let w :: ws := witnesses | throwError "JP witness underflow" + let hGoal ← Meta.mkFreshExprSyntheticOpaqueMVar (p.beta #[w]) + g.assign (mkApp4 (mkConst ``Exists.intro [← Meta.getLevel α]) α p w hGoal) + fillJPExists hGoal.mvarId! ws + | And a b => + let ga ← Meta.mkFreshExprSyntheticOpaqueMVar a + let gb ← Meta.mkFreshExprSyntheticOpaqueMVar b + g.assign (mkApp4 (mkConst ``And.intro) a b ga gb) + fillJPExists ga.mvarId! witnesses + fillJPExists gb.mvarId! witnesses + | True => g.assign (mkConst ``True.intro) + | Eq _ lhs _ => g.assign (← Meta.mkEqRefl lhs) + | _ => throwError "JP witness: unexpected residual{indentExpr ty}" + +/-- Discharge a JP jump's precondition VC `pre ⊑ ⌜match discrs => ?Hᵢ⌝` by reducing the match to the +applicable alt with the jump's discriminant evidence and witnessing the resulting existential with the +jump's own locals. Returns `true` when it closed `g`; other subgoals are left. -/ +private def tryCloseJPPrecond (g : MVarId) (altIdx : Nat) (witnesses : Array Expr) : VCGenM Bool := + g.withContext do + let_expr PartialOrder.rel _l _inst pre rhs := ← g.getType | return false + -- `rhs` is `⌜match discrs => ?Hᵢ⌝`, on a stateful assertion applied to the introduced state args. + let rhsArgs := rhs.getAppArgs + unless rhs.getAppFn.isConstOf ``CompleteLattice.ofProp && rhsArgs.size ≥ 3 do return false + let matchExpr := rhsArgs[2]! + let some redRes ← liftMetaM <| (try + some <$> Lean.Elab.Tactic.Do.rwIfOrMatcher altIdx matchExpr + catch _ => pure none) + | return false + let some redProof := redRes.proof? | return false + liftMetaM do + let φGoal ← Meta.mkFreshExprSyntheticOpaqueMVar redRes.expr + -- A witness of the reduced alt gives `matchExpr`, hence `pre ⊑ ⌜matchExpr⌝`. Strip the state + -- args off the RHS with `ofProp_apply` (`⌜φ⌝ s = ⌜φ⌝`) and transport back to the original goal. + let hMatch ← Meta.mkEqMP (← Meta.mkEqSymm redProof) φGoal + let leProof ← Meta.mkAppM ``Std.Internal.Do.CompleteLattice.le_ofProp #[pre, hMatch] + let sthms ← ({} : Meta.SimpTheorems).addConst ``Lean.Order.CompleteLattice.ofProp_apply + let (res, _) ← Meta.simp rhs (← Meta.Simp.mkContext (simpTheorems := #[sthms])) + match res.proof? with + | some rhsEq => + let motive ← Meta.withLocalDeclD `x (← Meta.inferType rhs) fun x => do + Meta.mkLambdaFVars #[x] (← Meta.mkAppM ``PartialOrder.rel #[pre, x]) + g.assign (← Meta.mkEqMPR (← Meta.mkCongrArg motive rhsEq) leProof) + | none => g.assign leProof + fillJPExists φGoal.mvarId! witnesses.toList + return true /-- Select the highest-priority `@[spec]` theorem matching `prog`, or a stop result when none matches. Hands `findSpecs` the sole reference to the spec database so its in-place pattern internalization does @@ -460,8 +506,9 @@ private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm -- At a JP jump site, assign its alt precondition, then build the rule at a fresh mvar depth so the -- synthetic body/precondition mvars survive `abstractMVars` as constants (shared across jump sites). let jpInfo? := info.prog.getAppFn.fvarId?.bind scope.knownJP? - if let some jpInfo := jpInfo? then - tryAssignJPHyps jpInfo info.prog + let jpAssign? ← match jpInfo? with + | some jpInfo => tryAssignJPHyps jpInfo info.prog + | none => pure none let some rule ← try let build := (mkBackwardRuleFromSpecCached thm info).run @@ -486,6 +533,12 @@ private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm Pred:{indentExpr info.Pred}\n\ excessArgs: {info.excessArgs}\n\ rule type:{indentExpr ruleType}" + if let some (altIdx, witnesses) := jpAssign? then + let mut remaining := #[] + for g in goals do + unless ← tryCloseJPPrecond g altIdx witnesses do + remaining := remaining.push g + return .goalsInScope scope remaining.toList return .goalsInScope scope goals /-- True iff the program matches the `until` pattern, in which case VC generation stops at this diff --git a/src/Std/Internal/Do/Order/Lemmas.lean b/src/Std/Internal/Do/Order/Lemmas.lean index ec2438d37db7..8dba69fb0752 100644 --- a/src/Std/Internal/Do/Order/Lemmas.lean +++ b/src/Std/Internal/Do/Order/Lemmas.lean @@ -218,6 +218,9 @@ theorem ofProp_meet_le_right {φ : Prop} (h : φ → Q ⊑ R) : Q ⊓ (⌜φ⌝ theorem ofProp_eq_top {φ : Prop} (h : φ) : (⌜φ⌝ : l) = ⊤ := (ofProp_congr ⟨fun _ => trivial, fun _ => h⟩).trans (CompleteLattice.ofProp_true l) +theorem le_ofProp {φ : Prop} (P : l) (h : φ) : P ⊑ ⌜φ⌝ := by + rw [ofProp_eq_top h]; exact le_top P + theorem ofProp_and {φ₁ φ₂ : Prop} : (⌜φ₁⌝ : l) ⊓ ⌜φ₂⌝ = ⌜φ₁ ∧ φ₂⌝ := by apply rel_antisymm · apply ofProp_meet_le_right diff --git a/tests/elab/symZetaJPMwe.lean b/tests/elab/symZetaJPMwe.lean deleted file mode 100644 index 5e37f21269eb..000000000000 --- a/tests/elab/symZetaJPMwe.lean +++ /dev/null @@ -1,39 +0,0 @@ -import Lean.Meta.Sym.Pattern -import Lean.Meta.Sym.Intro - -/-! MWE for the zeta that `+jp` spec construction hits. - -`Sym.introN` introduces a nondep `let` (`have`) as a *dependent* ldecl: `Intro.lean` calls -`mkLetDecl` without threading the letE's `nondep` flag. `mkSpecTheorem` then runs -`Sym.preprocessType`, whose `zetaReduce` unfolds the dependent fvar, so a spec keyed on -`@fv joinParams` is re-keyed on the join-point body. Marking the fvar nondep preserves it. -/ - -open Lean Meta Sym - -/-- -info: [Sym.introN: isNondep=false] preprocessType: 3 = 3 ---- -info: [fixed: isNondep=true] preprocessType: f✝ 3 = f✝ 3 --/ -#guard_msgs in -run_meta do - let nat := mkConst ``Nat - let arrow : Expr := .forallE `_ nat nat .default -- Nat → Nat - let val ← withLocalDeclD `x nat fun x => mkLambdaFVars #[x] x -- `fun x => x` - let target := Expr.letE `f arrow val (mkConst ``True) (nondep := true) -- nondep `have f` - let mvar ← mkFreshExprMVar target - SymM.run do - let .goal newDecls newGoal ← Sym.introN mvar.mvarId! 1 | return - -- (1) as `Sym.introN` leaves it: dependent, so `preprocessType` zeta-reduces `f 3` - newGoal.withContext do - let f := mkFVar newDecls[0]! - let ty ← mkEq (mkApp f (mkNatLit 3)) (mkApp f (mkNatLit 3)) - let nd := ((← getLCtx).find? newDecls[0]!).get!.isNondep - logInfo m!"[Sym.introN: isNondep={nd}] preprocessType: {← Sym.preprocessType ty}" - -- (2) with the fix (nondep): `preprocessType` preserves `f 3` - newGoal.modifyLCtx fun lctx => lctx.modifyLocalDecl newDecls[0]! (·.setNondep true) - newGoal.withContext do - let f := mkFVar newDecls[0]! - let ty ← mkEq (mkApp f (mkNatLit 3)) (mkApp f (mkNatLit 3)) - let nd := ((← getLCtx).find? newDecls[0]!).get!.isNondep - logInfo m!"[fixed: isNondep={nd}] preprocessType: {← Sym.preprocessType ty}" diff --git a/tests/elab/vcgenJPs.lean b/tests/elab/vcgenJPs.lean index 2a3a3c2b353c..5d14bd2a7f28 100644 --- a/tests/elab/vcgenJPs.lean +++ b/tests/elab/vcgenJPs.lean @@ -71,24 +71,18 @@ theorem dmatches_pure_triple : ⦃ True ⦄ dmatches_pure f ⦃ fun r => r > 0 vcgen +jp all_goals grind -/- Multi-discriminant dependent matches make the jump-site precondition a proof-carrying existential -(`∃ … (h : …), … cast … h …`) that `grind` cannot witness; the two `mixed_matches_*` cases are -exercised once the join point constructs that witness directly. def mixed_matches_pure (f : Nat → Option Nat) : Id Nat := do let mut x := 0 match h : f 0, f 10 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 match h : f 1, f 11 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 match h : f 2, f 12 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 match h : f 3, f 13 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 - match h : f 4, f 14 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 - match h : f 5, f 15 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 return x theorem mixed_matches_pure_triple : ⦃ True ⦄ mixed_matches_pure f ⦃ fun r => r > 0 ⦄ := by unfold mixed_matches_pure vcgen +jp all_goals grind --/ def if_state (f : Nat → Bool) : StateM Nat Nat := do let mut x := 0 @@ -127,8 +121,6 @@ theorem set42_triple : ⦃ fun _ => True ⦄ set42 ⦃ fun _ s => ⌜s > 13⌝ vcgen [set42] grind --- Same proof-carrying-existential gap as `mixed_matches_pure`. -/- def mixed_matches_state (f : Nat → Option Nat) : StateM Nat Nat := do set 42 let mut x := 0 @@ -156,7 +148,6 @@ theorem mixed_matches_state_triple : ⦃ fun _ => True ⦄ mixed_matches_state f unfold mixed_matches_state vcgen +jp all_goals grind --/ def early_return (f : Nat → Option Nat) : Id Nat := do let mut x := 1 From 064f71e52bfc093f884fdf46cc156095f1657a21 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 17 Jul 2026 08:33:04 +0000 Subject: [PATCH 09/35] feat: key vcgen +jp jump-site facts on the spec's own alt binders Pair the join-point spec's alt binders with the corresponding jump-site locals instead of existentially closing over the whole alt context: the body split's alt telescope is the matcher's alt telescope interleaved with overlap hypotheses and added discriminant equalities, so the pattern variables and user equations are matched up as an order-preserving subsequence and substituted, leaving only the splitter-specific binders under the existential. The join-point body then sees the shared precondition expressed directly in its own pattern variables, which `grind` discharges without unfolding nested existentials; the six-way multi-discriminant dependent-match case in `tests/elab/vcgenJPs.lean` is restored to full size and the whole file elaborates in under two seconds. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 38 ++++++++++++++++--- tests/elab/vcgenJPs.lean | 2 + 2 files changed, 34 insertions(+), 6 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 521cd6c0149a..8740a119aacb 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -401,16 +401,41 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM (Option (Na let newLocalDecls := lctx.decls.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push |>.filterMap id |>.filter (fun decl => !decl.isImplementationDetail) - let newLocals := newLocalDecls.map LocalDecl.toExpr let mvarArity ← Meta.forallTelescopeReducing mvarTy fun xs _ => pure xs.size Meta.forallBoundedTelescope mvarTy mvarArity fun allBinders _ => do let numJP := joinArgs.size unless numJP ≤ allBinders.size do return none let jpBinders := allBinders.extract 0 numJP - -- `∃ locals, joinParams = joinArgs`, existentially/let-closing the alt-local decls to be valid - -- in the mvar's def-site context. + let altBinders := allBinders.extract numJP allBinders.size + -- The body split's alt telescope is the matcher's own alt telescope interleaved with extra + -- binders (overlap hypotheses, added discriminant equalities) and followed by lets, so the + -- mvar's alt binders form an order-preserving subsequence of the leading non-let jump-site + -- locals. Pair them up by type so those locals become the mvar's own binders; everything + -- unpaired is closed over below. + let mut matchedLocals : Array Expr := #[] + let mut matchedBinders : Array Expr := #[] + let mut matchedIdxs : Array Nat := #[] + let mut cursor := 0 + for i in [:altBinders.size] do + let binderTy := (← Meta.inferType altBinders[i]!).replaceFVars matchedBinders matchedLocals + for j in [cursor:newLocalDecls.size] do + let decl := newLocalDecls[j]! + if decl.value?.isSome then break + if ← Meta.isDefEqGuarded binderTy (← instantiateMVars decl.type) then + matchedLocals := matchedLocals.push decl.toExpr + matchedBinders := matchedBinders.push altBinders[i]! + matchedIdxs := matchedIdxs.push j + cursor := j + 1 + break + let mut restDecls : Array LocalDecl := #[] + for j in [:newLocalDecls.size] do + unless matchedIdxs.contains j do + restDecls := restDecls.push newLocalDecls[j]! + let restLocals := restDecls.map LocalDecl.toExpr + -- `∃ rest, joinParams = joinArgs`, existentially/let-closing only the unpaired locals; the + -- paired ones are then rewritten to the mvar's own alt binders. let eqs ← (jpBinders.mapIdx fun i jp => (jp, i)).mapM fun (jp, i) => Meta.mkEq jp joinArgs[i]! - let (_, φPropClosed) ← newLocalDecls.foldrM (init := (newLocals, (mkAndN eqs.toList).abstract newLocals)) + let (_, φPropClosed) ← restDecls.foldrM (init := (restLocals, (mkAndN eqs.toList).abstract restLocals)) fun decl (locals, φ) => do let locals := locals.pop let type := (← instantiateMVars decl.type).abstract locals @@ -421,10 +446,11 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM (Option (Na | none => let typeLevel ← Meta.getLevel decl.type return (locals, mkApp2 (mkConst ``Exists [typeLevel]) type (Expr.lam decl.userName type φ .default)) + let φPropClosed := φPropClosed.replaceFVars matchedLocals matchedBinders unless ← hypsMVar.isAssigned do hypsMVar.assign (← Meta.mkLambdaFVars allBinders φPropClosed) - -- The `∃` binders are exactly the non-let locals, in order; hand them back as witnesses. - return some (altIdx, (newLocalDecls.filter (·.value?.isNone)).map LocalDecl.toExpr) + -- The `∃` binders are exactly the non-let rest locals, in order; hand them back as witnesses. + return some (altIdx, (restDecls.filter (·.value?.isNone)).map LocalDecl.toExpr) /-- Prove `∃ locals, ⋀ joinArgs = joinArgs` by supplying each `∃` binder from `witnesses` (the actual locals) and closing the residual equalities by `rfl`. -/ diff --git a/tests/elab/vcgenJPs.lean b/tests/elab/vcgenJPs.lean index 5d14bd2a7f28..167cb2335218 100644 --- a/tests/elab/vcgenJPs.lean +++ b/tests/elab/vcgenJPs.lean @@ -77,6 +77,8 @@ def mixed_matches_pure (f : Nat → Option Nat) : Id Nat := do match h : f 1, f 11 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 match h : f 2, f 12 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 match h : f 3, f 13 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 + match h : f 4, f 14 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 + match h : f 5, f 15 with | some y, some z => x := x + (cast (congrArg (fun _ => Nat) h) y) + z + 1 | _, some _ => x := x + 2 | _, _ => x := x + 1 return x theorem mixed_matches_pure_triple : ⦃ True ⦄ mixed_matches_pure f ⦃ fun r => r > 0 ⦄ := by From b5e7659da405044a801f1d7bf99a635294079267 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 17 Jul 2026 08:51:22 +0000 Subject: [PATCH 10/35] feat: close vcgen +jp jump-site facts over referenced locals only Keep an unpaired jump-site local in the join-point precondition only when the join-argument equalities transitively reference it through kept let values. Split bookkeeping such as overlap hypotheses and added discriminant equalities is re-derived on the consuming side when the match hypothesis is split, so dropping it leaves the precondition free of existentials in the common case, matching what `mvcgen +jp` emits. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 26 ++++++++++++++----- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 8740a119aacb..9ac7f49bbde1 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -427,14 +427,26 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM (Option (Na matchedIdxs := matchedIdxs.push j cursor := j + 1 break - let mut restDecls : Array LocalDecl := #[] - for j in [:newLocalDecls.size] do - unless matchedIdxs.contains j do - restDecls := restDecls.push newLocalDecls[j]! - let restLocals := restDecls.map LocalDecl.toExpr - -- `∃ rest, joinParams = joinArgs`, existentially/let-closing only the unpaired locals; the - -- paired ones are then rewritten to the mvar's own alt binders. let eqs ← (jpBinders.mapIdx fun i jp => (jp, i)).mapM fun (jp, i) => Meta.mkEq jp joinArgs[i]! + -- Close only over the unpaired locals the equalities transitively reference (through kept + -- lets' values); split bookkeeping like overlap hypotheses and added discriminant equalities + -- is re-derived on the consuming side when the match hypothesis is split, so it is dropped. + -- Right-to-left suffices: a local can only reference earlier ones. + let mut restDeclsRev : Array LocalDecl := #[] + let mut referenced : Array Expr := #[← instantiateMVars (mkAndN eqs.toList)] + for j' in [:newLocalDecls.size] do + let j := newLocalDecls.size - 1 - j' + if matchedIdxs.contains j then continue + let decl := newLocalDecls[j]! + if referenced.any (·.containsFVar decl.fvarId) then + restDeclsRev := restDeclsRev.push decl + referenced := referenced.push (← instantiateMVars decl.type) + if let some v := decl.value? then + referenced := referenced.push (← instantiateMVars v) + let restDecls := restDeclsRev.reverse + let restLocals := restDecls.map LocalDecl.toExpr + -- `∃ rest, joinParams = joinArgs`, existentially/let-closing the kept locals; the paired ones + -- are then rewritten to the mvar's own alt binders. let (_, φPropClosed) ← restDecls.foldrM (init := (restLocals, (mkAndN eqs.toList).abstract restLocals)) fun decl (locals, φ) => do let locals := locals.pop From 25b2392df12fa6aa62992738543ecdcd26be19cb Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 17 Jul 2026 11:01:21 +0000 Subject: [PATCH 11/35] test: cover more vcgen +jp shapes in vcgenJPs Add join-point cases along axes the suite did not exercise: several mutable variables (multiple join-argument equalities), an effectful shared tail (spec application inside the join-point body), and literal/successor patterns (a `Nat.casesOn`-shaped matcher). A split nested inside an alt and a throwing alt fail under `vcgen +jp` and `mvcgen +jp` alike and are recorded as commented cases. --- tests/elab/vcgenJPs.lean | 71 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) diff --git a/tests/elab/vcgenJPs.lean b/tests/elab/vcgenJPs.lean index 167cb2335218..b04b76f86864 100644 --- a/tests/elab/vcgenJPs.lean +++ b/tests/elab/vcgenJPs.lean @@ -162,3 +162,74 @@ theorem early_return_triple : ⦃ True ⦄ early_return f ⦃ fun r => r > 0 ⦄ unfold early_return vcgen +jp all_goals grind + +-- Two mutable variables: the join carries several join-argument equalities. +def multi_mut (f : Nat → Option Nat) : Id Nat := do + let mut x := 0 + let mut y := 1 + match f 0 with | some z => x := x + z; y := y + x | none => y := y + 2 + match f 1 with | some z => x := x + z + y | none => x := x + y + return x + y + +theorem multi_mut_triple : ⦃ True ⦄ multi_mut f ⦃ fun r => r > 0 ⦄ := by + unfold multi_mut + vcgen +jp + all_goals grind + +-- The shared tail performs an effect, so the join-point body applies specs under the +-- match-valued precondition hypothesis. +def monadic_tail (f : Nat → Option Nat) : StateM Nat Nat := do + let mut x := 1 + match f 0 with | some y => x := x + y | none => x := x + 2 + set x + match f 1 with | some y => x := x + y | none => x := x + 2 + set x + return x + +theorem monadic_tail_triple : ⦃ fun _ => True ⦄ monadic_tail f ⦃ fun r => ⌜r > 0⌝ ⦄ := by + unfold monadic_tail + vcgen +jp + all_goals grind + +-- Literal and successor patterns produce a `Nat.casesOn`-shaped matcher. +def literal_patterns (n m : Nat) : Id Nat := do + let mut x := 1 + match n with | 0 => x := x + 1 | k+1 => x := x + k + 2 + match m with | 0 => x := x + 1 | k+1 => x := x + k + 2 + return x + +theorem literal_patterns_triple : ⦃ True ⦄ literal_patterns n m ⦃ fun r => r > 0 ⦄ := by + unfold literal_patterns + vcgen +jp + all_goals grind + +/- A split nested inside an alt (the inner join point's body is a jump to the outer one) and a +throwing alt (the jump behind `throw` is dead code, leaving its precondition unassigned) fail +under `vcgen +jp` and `mvcgen +jp` alike; these cases are exercised once join points support them. +def nested_split (f : Nat → Option Nat) : Id Nat := do + let mut x := 0 + match f 0 with + | some y => if y > 0 then x := x + y else x := x + 1 + | none => x := x + 2 + match f 1 with + | some y => if y > 0 then x := x + y else x := x + 1 + | none => x := x + 2 + return x + +theorem nested_split_triple : ⦃ True ⦄ nested_split f ⦃ fun r => r > 0 ⦄ := by + unfold nested_split + vcgen +jp + all_goals grind + +def throwing (f : Nat → Option Nat) : ExceptT String (StateM Nat) Nat := do + let mut x := 1 + match f 0 with | some y => x := x + y | none => throw "none" + match f 1 with | some y => x := x + y | none => x := x + 2 + return x + +theorem throwing_triple : + ⦃ fun _ => True ⦄ throwing f ⦃ fun r => ⌜r > 0⌝; epost⟨fun _ _ => True⟩ ⦄ := by + unfold throwing + vcgen +jp + all_goals grind +-/ From 4f09c91f788ee1e66210165e3b5a7396dc234585 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 17 Jul 2026 11:28:31 +0000 Subject: [PATCH 12/35] feat: finalize vcgen +jp jump preconditions as payload disjunctions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Defer assignment of the join-point alt-precondition mvars to a finalization pass after VC generation: each jump records its payload and witnesses, and `finalizeJPs` assigns every `?Hᵢ` the disjunction of its recorded payloads before discharging each jump goal with its own disjunct. An alt no jump reaches gets `False`, so a jump that is dead code behind a `throw` no longer leaves an unassigned metavariable, and several jumps into one alt, as arise from an `if` nested inside a match alt, no longer race for a single assignment. Payload closure now drops exactly the outer split's own bookkeeping (overlap hypotheses, added discriminant equalities, an outer `ite`'s condition proof), which the consuming side re-derives when splitting the match hypothesis; facts from within the alt, such as an inner `if` condition, are kept under the existential. Tests: `nested_split` and `throwing` in `tests/elab/vcgenJPs.lean` exercise the two shapes; both also fail under legacy `mvcgen +jp`. --- .../Tactic/Do/Internal/VCGen/Context.lean | 16 ++ .../Elab/Tactic/Do/Internal/VCGen/Driver.lean | 1 + .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 159 +++++++++++------- tests/elab/vcgenJPs.lean | 8 +- 4 files changed, 122 insertions(+), 62 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index e5ca0f7aa2f0..c8a365dc1995 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -163,6 +163,18 @@ public structure VCGen.Scope where nextDeclIdx : Nat := 0 deriving Inhabited +/-- A deferred join-point jump: the alt-precondition mvar it targets, its open precondition +subgoal, the payload proposition (abstracted over the mvar's binders), the witnesses for the +payload's existentials, and the reduction of the subgoal's precondition match to the applicable +alt. Resolved by `finalizeJPs`. -/ +public structure JPJumpRecord where + hypsMVar : MVarId + goal : MVarId + payload : Expr + witnesses : Array Expr + redExpr : Expr + redProof : Expr + public structure VCGen.State where /-- A cache mapping registered SpecThms to their backward rule to apply. @@ -224,6 +236,10 @@ public structure VCGen.State where this to know which user-provided alts have already been consumed (so it doesn't warn about them). -/ inlineHandledInvariants : Std.HashSet Nat := {} + /-- All join-point alt-precondition mvars, in registration order. Assigned by `finalizeJPs`. -/ + jpHypsMVars : Array MVarId := #[] + /-- Deferred join-point jumps, in jump order. Discharged by `finalizeJPs`. -/ + jpJumps : Array JPJumpRecord := #[] public abbrev VCGenM := ReaderT VCGen.Context (StateRefT VCGen.State Grind.GrindM) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean index 6f7d8efe700b..6ea8bdeb3b78 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean @@ -124,6 +124,7 @@ public def work (scope : Scope) (goal : Grind.Goal) : VCGenM Unit := do let kept := scopedSubgoals.filter (fun (_, mv) => mvarIds.contains mv) worklist := worklist ++ kept.reverse.toArray.map (fun (scope, mv) => { goal := { goal with mvarId := mv }, scope }) + finalizeJPs public structure Result where /-- All invariant goals emitted during VC generation, in emit order. The MVarId at diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 9ac7f49bbde1..fbbc0f3de68d 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -303,14 +303,9 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get) - -- A `rest` alt that never mentions `fv` cannot jump to the join point; the JP is unreachable - -- through it, so its precondition is `False`, discharging that branch of the body proof vacuously. - for idx in [:sinfo.altInfos.size] do - let (_, alt) := sinfo.altInfos[idx]! - if alt.hasAnyFVar (· == fvId) then continue - let mv := hypsMVars[idx]! - liftMetaM <| Meta.forallTelescopeReducing (← mv.getType) fun xs _ => do - mv.assign (← Meta.mkLambdaFVars xs (mkConst ``False)) + -- `finalizeJPs` assigns each `?Hᵢ` the disjunction of its recorded jump payloads (`False` when + -- no jump reaches the alt, e.g. behind an early `return` or a `throw`). + modify fun s => { s with jpHypsMVars := s.jpHypsMVars ++ hypsMVars } let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← goal.getTag) let some joinSpec ← liftMetaM <| SpecAttr.mkSpecTheoremFromStx (← getRef) bodyMV @@ -374,11 +369,13 @@ private def stopOrErrorOnMissingSpec (prog monad : Expr) (thms : Array SpecTheor throwError "No spec matching the monad {monad} found for program {prog}. \ Candidates were {thms.map (·.proof)}." -/-- At a JP jump site `__do_jp args`, assign the applicable alt's precondition mvar `?Hᵢ` to an -existential closure of the join-argument equalities over the jump site's local context. Returns -`(altIdx, witnesses)` where `witnesses` are the actual locals for those `∃` binders, so the jump's -precondition VC can be discharged by construction. -/ -private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM (Option (Nat × Array Expr)) := do +/-- At a JP jump site `__do_jp args`, build this jump's payload for the applicable alt's +precondition mvar `?Hᵢ`: an existential closure of the join-argument equalities over the jump +site's local context, abstracted over the mvar's binders. Returns `(altIdx, payload, witnesses)` +where `witnesses` are the actual locals for the payload's `∃` binders; `finalizeJPs` assigns +`?Hᵢ` the disjunction of its jumps' payloads and discharges each jump goal by construction. -/ +private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e : Expr) : + VCGenM (Option (Nat × Expr × Array Expr)) := do let info := jpInfo.splitInfo let joinArgs := e.getAppArgs -- The applicable alt is the one whose discriminant `rwIfOrMatcher` succeeds on here. @@ -428,22 +425,28 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM (Option (Na cursor := j + 1 break let eqs ← (jpBinders.mapIdx fun i jp => (jp, i)).mapM fun (jp, i) => Meta.mkEq jp joinArgs[i]! - -- Close only over the unpaired locals the equalities transitively reference (through kept - -- lets' values); split bookkeeping like overlap hypotheses and added discriminant equalities - -- is re-derived on the consuming side when the match hypothesis is split, so it is dropped. - -- Right-to-left suffices: a local can only reference earlier ones. - let mut restDeclsRev : Array LocalDecl := #[] - let mut referenced : Array Expr := #[← instantiateMVars (mkAndN eqs.toList)] - for j' in [:newLocalDecls.size] do - let j := newLocalDecls.size - 1 - j' + -- Close over the unpaired locals, dropping only the outer split's own bookkeeping, which the + -- consuming side re-derives when it splits the match/ite hypothesis: interleaved overlap + -- hypotheses, added equalities on the outer discriminants, and an outer `ite`'s condition + -- proof. Facts from within the alt (inner split conditions, monadic binders) are kept. + let outerDiscrs : Array Expr := match info with + | .matcher m => m.discrs + | _ => #[] + let iteCond? : Option Expr := match info with + | .ite e => some (e.getArg! 1) + | _ => none + let mut restDecls : Array LocalDecl := #[] + for j in [:newLocalDecls.size] do if matchedIdxs.contains j then continue let decl := newLocalDecls[j]! - if referenced.any (·.containsFVar decl.fvarId) then - restDeclsRev := restDeclsRev.push decl - referenced := referenced.push (← instantiateMVars decl.type) - if let some v := decl.value? then - referenced := referenced.push (← instantiateMVars v) - let restDecls := restDeclsRev.reverse + if decl.value?.isNone then + if j < cursor then continue + let ty ← instantiateMVars decl.type + if let some (_, lhs, _) := ty.eq? then + if ← outerDiscrs.anyM (Meta.isDefEqGuarded · lhs) then continue + if let some c := iteCond? then + if (← Meta.isDefEqGuarded ty c) || (← Meta.isDefEqGuarded ty (mkNot c)) then continue + restDecls := restDecls.push decl let restLocals := restDecls.map LocalDecl.toExpr -- `∃ rest, joinParams = joinArgs`, existentially/let-closing the kept locals; the paired ones -- are then rewritten to the mvar's own alt binders. @@ -459,10 +462,9 @@ private def tryAssignJPHyps (jpInfo : JPDefInfo) (e : Expr) : VCGenM (Option (Na let typeLevel ← Meta.getLevel decl.type return (locals, mkApp2 (mkConst ``Exists [typeLevel]) type (Expr.lam decl.userName type φ .default)) let φPropClosed := φPropClosed.replaceFVars matchedLocals matchedBinders - unless ← hypsMVar.isAssigned do - hypsMVar.assign (← Meta.mkLambdaFVars allBinders φPropClosed) -- The `∃` binders are exactly the non-let rest locals, in order; hand them back as witnesses. - return some (altIdx, (restDecls.filter (·.value?.isNone)).map LocalDecl.toExpr) + return some (altIdx, ← Meta.mkLambdaFVars allBinders φPropClosed, + (restDecls.filter (·.value?.isNone)).map LocalDecl.toExpr) /-- Prove `∃ locals, ⋀ joinArgs = joinArgs` by supplying each `∃` binder from `witnesses` (the actual locals) and closing the residual equalities by `rfl`. -/ @@ -484,38 +486,77 @@ private partial def fillJPExists (g : MVarId) (witnesses : List Expr) : MetaM Un | Eq _ lhs _ => g.assign (← Meta.mkEqRefl lhs) | _ => throwError "JP witness: unexpected residual{indentExpr ty}" -/-- Discharge a JP jump's precondition VC `pre ⊑ ⌜match discrs => ?Hᵢ⌝` by reducing the match to the -applicable alt with the jump's discriminant evidence and witnessing the resulting existential with the -jump's own locals. Returns `true` when it closed `g`; other subgoals are left. -/ -private def tryCloseJPPrecond (g : MVarId) (altIdx : Nat) (witnesses : Array Expr) : VCGenM Bool := +/-- Record a JP jump's precondition VC `pre ⊑ ⌜match discrs => ?Hᵢ⌝` for `finalizeJPs`, verifying +that the match reduces to the applicable alt with the jump's discriminant evidence. Returns `true` +when `g` was recorded (and thus withheld from the worklist); other subgoals are left. -/ +private def tryDeferJPPrecond (g hypsMVar : MVarId) (altIdx : Nat) (payload : Expr) + (witnesses : Array Expr) : VCGenM Bool := g.withContext do - let_expr PartialOrder.rel _l _inst pre rhs := ← g.getType | return false + let_expr PartialOrder.rel _l _inst _pre rhs := ← g.getType | return false -- `rhs` is `⌜match discrs => ?Hᵢ⌝`, on a stateful assertion applied to the introduced state args. let rhsArgs := rhs.getAppArgs unless rhs.getAppFn.isConstOf ``CompleteLattice.ofProp && rhsArgs.size ≥ 3 do return false let matchExpr := rhsArgs[2]! - let some redRes ← liftMetaM <| (try + let some red ← liftMetaM <| (try some <$> Lean.Elab.Tactic.Do.rwIfOrMatcher altIdx matchExpr catch _ => pure none) | return false - let some redProof := redRes.proof? | return false - liftMetaM do - let φGoal ← Meta.mkFreshExprSyntheticOpaqueMVar redRes.expr - -- A witness of the reduced alt gives `matchExpr`, hence `pre ⊑ ⌜matchExpr⌝`. Strip the state - -- args off the RHS with `ofProp_apply` (`⌜φ⌝ s = ⌜φ⌝`) and transport back to the original goal. - let hMatch ← Meta.mkEqMP (← Meta.mkEqSymm redProof) φGoal - let leProof ← Meta.mkAppM ``Std.Internal.Do.CompleteLattice.le_ofProp #[pre, hMatch] - let sthms ← ({} : Meta.SimpTheorems).addConst ``Lean.Order.CompleteLattice.ofProp_apply - let (res, _) ← Meta.simp rhs (← Meta.Simp.mkContext (simpTheorems := #[sthms])) - match res.proof? with - | some rhsEq => - let motive ← Meta.withLocalDeclD `x (← Meta.inferType rhs) fun x => do - Meta.mkLambdaFVars #[x] (← Meta.mkAppM ``PartialOrder.rel #[pre, x]) - g.assign (← Meta.mkEqMPR (← Meta.mkCongrArg motive rhsEq) leProof) - | none => g.assign leProof - fillJPExists φGoal.mvarId! witnesses.toList + let some redProof := red.proof? | return false + let record : JPJumpRecord := + { hypsMVar, goal := g, payload, witnesses, redExpr := red.expr, redProof } + modify fun s => { s with jpJumps := s.jpJumps.push record } return true +/-- Prove disjunct `idx` of the `count`-fold right-nested disjunction `φ`, witnessing the selected +disjunct via `fillJPExists`. -/ +private partial def proveJPDisjunct (φ : Expr) (idx count : Nat) (witnesses : List Expr) : + MetaM Expr := do + if count == 1 then + let m ← Meta.mkFreshExprSyntheticOpaqueMVar φ + fillJPExists m.mvarId! witnesses + return m + let_expr Or a b := φ | throwError "JP finalization: expected disjunction{indentExpr φ}" + match idx with + | 0 => return mkApp3 (mkConst ``Or.inl) a b (← proveJPDisjunct a 0 1 witnesses) + | idx + 1 => return mkApp3 (mkConst ``Or.inr) a b (← proveJPDisjunct b idx (count - 1) witnesses) + +/-- Discharge a recorded JP jump: prove its own disjunct (number `idx` of `count`) of the assigned +`?Hᵢ`, then close the jump goal `pre ⊑ ⌜match discrs => ?Hᵢ⌝` with it. The state args a stateful +assertion is applied to are stripped with `ofProp_apply` (`⌜φ⌝ s = ⌜φ⌝`) and the proof transported +back to the original goal. -/ +private def dischargeJPJump (r : JPJumpRecord) (idx count : Nat) : VCGenM Unit := + r.goal.withContext do liftMetaM do + let_expr PartialOrder.rel _l _inst pre rhs := ← r.goal.getType + | throwError "JP finalization: unexpected jump goal{indentExpr (← r.goal.getType)}" + let φPrf ← proveJPDisjunct (← instantiateMVars r.redExpr) idx count r.witnesses.toList + let hMatch ← Meta.mkEqMP (← Meta.mkEqSymm r.redProof) φPrf + let leProof ← Meta.mkAppM ``Std.Internal.Do.CompleteLattice.le_ofProp #[pre, hMatch] + let sthms ← ({} : Meta.SimpTheorems).addConst ``Lean.Order.CompleteLattice.ofProp_apply + let (res, _) ← Meta.simp rhs (← Meta.Simp.mkContext (simpTheorems := #[sthms])) + match res.proof? with + | some rhsEq => + let motive ← Meta.withLocalDeclD `x (← Meta.inferType rhs) fun x => do + Meta.mkLambdaFVars #[x] (← Meta.mkAppM ``PartialOrder.rel #[pre, x]) + r.goal.assign (← Meta.mkEqMPR (← Meta.mkCongrArg motive rhsEq) leProof) + | none => r.goal.assign leProof + +/-- Assign every `+jp` alt-precondition mvar `?Hᵢ` the disjunction of the payloads its recorded +jumps provided (`False` when no jump reaches the alt, e.g. behind an early `return` or a `throw`), +then discharge each recorded jump goal with its own disjunct. -/ +public def finalizeJPs : VCGenM Unit := do + let s ← get + for mv in s.jpHypsMVars do + let records := s.jpJumps.filter (·.hypsMVar == mv) + unless ← mv.isAssigned do + liftMetaM <| Meta.forallTelescopeReducing (← mv.getType) fun bs _ => do + let props := records.map (·.payload.beta bs) + let φ := match props.back? with + | none => mkConst ``False + | some last => props.pop.foldr (init := last) (mkApp2 (mkConst ``Or)) + mv.assign (← Meta.mkLambdaFVars bs φ) + for h : i in [:records.size] do + dischargeJPJump records[i] i records.size + /-- Select the highest-priority `@[spec]` theorem matching `prog`, or a stop result when none matches. Hands `findSpecs` the sole reference to the spec database so its in-place pattern internalization does not copy the discrimination tree, then threads the updated database back into the returned scope. -/ @@ -541,11 +582,12 @@ a stop result when no rule matches the goal's monad. Reached from `applyFrameOrS private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm : SpecTheorem) : VCGenM SolveResult := do trace[Elab.Tactic.Do.vcgen] "Applying spec {thm.proof} for {info.prog}. Excess args: {info.excessArgs}" - -- At a JP jump site, assign its alt precondition, then build the rule at a fresh mvar depth so the - -- synthetic body/precondition mvars survive `abstractMVars` as constants (shared across jump sites). + -- At a JP jump site, build its alt-precondition payload, then build the rule at a fresh mvar depth + -- so the synthetic body/precondition mvars survive `abstractMVars` as constants (shared across jump + -- sites). let jpInfo? := info.prog.getAppFn.fvarId?.bind scope.knownJP? - let jpAssign? ← match jpInfo? with - | some jpInfo => tryAssignJPHyps jpInfo info.prog + let jpJump? ← match jpInfo? with + | some jpInfo => mkJPJumpPayload? jpInfo info.prog | none => pure none let some rule ← try @@ -571,10 +613,11 @@ private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm Pred:{indentExpr info.Pred}\n\ excessArgs: {info.excessArgs}\n\ rule type:{indentExpr ruleType}" - if let some (altIdx, witnesses) := jpAssign? then + if let some (altIdx, payload, witnesses) := jpJump? then + let hypsMVar := (jpInfo?.get!).hypsMVars[altIdx]! let mut remaining := #[] for g in goals do - unless ← tryCloseJPPrecond g altIdx witnesses do + unless ← tryDeferJPPrecond g hypsMVar altIdx payload witnesses do remaining := remaining.push g return .goalsInScope scope remaining.toList return .goalsInScope scope goals diff --git a/tests/elab/vcgenJPs.lean b/tests/elab/vcgenJPs.lean index b04b76f86864..fed5c58ad097 100644 --- a/tests/elab/vcgenJPs.lean +++ b/tests/elab/vcgenJPs.lean @@ -203,9 +203,8 @@ theorem literal_patterns_triple : ⦃ True ⦄ literal_patterns n m ⦃ fun r => vcgen +jp all_goals grind -/- A split nested inside an alt (the inner join point's body is a jump to the outer one) and a -throwing alt (the jump behind `throw` is dead code, leaving its precondition unassigned) fail -under `vcgen +jp` and `mvcgen +jp` alike; these cases are exercised once join points support them. +-- A split nested inside an alt: both branches of the inner `if` jump to the same alt of the +-- outer join point, so its precondition is the disjunction of the two jump payloads. def nested_split (f : Nat → Option Nat) : Id Nat := do let mut x := 0 match f 0 with @@ -221,6 +220,8 @@ theorem nested_split_triple : ⦃ True ⦄ nested_split f ⦃ fun r => r > 0 ⦄ vcgen +jp all_goals grind +-- The `none` alt throws: its jump is dead code behind `throw`, so the alt's precondition is +-- finalized to `False`. def throwing (f : Nat → Option Nat) : ExceptT String (StateM Nat) Nat := do let mut x := 1 match f 0 with | some y => x := x + y | none => throw "none" @@ -232,4 +233,3 @@ theorem throwing_triple : unfold throwing vcgen +jp all_goals grind --/ From a8a79f3fe2e891fe79ff83b318aa2842006c54d7 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 17 Jul 2026 12:27:04 +0000 Subject: [PATCH 13/35] refactor: pair vcgen +jp jump-site locals by recorded split layout Replace the defeq-based pairing of the join-point spec's alt binders with jump-site locals by a structural layout recorded at registration: `JPAltLayout` stores the segment sizes of the body split's alt telescope (`fields ++ overlaps ++ discrEqs ++ extraEqs`, per `MatcherApp.TransformAltFVars`) alongside the spec's own binder count, so pairing and bookkeeping classification become positional slicing. A thunked nullary alt's `Unit` parameter exists on the spec side only and stays unpaired. Layout mismatches and jumps yielding no precondition subgoal now raise errors instead of degrading silently. Also restore `wpFVarZeta?` to dependent-let values only, reuse `Lean.Order.le_ofProp` in place of a duplicate lemma, group recorded jumps and build the finalization simp context once, and drop a redundant second telescope of the precondition mvar's type. --- .../Tactic/Do/Internal/VCGen/Context.lean | 27 +++- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 140 ++++++++++-------- src/Std/Internal/Do/Order/Lemmas.lean | 3 - tests/bench/vcgen/vcgen_ifs_jp.lean | 3 + 4 files changed, 105 insertions(+), 68 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index c8a365dc1995..5ac7d7c03713 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -135,20 +135,37 @@ public structure VCGen.Context where once the program in `wp⟦e⟧` matches `pat`, before applying a spec. -/ untilPat? : Option Sym.Pattern := none -/-- Definition-site info for a `__do_jp` synthetic spec, indexed by the JP's let-fvar. +/-- Per-alt binder layout of a join point's split: the segment sizes of the alt telescope the body +split introduces at each jump site (`fields ++ overlaps ++ discrEqs ++ extraEqs`, per +`MatcherApp.TransformAltFVars.all`), and the number of alt binders of the synthetic spec (the +matcher alt's own parameters: fields, then discriminant equations, or a single thunk parameter). +Positions the spec binders within the jump-site telescope without unification. -/ +public structure JPAltLayout where + bodyFields : Nat + bodyOverlaps : Nat + bodyDiscrEqs : Nat + bodyExtraEqs : Nat + specBinders : Nat + deriving Inhabited + +/-- Length of the alt telescope the body split introduces at a jump site. -/ +public def JPAltLayout.bodyTeleLen (l : JPAltLayout) : Nat := + l.bodyFields + l.bodyOverlaps + l.bodyDiscrEqs + l.bodyExtraEqs -Recorded by `tryJoinPointDef` when it registers the JP's synthetic spec, and consulted by -`tryAssignJPHyps` at each jump site to assign the alt-specific precondition mvar -`hypsMVars[altIdx]` to an existential closure over the jump site's local context. -/ +/-- Definition-site info for a `__do_jp` synthetic spec, indexed by the JP's let-fvar. Recorded when +the JP's synthetic spec is registered and consulted at each jump site to build the jump's payload +for the alt-specific precondition mvar `hypsMVars[altIdx]`. -/ public structure JPDefInfo where /-- Per-alt synthetic-opaque precondition mvars. Each has type - `(joinParams ++ altParams) → Pred`, assigned at the corresponding jump site. -/ + `(joinParams ++ altParams) → Prop`, assigned by `finalizeJPs`. -/ hypsMVars : Array MVarId /-- The join point's continuation splitter; its discriminant selects the alt at each jump site. -/ splitInfo : Lean.Elab.Tactic.Do.SplitInfo /-- Size of the local context at the JP definition site. Locals introduced beyond this index are alt-local and get existentially closed when building the jump-site `φ`. -/ outerLCtxSize : Nat + /-- Per-alt binder layouts, aligned with `hypsMVars`. -/ + altLayouts : Array JPAltLayout deriving Inhabited public structure VCGen.Scope where diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index fbbc0f3de68d..161607ca85c7 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -257,13 +257,29 @@ private def wpLet? (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) := do | throwError "Failed to intro hoisted let" return some goal +/-- Per-alt segment sizes of the alt telescope the body split (`mkBackwardRuleForSplit`, splitter +form with added equalities) introduces at each jump site, computed the same way over the abstracted +split. -/ +private def computeBodyAltLayouts (sinfo : Lean.Elab.Tactic.Do.SplitInfo) (progTy : Expr) : + MetaM (Array (Nat × Nat × Nat × Nat)) := do + match sinfo with + | .ite _ | .dite _ => return #[(1, 0, 0, 0), (1, 0, 0, 0)] + | .matcher _ => + let ref ← IO.mkRef (#[] : Array (Nat × Nat × Nat × Nat)) + discard <| sinfo.withAbstract progTy fun abstractInfo _ => + abstractInfo.splitWith (mkSort .zero) (useSplitter := true) + fun _name _expAltType _idx altFVars => do + ref.modify (·.push (altFVars.fields.size, altFVars.overlaps.size, + altFVars.discrEqs.size, altFVars.extraEqs.size)) + pure (mkConst ``True) + ref.get + /-- `+jp`: at `wp⟦jpGadget fv rest⟧` with `rest` an `if`/`match`, register a `Triple` spec for the -join point `fv` and split into two subgoals, the JP body and the (gadget-stripped) `rest`. Then -`body` is proved once and each jump `fv args` in `rest` closes via `applySpec` rather than inlining -`body`. +join point `fv` and split into two subgoals, the JP body and the (gadget-stripped) `rest`. `body` +is proved once and each jump `fv args` in `rest` closes via `applySpec`. The spec's precondition splits the same way as `rest`: in branch `i` it is a fresh metavariable -`?Hᵢ`, which the jump in that branch fills in with the facts that hold there. -/ +`?Hᵢ`, which the jumps in that branch fill in with the facts that hold there. -/ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM (Option SolveResult) := do let_expr Std.Internal.Do.jpGadget _α _β fv rest := info.prog | return none @@ -280,13 +296,14 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let numJoinParams ← liftMetaM <| Lean.Elab.Tactic.Do.getNumJoinParams joinTy resTy -- Create the `?Hᵢ` mvars in the outer local context so the rule construction's `abstractMVars` - -- keeps them shared across jump sites instead of lifting the splitter telescope into each. + -- keeps them shared across jump sites. let outerLCtx ← liftMetaM getLCtx let outerLocalInsts ← liftMetaM getLocalInstances let instCL ← liftMetaM <| Meta.synthInstance (← Meta.mkAppM ``Lean.Order.CompleteLattice #[info.Pred]) - let (bodyTy, hypsMVars) ← liftMetaM <| + let (bodyTy, hypsMVars, specSizes) ← liftMetaM <| Meta.forallBoundedTelescope joinTy numJoinParams fun joinParams _ => do let hypsMVarsRef ← IO.mkRef (#[] : Array MVarId) + let specSizesRef ← IO.mkRef (#[] : Array Nat) -- Split the precondition at `Prop` (each `?Hᵢ` produces a `Prop`) and embed the match via `⌜·⌝`. -- Each jump discharges its instance by construction (`ofProp_eq_top` of the witnessed alt); the -- body proof case-splits the bare `Prop` match that `⌜φ⌝ s` reduces to. @@ -296,23 +313,31 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let mvarTy ← Meta.mkForallFVars allBinders (mkSort .zero) let hypsMVar ← Meta.mkFreshExprMVarAt outerLCtx outerLocalInsts mvarTy .syntheticOpaque hypsMVarsRef.modify (·.push hypsMVar.mvarId!) + specSizesRef.modify (·.push altFVars.all.size) pure (mkAppN hypsMVar allBinders) let pjpBody ← Meta.mkAppOptM ``Lean.Order.CompleteLattice.ofProp #[info.Pred, instCL, propMatch] let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple #[info.Pred, info.EPred, info.Prog, info.Value, info.args[4]!, info.args[5]!, mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] - pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get) + pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get, ← specSizesRef.get) + + let bodySizes ← liftMetaM <| computeBodyAltLayouts sinfo info.Prog + unless bodySizes.size == specSizes.size do + throwError "vcgen +jp: alt count mismatch between spec and body splits of{indentExpr rest}" + let altLayouts := bodySizes.zipWith (fun (bF, bO, bD, bE) sB => + { bodyFields := bF, bodyOverlaps := bO, bodyDiscrEqs := bD, bodyExtraEqs := bE + specBinders := sB : JPAltLayout }) specSizes -- `finalizeJPs` assigns each `?Hᵢ` the disjunction of its recorded jump payloads (`False` when -- no jump reaches the alt, e.g. behind an early `return` or a `throw`). - modify fun s => { s with jpHypsMVars := s.jpHypsMVars ++ hypsMVars } + modify fun s => { s with jpHypsMVars := hypsMVars.foldl (·.push ·) s.jpHypsMVars } let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← goal.getTag) let some joinSpec ← liftMetaM <| SpecAttr.mkSpecTheoremFromStx (← getRef) bodyMV | return some (.goalsInScope scope [restGoal]) let outerLCtxSize := (← restGoal.getDecl).lctx.numIndices - let jpDefInfo : JPDefInfo := { hypsMVars, splitInfo := sinfo, outerLCtxSize } + let jpDefInfo : JPDefInfo := { hypsMVars, splitInfo := sinfo, outerLCtxSize, altLayouts } -- `bodyMV` keeps the original scope so its own head is not treated as a JP. let restScope := (scope.insertSpec joinSpec).registerJP fvId jpDefInfo return some (.goals [(restScope, restGoal), (scope, bodyMV.mvarId!)]) @@ -342,7 +367,7 @@ private def wpFVarZeta? (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) : let f := info.prog.getAppFn let some fvarId := f.fvarId? | return none if (scope.knownJP? fvarId).isSome then return none - let some val ← fvarId.getValue? (allowNondep := true) | return none + let some val ← fvarId.getValue? | return none trace[Elab.Tactic.Do.vcgen] "fvar-zeta: {(← fvarId.getUserName)}" let prog ← shareCommonInc (val.betaRev info.prog.getAppRevArgs) return some (← replaceProgDefEq goal info prog) @@ -392,61 +417,45 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e : Expr) : unless altIdx < jpInfo.hypsMVars.size do return none let hypsMVar := jpInfo.hypsMVars[altIdx]! trace[Elab.Tactic.Do.vcgen] "JP jump: alt {altIdx} args={joinArgs}" + let layout := jpInfo.altLayouts[altIdx]! liftMetaM do let mvarTy ← hypsMVar.getType let lctx ← getLCtx let newLocalDecls := lctx.decls.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push |>.filterMap id |>.filter (fun decl => !decl.isImplementationDetail) - let mvarArity ← Meta.forallTelescopeReducing mvarTy fun xs _ => pure xs.size - Meta.forallBoundedTelescope mvarTy mvarArity fun allBinders _ => do + Meta.forallTelescopeReducing mvarTy fun allBinders _ => do let numJP := joinArgs.size unless numJP ≤ allBinders.size do return none let jpBinders := allBinders.extract 0 numJP let altBinders := allBinders.extract numJP allBinders.size - -- The body split's alt telescope is the matcher's own alt telescope interleaved with extra - -- binders (overlap hypotheses, added discriminant equalities) and followed by lets, so the - -- mvar's alt binders form an order-preserving subsequence of the leading non-let jump-site - -- locals. Pair them up by type so those locals become the mvar's own binders; everything - -- unpaired is closed over below. + -- The leading jump-site locals are the body split's alt telescope, + -- `fields ++ overlaps ++ discrEqs ++ extraEqs` with the sizes recorded in `layout`. The mvar's + -- alt binders are the fields and discrEqs of the spec-side split, so they pair positionally; + -- the remaining telescope binders are the split's own bookkeeping, which the consuming side + -- re-derives when it splits the match/ite hypothesis, and are dropped. Locals beyond the + -- telescope (inner split conditions, monadic binders) are kept and closed over below. + -- The spec binders are the matcher alt's own parameters, fields first and then discriminant + -- equations; a thunked nullary alt has a single `Unit` parameter on the spec side only, which + -- stays unpaired and unused. + let pairedFields := min layout.specBinders layout.bodyFields + let pairedEqs := min (layout.specBinders - pairedFields) layout.bodyDiscrEqs + unless altBinders.size == layout.specBinders && + layout.bodyTeleLen ≤ newLocalDecls.size && + layout.specBinders - pairedFields - pairedEqs ≤ 1 do + throwError "vcgen +jp: jump-site telescope does not match the recorded alt layout for \ + {indentExpr e}" let mut matchedLocals : Array Expr := #[] let mut matchedBinders : Array Expr := #[] - let mut matchedIdxs : Array Nat := #[] - let mut cursor := 0 - for i in [:altBinders.size] do - let binderTy := (← Meta.inferType altBinders[i]!).replaceFVars matchedBinders matchedLocals - for j in [cursor:newLocalDecls.size] do - let decl := newLocalDecls[j]! - if decl.value?.isSome then break - if ← Meta.isDefEqGuarded binderTy (← instantiateMVars decl.type) then - matchedLocals := matchedLocals.push decl.toExpr - matchedBinders := matchedBinders.push altBinders[i]! - matchedIdxs := matchedIdxs.push j - cursor := j + 1 - break + for i in [:pairedFields] do + matchedLocals := matchedLocals.push newLocalDecls[i]!.toExpr + matchedBinders := matchedBinders.push altBinders[i]! + for i in [:pairedEqs] do + matchedLocals := matchedLocals.push + newLocalDecls[layout.bodyFields + layout.bodyOverlaps + i]!.toExpr + matchedBinders := matchedBinders.push altBinders[pairedFields + i]! let eqs ← (jpBinders.mapIdx fun i jp => (jp, i)).mapM fun (jp, i) => Meta.mkEq jp joinArgs[i]! - -- Close over the unpaired locals, dropping only the outer split's own bookkeeping, which the - -- consuming side re-derives when it splits the match/ite hypothesis: interleaved overlap - -- hypotheses, added equalities on the outer discriminants, and an outer `ite`'s condition - -- proof. Facts from within the alt (inner split conditions, monadic binders) are kept. - let outerDiscrs : Array Expr := match info with - | .matcher m => m.discrs - | _ => #[] - let iteCond? : Option Expr := match info with - | .ite e => some (e.getArg! 1) - | _ => none - let mut restDecls : Array LocalDecl := #[] - for j in [:newLocalDecls.size] do - if matchedIdxs.contains j then continue - let decl := newLocalDecls[j]! - if decl.value?.isNone then - if j < cursor then continue - let ty ← instantiateMVars decl.type - if let some (_, lhs, _) := ty.eq? then - if ← outerDiscrs.anyM (Meta.isDefEqGuarded · lhs) then continue - if let some c := iteCond? then - if (← Meta.isDefEqGuarded ty c) || (← Meta.isDefEqGuarded ty (mkNot c)) then continue - restDecls := restDecls.push decl + let restDecls := newLocalDecls.extract layout.bodyTeleLen newLocalDecls.size let restLocals := restDecls.map LocalDecl.toExpr -- `∃ rest, joinParams = joinArgs`, existentially/let-closing the kept locals; the paired ones -- are then rewritten to the mvar's own alt binders. @@ -524,15 +533,15 @@ private partial def proveJPDisjunct (φ : Expr) (idx count : Nat) (witnesses : L `?Hᵢ`, then close the jump goal `pre ⊑ ⌜match discrs => ?Hᵢ⌝` with it. The state args a stateful assertion is applied to are stripped with `ofProp_apply` (`⌜φ⌝ s = ⌜φ⌝`) and the proof transported back to the original goal. -/ -private def dischargeJPJump (r : JPJumpRecord) (idx count : Nat) : VCGenM Unit := +private def dischargeJPJump (sctx : Meta.Simp.Context) (r : JPJumpRecord) (idx count : Nat) : + VCGenM Unit := r.goal.withContext do liftMetaM do let_expr PartialOrder.rel _l _inst pre rhs := ← r.goal.getType | throwError "JP finalization: unexpected jump goal{indentExpr (← r.goal.getType)}" let φPrf ← proveJPDisjunct (← instantiateMVars r.redExpr) idx count r.witnesses.toList let hMatch ← Meta.mkEqMP (← Meta.mkEqSymm r.redProof) φPrf - let leProof ← Meta.mkAppM ``Std.Internal.Do.CompleteLattice.le_ofProp #[pre, hMatch] - let sthms ← ({} : Meta.SimpTheorems).addConst ``Lean.Order.CompleteLattice.ofProp_apply - let (res, _) ← Meta.simp rhs (← Meta.Simp.mkContext (simpTheorems := #[sthms])) + let leProof ← Meta.mkAppM ``Lean.Order.le_ofProp #[pre, ← Meta.inferType hMatch, hMatch] + let (res, _) ← Meta.simp rhs sctx match res.proof? with | some rhsEq => let motive ← Meta.withLocalDeclD `x (← Meta.inferType rhs) fun x => do @@ -545,17 +554,23 @@ jumps provided (`False` when no jump reaches the alt, e.g. behind an early `retu then discharge each recorded jump goal with its own disjunct. -/ public def finalizeJPs : VCGenM Unit := do let s ← get + if s.jpHypsMVars.isEmpty then return + let sthms ← ({} : Meta.SimpTheorems).addConst ``Lean.Order.CompleteLattice.ofProp_apply + let sctx ← Meta.Simp.mkContext (simpTheorems := #[sthms]) + let grouped : Std.HashMap MVarId (Array JPJumpRecord) := + s.jpJumps.foldl (init := {}) fun m r => + m.alter r.hypsMVar (fun rs? => some ((rs?.getD #[]).push r)) for mv in s.jpHypsMVars do - let records := s.jpJumps.filter (·.hypsMVar == mv) + let records := grouped.getD mv #[] unless ← mv.isAssigned do liftMetaM <| Meta.forallTelescopeReducing (← mv.getType) fun bs _ => do let props := records.map (·.payload.beta bs) let φ := match props.back? with | none => mkConst ``False - | some last => props.pop.foldr (init := last) (mkApp2 (mkConst ``Or)) + | some last => props.pop.foldr (init := last) mkOr mv.assign (← Meta.mkLambdaFVars bs φ) for h : i in [:records.size] do - dischargeJPJump records[i] i records.size + dischargeJPJump sctx records[i] i records.size /-- Select the highest-priority `@[spec]` theorem matching `prog`, or a stop result when none matches. Hands `findSpecs` the sole reference to the spec database so its in-place pattern internalization does @@ -616,9 +631,14 @@ private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm if let some (altIdx, payload, witnesses) := jpJump? then let hypsMVar := (jpInfo?.get!).hypsMVars[altIdx]! let mut remaining := #[] + let mut deferred := false for g in goals do - unless ← tryDeferJPPrecond g hypsMVar altIdx payload witnesses do + if ← tryDeferJPPrecond g hypsMVar altIdx payload witnesses then + deferred := true + else remaining := remaining.push g + unless deferred do + throwError "vcgen +jp: jump {indentExpr info.prog}\nyielded no precondition subgoal to defer" return .goalsInScope scope remaining.toList return .goalsInScope scope goals diff --git a/src/Std/Internal/Do/Order/Lemmas.lean b/src/Std/Internal/Do/Order/Lemmas.lean index 8dba69fb0752..ec2438d37db7 100644 --- a/src/Std/Internal/Do/Order/Lemmas.lean +++ b/src/Std/Internal/Do/Order/Lemmas.lean @@ -218,9 +218,6 @@ theorem ofProp_meet_le_right {φ : Prop} (h : φ → Q ⊑ R) : Q ⊓ (⌜φ⌝ theorem ofProp_eq_top {φ : Prop} (h : φ) : (⌜φ⌝ : l) = ⊤ := (ofProp_congr ⟨fun _ => trivial, fun _ => h⟩).trans (CompleteLattice.ofProp_true l) -theorem le_ofProp {φ : Prop} (P : l) (h : φ) : P ⊑ ⌜φ⌝ := by - rw [ofProp_eq_top h]; exact le_top P - theorem ofProp_and {φ₁ φ₂ : Prop} : (⌜φ₁⌝ : l) ⊓ ⌜φ₂⌝ = ⌜φ₁ ∧ φ₂⌝ := by apply rel_antisymm · apply ofProp_meet_le_right diff --git a/tests/bench/vcgen/vcgen_ifs_jp.lean b/tests/bench/vcgen/vcgen_ifs_jp.lean index 233266f165a3..4b789adbe398 100644 --- a/tests/bench/vcgen/vcgen_ifs_jp.lean +++ b/tests/bench/vcgen/vcgen_ifs_jp.lean @@ -6,6 +6,9 @@ Authors: Sebastian Graf import Cases.IfsJP import Driver +/-! Benchmark driver for the `IfsJP` case: `vcgen +jp` on a loop whose body chains `if`s with a +shared continuation. -/ + set_option mvcgen.warning false open Lean Order Parser Meta Elab Tactic Sym Std Internal.Do From eca8cf6c94265920247da0a59ac57d2507a9eb36 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 17 Jul 2026 14:06:43 +0000 Subject: [PATCH 14/35] fix: close trivial vcgen +jp jump post premises by reflexivity MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Close a jump subgoal `∀ xs, lhs ⊑ rhs` with definitionally equal sides directly in `applySpec`. The synthetic spec's postcondition is the registration goal's, so the jump's post-monotonicity premise carries the same postcondition on both sides, differing at most by eta; on the worklist the target simp unfolded the entailment and re-verified the continuation that postcondition carries, once per jump, which made the VC count grow exponentially in the number of sequenced splits. The `IfsJP` benchmark drops from 49 VCs and 2.4s of grind at n = 3 to a single VC discharged in under 30ms. --- src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 161607ca85c7..a2027f0bd537 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -495,6 +495,19 @@ private partial def fillJPExists (g : MVarId) (witnesses : List Expr) : MetaM Un | Eq _ lhs _ => g.assign (← Meta.mkEqRefl lhs) | _ => throwError "JP witness: unexpected residual{indentExpr ty}" +/-- Close a JP jump subgoal `∀ xs, lhs ⊑ rhs` with definitionally equal sides by reflexivity. The +synthetic spec's postcondition is the registration goal's, so the jump's post-monotonicity premise +has the shared postcondition on both sides (up to eta); left to the worklist, the target simp would +unfold the entailment and re-verify the continuation the postcondition carries, once per jump. -/ +private def tryCloseTrivialRefl (g : MVarId) : VCGenM Bool := + g.withContext do liftMetaM do + Meta.forallTelescope (← g.getType) fun xs body => do + let some (α, inst, lhs, rhs) := body.app4? ``PartialOrder.rel | return false + unless ← Meta.isDefEqGuarded lhs rhs do return false + let prf ← Meta.mkAppOptM ``Lean.Order.PartialOrder.rel_refl #[α, inst, lhs] + g.assign (← Meta.mkLambdaFVars xs prf) + return true + /-- Record a JP jump's precondition VC `pre ⊑ ⌜match discrs => ?Hᵢ⌝` for `finalizeJPs`, verifying that the match reduces to the applicable alt with the jump's discriminant evidence. Returns `true` when `g` was recorded (and thus withheld from the worklist); other subgoals are left. -/ @@ -635,6 +648,8 @@ private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm for g in goals do if ← tryDeferJPPrecond g hypsMVar altIdx payload witnesses then deferred := true + else if ← tryCloseTrivialRefl g then + pure () else remaining := remaining.push g unless deferred do From 3d06561be1b0031b69be08781bb9979556ffb7fb Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 17 Jul 2026 15:20:48 +0000 Subject: [PATCH 15/35] fix: close vcgen +jp post-monotonicity premise by construction The jump-site post-monotonicity premise of a +jp jump always has the shared continuation on both sides, defeq up to the join-point lets and eta. Assign rel_refl directly and let the kernel discharge the defeq, keeping the hot path free of definitional-equality checks. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index a2027f0bd537..3ad6278a8928 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -495,17 +495,16 @@ private partial def fillJPExists (g : MVarId) (witnesses : List Expr) : MetaM Un | Eq _ lhs _ => g.assign (← Meta.mkEqRefl lhs) | _ => throwError "JP witness: unexpected residual{indentExpr ty}" -/-- Close a JP jump subgoal `∀ xs, lhs ⊑ rhs` with definitionally equal sides by reflexivity. The -synthetic spec's postcondition is the registration goal's, so the jump's post-monotonicity premise -has the shared postcondition on both sides (up to eta); left to the worklist, the target simp would -unfold the entailment and re-verify the continuation the postcondition carries, once per jump. -/ +/-- Close a JP jump's post-monotonicity premise `∀ xs, lhs ⊑ rhs` by reflexivity. Both sides are the +shared continuation the synthetic spec carries as its postcondition, defeq up to the join-point `let`s +and eta, so `rel_refl lhs` is assigned and the kernel discharges the defeq. Left to the worklist, the +target simp would re-verify that continuation at every jump. -/ private def tryCloseTrivialRefl (g : MVarId) : VCGenM Bool := - g.withContext do liftMetaM do - Meta.forallTelescope (← g.getType) fun xs body => do - let some (α, inst, lhs, rhs) := body.app4? ``PartialOrder.rel | return false - unless ← Meta.isDefEqGuarded lhs rhs do return false - let prf ← Meta.mkAppOptM ``Lean.Order.PartialOrder.rel_refl #[α, inst, lhs] - g.assign (← Meta.mkLambdaFVars xs prf) + g.withContext do + forallTelescope (← g.getType) fun xs body => do + let_expr PartialOrder.rel α inst lhs _rhs := body | return false + let prf ← mkAppOptM ``Lean.Order.PartialOrder.rel_refl #[α, inst, lhs] + g.assign (← mkLambdaFVars xs prf) return true /-- Record a JP jump's precondition VC `pre ⊑ ⌜match discrs => ?Hᵢ⌝` for `finalizeJPs`, verifying From 2fd9c7d9c56d839d17340834040c335c73c4b0e8 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Mon, 20 Jul 2026 14:44:37 +0000 Subject: [PATCH 16/35] perf: share vcgen +jp continuation proofs across jump sites Bind each join point's body proof as a local hypothesis and reference it by fvar at every jump. The shared continuation proof then lives in a single `let` binding, so instantiating the assembled proof term visits the body once regardless of how many jumps reach it. Proof-term instantiation for the `IfsJP` benchmark drops from exponential to linear in the number of join levels (n=5: 1457ms to 1ms); verification-condition count and kernel time were already linear. --- src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 3ad6278a8928..3b29914ba40c 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -333,7 +333,11 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : modify fun s => { s with jpHypsMVars := hypsMVars.foldl (·.push ·) s.jpHypsMVars } let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← goal.getTag) - let some joinSpec ← liftMetaM <| SpecAttr.mkSpecTheoremFromStx (← getRef) bodyMV + -- Bind the body proof as a local hypothesis so each jump references it by fvar (`jpProof joinArgs`), + -- keeping the shared continuation proof in one `let` binding that survives proof-term instantiation. + let restGoal ← liftMetaM <| restGoal.define `jpProof bodyTy bodyMV + let (jpProofFVar, restGoal) ← liftMetaM <| restGoal.intro1P + let some joinSpec ← liftMetaM <| restGoal.withContext <| SpecAttr.mkSpecTheoremFromLocal jpProofFVar | return some (.goalsInScope scope [restGoal]) let outerLCtxSize := (← restGoal.getDecl).lctx.numIndices From 22850e7c405c2bb86f18d6ed45cb7e4ebad9bcd6 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Mon, 20 Jul 2026 14:57:51 +0000 Subject: [PATCH 17/35] test: scale IfsJP vcgen +jp benchmark to a ~1s size Raise the `IfsJP` benchmark size to 30, at which `vcgen +jp` takes roughly one second. With continuation proofs shared across jump sites the proof term is linear in the number of join levels (~770 shared nodes per level), so the size is bounded only by the tactic's own per-level cost rather than proof-term instantiation. --- tests/bench/vcgen/vcgen_ifs_jp.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/bench/vcgen/vcgen_ifs_jp.lean b/tests/bench/vcgen/vcgen_ifs_jp.lean index 4b789adbe398..e8e20196f492 100644 --- a/tests/bench/vcgen/vcgen_ifs_jp.lean +++ b/tests/bench/vcgen/vcgen_ifs_jp.lean @@ -20,4 +20,4 @@ set_option maxHeartbeats 10000000 -- `+jp` shares each trailing continuation across the splitter alts; without it every alt -- zeta-unfolds the `__do_jp` body and the VC count grows exponentially in the number of `if`s. #eval runBenchUsingTactic ``Goal [``loop, ``step] `(tactic| vcgen +jp) `(tactic| sorry) - [3] + [30] From 3f83c70a8566b2332a48e6490c4d773622bbeb70 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 06:51:42 +0000 Subject: [PATCH 18/35] refactor: mark implementation-detail binders when introducing them `Sym.introCore` now gives a binder whose name is an implementation detail (prefixed with `__`, e.g. a `__do_jp` join point) the `.implDetail` local-declaration kind, so `grind` skips it during internalization and it stays hidden from the user in intermediate goals. --- src/Lean/Meta/Sym/Intro.lean | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Lean/Meta/Sym/Intro.lean b/src/Lean/Meta/Sym/Intro.lean index 3bb7f1a40c01..ce5113d407bb 100644 --- a/src/Lean/Meta/Sym/Intro.lean +++ b/src/Lean/Meta/Sym/Intro.lean @@ -78,7 +78,8 @@ def introCore (mvarId : MVarId) (max : Nat) (names : Array Name) (hygienic : Boo | .forallE n type body bi => let type ← instantiateRevS type fvars let fvarId ← mkFreshFVarId - let lctx := lctx.mkLocalDecl fvarId (← mkName lctx n i) type bi + let kind := if n.isImplementationDetail then .implDetail else .default + let lctx := lctx.mkLocalDecl fvarId (← mkName lctx n i) type bi kind let fvar ← mkFVarS fvarId let fvars := fvars.push fvar let localInsts := updateLocalInsts localInsts fvar type @@ -91,8 +92,11 @@ def introCore (mvarId : MVarId) (max : Nat) (names : Array Name) (hygienic : Boo We have both dependent and non-dependent `let` expressions result in dependent `ldecl`s. This is fine here since we never revert them in the Sym framework. **Note**: If `type` is a proposition we could use a `cdecl`. + An implementation-detail binder (name prefixed with `__`, e.g. a `__do_jp` join point) is marked + so downstream consumers such as `grind` skip it and it stays hidden from the user. -/ - let lctx := lctx.mkLetDecl fvarId (← mkName lctx n i) type value + let kind := if n.isImplementationDetail then .implDetail else .default + let lctx := lctx.mkLetDecl fvarId (← mkName lctx n i) type value (kind := kind) let fvar ← mkFVarS fvarId let fvars := fvars.push fvar let localInsts := updateLocalInsts localInsts fvar type From 6ec5c337bcf03eb5389ef125bce02efebe83edfa Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 06:51:42 +0000 Subject: [PATCH 19/35] perf: close vcgen +jp jumps by construction without a synthetic spec This PR closes each `+jp` jump directly against the join point's body proof instead of registering a synthetic `Triple` spec and applying its backward rule, removing the discrimination-tree pattern construction (and its `preprocessType`/`zetaReduce` over the continuation) from the jump path. Join points are tail-called, so a jump's use-site post equals the body's post up to definitional equality; no post weakening is needed. Each jump `fv joinArgs` is closed with `rel_trans hPre (Triple.le_wp (jpProof joinArgs) ss)`, where `hPre` is the deferred precondition VC and the post equality is left to the kernel. The body proof and the abstracted precondition are recorded in the join-point registry, and the proof term is built on the share-common `SymM` path, so it never traverses the post. --- .../Tactic/Do/Internal/VCGen/Context.lean | 6 +++ .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 48 ++++++++++++++++--- 2 files changed, 48 insertions(+), 6 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index 5ac7d7c03713..8ab3c60eb97e 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -156,6 +156,12 @@ public def JPAltLayout.bodyTeleLen (l : JPAltLayout) : Nat := the JP's synthetic spec is registered and consulted at each jump site to build the jump's payload for the alt-specific precondition mvar `hypsMVars[altIdx]`. -/ public structure JPDefInfo where + /-- The join point's body proof, `∀ joinParams, Triple ⌜match discrs => ?Hᵢ⌝ (fv joinParams) Q`, + bound as a local hypothesis. Each jump is closed by `rel_trans` against `jpProof joinArgs`. -/ + jpProof : Expr + /-- The precondition abstracted over the join params, `fun joinParams => ⌜match discrs => ?Hᵢ⌝`. + Applied at each jump to form the mid-point of the `rel_trans`, avoiding a walk over the post `Q`. -/ + pjpBodyAbs : Expr /-- Per-alt synthetic-opaque precondition mvars. Each has type `(joinParams ++ altParams) → Prop`, assigned by `finalizeJPs`. -/ hypsMVars : Array MVarId diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 3b29914ba40c..0d649828cca3 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -300,7 +300,7 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let outerLCtx ← liftMetaM getLCtx let outerLocalInsts ← liftMetaM getLocalInstances let instCL ← liftMetaM <| Meta.synthInstance (← Meta.mkAppM ``Lean.Order.CompleteLattice #[info.Pred]) - let (bodyTy, hypsMVars, specSizes) ← liftMetaM <| + let (bodyTy, pjpBodyAbs, hypsMVars, specSizes) ← liftMetaM <| Meta.forallBoundedTelescope joinTy numJoinParams fun joinParams _ => do let hypsMVarsRef ← IO.mkRef (#[] : Array MVarId) let specSizesRef ← IO.mkRef (#[] : Array Nat) @@ -319,7 +319,8 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple #[info.Pred, info.EPred, info.Prog, info.Value, info.args[4]!, info.args[5]!, mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] - pure (← Meta.mkForallFVars joinParams tripleTy, ← hypsMVarsRef.get, ← specSizesRef.get) + pure (← Meta.mkForallFVars joinParams tripleTy, ← Meta.mkLambdaFVars joinParams pjpBody, + ← hypsMVarsRef.get, ← specSizesRef.get) let bodySizes ← liftMetaM <| computeBodyAltLayouts sinfo info.Prog unless bodySizes.size == specSizes.size do @@ -337,13 +338,12 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : -- keeping the shared continuation proof in one `let` binding that survives proof-term instantiation. let restGoal ← liftMetaM <| restGoal.define `jpProof bodyTy bodyMV let (jpProofFVar, restGoal) ← liftMetaM <| restGoal.intro1P - let some joinSpec ← liftMetaM <| restGoal.withContext <| SpecAttr.mkSpecTheoremFromLocal jpProofFVar - | return some (.goalsInScope scope [restGoal]) let outerLCtxSize := (← restGoal.getDecl).lctx.numIndices - let jpDefInfo : JPDefInfo := { hypsMVars, splitInfo := sinfo, outerLCtxSize, altLayouts } + let jpDefInfo : JPDefInfo := + { jpProof := .fvar jpProofFVar, pjpBodyAbs, hypsMVars, splitInfo := sinfo, outerLCtxSize, altLayouts } -- `bodyMV` keeps the original scope so its own head is not treated as a JP. - let restScope := (scope.insertSpec joinSpec).registerJP fvId jpDefInfo + let restScope := scope.registerJP fvId jpDefInfo return some (.goals [(restScope, restGoal), (scope, bodyMV.mvarId!)]) /-- Strategy 11b: split an `ite`/`dite`/match program, or iota-reduce a matcher with a concrete @@ -588,6 +588,39 @@ public def finalizeJPs : VCGenM Unit := do for h : i in [:records.size] do dischargeJPJump sctx records[i] i records.size +/-- Close a JP jump `fv joinArgs` directly against the join point's body proof, bypassing the spec +and backward-rule machinery. Join points are tail-called, so the use-site post equals the body's post +up to definitional equality; the proof is `rel_trans hPre (jpProof joinArgs ss)` with `hPre` the +recorded precondition VC `pre ⊑ ⌜match discrs => ?Hᵢ⌝ ss`, and the post equality is left to the kernel. +Building the proof term touches neither the post nor a discrimination-tree pattern, so it stays O(1) +in the size of the continuation. -/ +private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM (Option SolveResult) := do + let some fvId := info.prog.getAppFn.fvarId? | return none + let some jpInfo := scope.knownJP? fvId | return none + let some (altIdx, payload, witnesses) ← mkJPJumpPayload? jpInfo info.prog | return none + goal.withContext do + let goalTy ← goal.getType + let_expr Lean.Order.PartialOrder.rel α inst pre zGoal := goalTy | return none + let lvls := goalTy.getAppFn.constLevels! + let ss := info.excessArgs + let joinArgs := info.prog.getAppArgs + -- `jpProof joinArgs : Triple …` is a one-field structure; project its `⊑ wp` field (`Triple.le_wp`) + -- before applying the excess state args, which the function-lattice `⊑` accepts pointwise. + let jpRel := Expr.proj ``Std.Internal.Do.Triple 0 (← mkAppNS jpInfo.jpProof joinArgs) + let jpAppliedSS ← mkAppNS jpRel ss + -- `pjpBodyAbs` is a lambda over the join params; beta-reduce so the head is `⌜·⌝` (`ofProp`), which + -- `tryDeferJPPrecond` matches. The precondition carries no post `Q`, so this stays cheap. + let yBase ← mkAppNS (jpInfo.pjpBodyAbs.beta joinArgs) ss + let hPreTy ← mkAppNS (mkConst ``Lean.Order.PartialOrder.rel lvls) #[α, inst, pre, yBase] + let hPre ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar hPreTy (← goal.getTag) + let proof ← mkAppNS (mkConst ``Lean.Order.PartialOrder.rel_trans lvls) + #[α, inst, pre, yBase, zGoal, hPre, jpAppliedSS] + goal.assign proof + let hypsMVar := jpInfo.hypsMVars[altIdx]! + unless ← tryDeferJPPrecond hPre.mvarId! hypsMVar altIdx payload witnesses do + throwError "vcgen +jp: jump{indentExpr info.prog}\nyielded no precondition subgoal to defer" + return some (.goalsInScope scope []) + /-- Select the highest-priority `@[spec]` theorem matching `prog`, or a stop result when none matches. Hands `findSpecs` the sole reference to the spec database so its in-place pattern internalization does not copy the discrimination tree, then threads the updated database back into the returned scope. -/ @@ -890,6 +923,9 @@ public def solve (scope : VCGen.Scope) (goal : MVarId) : VCGenM SolveResult := g if let some g ← wpHeadReduce? goal info then VCGen.burnOne return .goalsInScope scope [g] + if let some r ← tryJPJump? scope goal info then + VCGen.burnOne + return r let f := info.prog.getAppFn if f.isConst || f.isFVar then VCGen.burnOne From 67e6f86f5d784de7f894ebc9b9afee5c8567822c Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 12:58:16 +0000 Subject: [PATCH 20/35] refactor: bound the assumption search to a context-index window Add optional `lowerBound`/`upperBound` indices to `Meta.findLocalDeclWithType?`, restricting the search to declarations in `[lowerBound, upperBound)` of the local context, and thread them through `rwMatcher` and `rwIfOrMatcher` as `assumptionLowerBound`/`assumptionUpperBound`. The defaults (`0`) preserve the existing whole-context behavior for all current callers. --- src/Lean/Elab/Tactic/Do/VCGen/Split.lean | 12 +++++-- src/Lean/Meta/Match/Rewrite.lean | 16 ++++++--- src/Lean/Meta/Tactic/Assumption.lean | 36 ++++++++++++++----- .../{vcgen_ifs_jp.lean => vcgen_jp.lean} | 0 4 files changed, 48 insertions(+), 16 deletions(-) rename tests/bench/vcgen/{vcgen_ifs_jp.lean => vcgen_jp.lean} (100%) diff --git a/src/Lean/Elab/Tactic/Do/VCGen/Split.lean b/src/Lean/Elab/Tactic/Do/VCGen/Split.lean index 1a2a02abaf20..e0e4ac971b7b 100644 --- a/src/Lean/Elab/Tactic/Do/VCGen/Split.lean +++ b/src/Lean/Elab/Tactic/Do/VCGen/Split.lean @@ -188,12 +188,18 @@ def getSplitInfo? (e : Expr) : MetaM (Option SplitInfo) := do else return none -def rwIfOrMatcher (idx : Nat) (e : Expr) : MetaM Simp.Result := do +/-- Rewrite the `ite`/`dite`/matcher `e` to its `idx`-th alternative. With a `[assumptionLowerBound, +assumptionUpperBound)` window, the branch condition (ite/dite) and the matcher congruence hypotheses +are discharged by an assumption search confined to that window of the local context rather than the +whole of it (an `assumptionUpperBound` of `0` means the end of the context). -/ +def rwIfOrMatcher (idx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) + (assumptionUpperBound : Nat := 0) : MetaM Simp.Result := do if e.isAppOf ``ite || e.isAppOf ``dite then let c := e.getArg! 1 let c := if idx = 0 then c else mkNot c - let .some fv ← findLocalDeclWithType? c + let some fv ← findLocalDeclWithType? c (lowerBound := assumptionLowerBound) + (upperBound := assumptionUpperBound) | throwError "Failed to find proof for if condition {c}" rwIfWith (mkFVar fv) e else - rwMatcher idx e + rwMatcher idx e assumptionLowerBound assumptionUpperBound diff --git a/src/Lean/Meta/Match/Rewrite.lean b/src/Lean/Meta/Match/Rewrite.lean index abf51e233f5a..c8f59a2e008f 100644 --- a/src/Lean/Meta/Match/Rewrite.lean +++ b/src/Lean/Meta/Match/Rewrite.lean @@ -72,7 +72,15 @@ equation theorem cannot be discharged by assumption or reflixivity. See `Lean.Meta.Tactic.FunInd.buildInductionBody` and `Lean.Elab.Tactic.Do.VCGen.Split` for examples of how to coerce `MatherApp.transform` into doing the substitution on the motive for you. -/ -def rwMatcher (altIdx : Nat) (e : Expr) : MetaM Simp.Result := do +def rwMatcher (altIdx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) + (assumptionUpperBound : Nat := 0) : MetaM Simp.Result := do + -- Close `g` by an assumption at context index in `[assumptionLowerBound, assumptionUpperBound)`, so + -- the search for the congruence-equation hypotheses is confined to a window of the local context. + let assumptionProc (g : MVarId) : MetaM Bool := g.withContext do + match ← findLocalDeclWithType? (← g.getType) (lowerBound := assumptionLowerBound) + (upperBound := assumptionUpperBound) with + | some fvarId => g.assign (mkFVar fvarId); return true + | none => return false if e.isAppOf ``PSum.casesOn || e.isAppOf ``PSigma.casesOn then let mut e := e while true do @@ -124,11 +132,11 @@ def rwMatcher (altIdx : Nat) (e : Expr) : MetaM Simp.Result := do if Simp.isEqnThmHypothesis hType then -- Using unrestricted h.substVars here does not work well; it could -- even introduce a dependency on the `oldIH` we want to eliminate - h.assumption <|> throwError "Failed to discharge `{h}`" + unless ← assumptionProc h do throwError "Failed to discharge `{h}`" else if hType.isEq then - h.assumption <|> h.refl <|> throwError m!"Failed to resolve `{h}`" + unless ← assumptionProc h do h.refl <|> throwError m!"Failed to resolve `{h}`" else if hType.isHEq then - h.assumption <|> h.hrefl <|> throwError m!"Failed to resolve `{h}`" + unless ← assumptionProc h do h.hrefl <|> throwError m!"Failed to resolve `{h}`" let unassignedHyps ← hyps.filterM fun h => return !(← h.isAssigned) unless unassignedHyps.isEmpty do throwError m!"Not all hypotheses of `{.ofConstName eqnThm}` could be discharged: {unassignedHyps}" diff --git a/src/Lean/Meta/Tactic/Assumption.lean b/src/Lean/Meta/Tactic/Assumption.lean index 5d4d8f5ca066..2eea11f3ca5b 100644 --- a/src/Lean/Meta/Tactic/Assumption.lean +++ b/src/Lean/Meta/Tactic/Assumption.lean @@ -12,15 +12,33 @@ public section namespace Lean.Meta -/-- Return a local declaration whose type is definitionally equal to `type`. -/ -def findLocalDeclWithType? (type : Expr) : MetaM (Option FVarId) := do - (← getLCtx).findDeclRevM? fun localDecl => do - if localDecl.isImplementationDetail then - return none - else if (← isDefEq type localDecl.type) then - return some localDecl.fvarId - else - return none +/-- Return a local declaration whose type is definitionally equal to `type`, searching most-recent +first. With `lowerBound > 0` and/or `upperBound > 0`, only declarations at context index in +`[lowerBound, upperBound)` are considered (an `upperBound` of `0` means the end of the context), so +the scan is confined to a window of the local context rather than the whole of it. -/ +def findLocalDeclWithType? (type : Expr) (lowerBound : Nat := 0) (upperBound : Nat := 0) : + MetaM (Option FVarId) := do + let lctx ← getLCtx + if lowerBound == 0 && upperBound == 0 then + lctx.findDeclRevM? fun localDecl => do + if localDecl.isImplementationDetail then + return none + else if (← isDefEq type localDecl.type) then + return some localDecl.fvarId + else + return none + else + let hi := if upperBound == 0 then lctx.decls.size else min upperBound lctx.decls.size + let slice := (lctx.decls.foldl (init := (#[] : Array (Option LocalDecl))) (start := lowerBound) + Array.push).take (hi - lowerBound) + slice.findSomeRevM? fun localDecl? => do + let some localDecl := localDecl? | return none + if localDecl.isImplementationDetail then + return none + else if (← isDefEq type localDecl.type) then + return some localDecl.fvarId + else + return none /-- Return `true` if managed to close goal `mvarId` using an assumption. -/ def _root_.Lean.MVarId.assumptionCore (mvarId : MVarId) : MetaM Bool := diff --git a/tests/bench/vcgen/vcgen_ifs_jp.lean b/tests/bench/vcgen/vcgen_jp.lean similarity index 100% rename from tests/bench/vcgen/vcgen_ifs_jp.lean rename to tests/bench/vcgen/vcgen_jp.lean From be4c2c7fd1502cebf4bc025dc2b21af28c78bdf7 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 12:58:28 +0000 Subject: [PATCH 21/35] perf: discharge vcgen +jp jumps by construction over a bounded window This PR makes `vcgen +jp` scale linearly on loops whose bodies chain `if`s or `match`es with shared continuations, where matcher-shaped join points previously scaled quadratically. Each jump `fv args` is closed directly against the join point's body proof by `rel_trans`, and its precondition subgoal is discharged at finalization by construction (`le_ofProp` at the postcondition lattice with a constant precondition, transported across the match reduction), replacing the previous `Meta.simp` and `MetaM` proof-term stack. The applicable alternative and its reduction are found by rewriting the precondition match, discharging the branch condition and matcher congruence hypotheses by an assumption search confined to the enclosing split's telescope window `[outerLCtxSize, outerLCtxSize + max bodyTeleLen)`, so the search is a fixed size independent of the jump's depth. The join point's body proof is bound as an implementation-detail hypothesis so local-spec collection skips it rather than building a discrimination-tree pattern over its (continuation-sized) postcondition. --- .../Tactic/Do/Internal/VCGen/Context.lean | 28 ++- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 183 +++++++----------- 2 files changed, 96 insertions(+), 115 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index 8ab3c60eb97e..02df7050e246 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -172,6 +172,13 @@ public structure JPDefInfo where outerLCtxSize : Nat /-- Per-alt binder layouts, aligned with `hypsMVars`. -/ altLayouts : Array JPAltLayout + /-- The postcondition lattice, `wp`'s `Pred` argument. Each jump's precondition proof lives here. -/ + Pred : Expr + /-- The `CompleteLattice Pred` instance, for instantiating `le_ofProp`. -/ + instCL : Expr + /-- State-argument types the postcondition lattice ranges over, for building each jump's + constant precondition function. -/ + stateTys : Array Expr deriving Inhabited public structure VCGen.Scope where @@ -188,8 +195,9 @@ public structure VCGen.Scope where /-- A deferred join-point jump: the alt-precondition mvar it targets, its open precondition subgoal, the payload proposition (abstracted over the mvar's binders), the witnesses for the -payload's existentials, and the reduction of the subgoal's precondition match to the applicable -alt. Resolved by `finalizeJPs`. -/ +payload's existentials, the reduction of the subgoal's precondition match to the applicable alt, +and the data needed to close the subgoal `pre ⊑ ⌜match discrs => ?Hᵢ⌝ ss` by construction. +Resolved by `finalizeJPs`. -/ public structure JPJumpRecord where hypsMVar : MVarId goal : MVarId @@ -197,6 +205,17 @@ public structure JPJumpRecord where witnesses : Array Expr redExpr : Expr redProof : Expr + /-- The proposition `match discrs => ?Hᵢ` the jump's precondition embeds via `⌜·⌝`. -/ + matchExpr : Expr + /-- Constant function `fun _ => pre` at the postcondition lattice, so `le_ofProp` applied to the + state args reproduces the jump's precondition `pre`. -/ + constFn : Expr + /-- The postcondition lattice `Pred`, its universe level, and its `CompleteLattice` instance. -/ + Pred : Expr + predLevel : Level + instCL : Expr + /-- The state arguments the postcondition lattice is applied to. -/ + ss : Array Expr public structure VCGen.State where /-- @@ -285,7 +304,10 @@ public def Scope.collectLocalSpecs (scope : Scope) (goal : MVarId) : VCGenM Scop let lctx ← getLCtx if scope.nextDeclIdx == lctx.decls.size then return scope let scope ← lctx.foldlM (init := scope) (start := scope.nextDeclIdx) fun scope decl => do - if decl.isAuxDecl then return scope + -- Skip implementation-detail hypotheses (e.g. the `+jp` body proof `__do_jpProof`, the + -- `__do_jp` continuation): they are never user specs, and building a spec pattern from one + -- runs `preprocessType` over its post, scaling with the continuation. + if decl.isAuxDecl || decl.userName.isImplementationDetail then return scope try if let some thm ← mkSpecTheoremFromLocal decl.fvarId (eval_prio low) then return scope.insertSpec thm diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 0d649828cca3..34a5cd673d23 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -336,12 +336,14 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← goal.getTag) -- Bind the body proof as a local hypothesis so each jump references it by fvar (`jpProof joinArgs`), -- keeping the shared continuation proof in one `let` binding that survives proof-term instantiation. - let restGoal ← liftMetaM <| restGoal.define `jpProof bodyTy bodyMV + let restGoal ← liftMetaM <| restGoal.define `__do_jpProof bodyTy bodyMV let (jpProofFVar, restGoal) ← liftMetaM <| restGoal.intro1P let outerLCtxSize := (← restGoal.getDecl).lctx.numIndices + let stateTys ← liftMetaM <| info.excessArgs.mapM Meta.inferType let jpDefInfo : JPDefInfo := - { jpProof := .fvar jpProofFVar, pjpBodyAbs, hypsMVars, splitInfo := sinfo, outerLCtxSize, altLayouts } + { jpProof := .fvar jpProofFVar, pjpBodyAbs, hypsMVars, splitInfo := sinfo, outerLCtxSize, altLayouts + Pred := info.Pred, instCL, stateTys } -- `bodyMV` keeps the original scope so its own head is not treated as a JP. let restScope := scope.registerJP fvId jpDefInfo return some (.goals [(restScope, restGoal), (scope, bodyMV.mvarId!)]) @@ -400,35 +402,48 @@ private def stopOrErrorOnMissingSpec (prog monad : Expr) (thms : Array SpecTheor /-- At a JP jump site `__do_jp args`, build this jump's payload for the applicable alt's precondition mvar `?Hᵢ`: an existential closure of the join-argument equalities over the jump -site's local context, abstracted over the mvar's binders. Returns `(altIdx, payload, witnesses)` -where `witnesses` are the actual locals for the payload's `∃` binders; `finalizeJPs` assigns -`?Hᵢ` the disjunction of its jumps' payloads and discharges each jump goal by construction. -/ +site's local context, abstracted over the mvar's binders. Returns `(altIdx, payload, witnesses, +redExpr, redProof)`, where `witnesses` are the actual locals for the payload's `∃` binders and +`redExpr`/`redProof` reduce the precondition match `⌜match discrs => ?Hᵢ⌝` to the applicable alt. +`finalizeJPs` assigns `?Hᵢ` the disjunction of its jumps' payloads and discharges each jump by +construction. + +The applicable alt and its reduction are found by rewriting the precondition match, discharging the +branch condition / matcher congruence hypotheses by an assumption search bounded to the locals +introduced since the join point was registered (context index `≥ outerLCtxSize`). Because the +`__do_jp` let is always outer to the split whose branches jump to it, that slice holds exactly the +enclosing split's hypotheses, so the search is bounded by the local nesting rather than the whole +context. -/ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e : Expr) : - VCGenM (Option (Nat × Expr × Array Expr)) := do + VCGenM (Option (Nat × Expr × Array Expr × Expr × Expr)) := do let info := jpInfo.splitInfo let joinArgs := e.getAppArgs - -- The applicable alt is the one whose discriminant `rwIfOrMatcher` succeeds on here. - let mut altIdx? : Option Nat := none - for idx in [:info.altInfos.size] do - let resOpt ← liftMetaM <| try - some <$> Lean.Elab.Tactic.Do.rwIfOrMatcher idx info.expr - catch _ => pure none - let some res := resOpt | continue - if res.proof?.isNone then continue - altIdx? := some idx - break - let some altIdx := altIdx? | return none - unless altIdx < jpInfo.hypsMVars.size do return none - let hypsMVar := jpInfo.hypsMVars[altIdx]! - trace[Elab.Tactic.Do.vcgen] "JP jump: alt {altIdx} args={joinArgs}" - let layout := jpInfo.altLayouts[altIdx]! liftMetaM do - let mvarTy ← hypsMVar.getType let lctx ← getLCtx let newLocalDecls := lctx.decls.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push |>.filterMap id |>.filter (fun decl => !decl.isImplementationDetail) - Meta.forallTelescopeReducing mvarTy fun allBinders _ => do + let matchExpr := (jpInfo.pjpBodyAbs.beta joinArgs).getAppArgs[2]! + -- The branch hypotheses a jump needs are the enclosing split's telescope, whose length is at most + -- `max bodyTeleLen`; the split introduces it right after the join point was registered. So confining + -- the assumption search to `[outerLCtxSize, outerLCtxSize + maxTele)` covers every alt's full + -- discriminant evidence in a fixed window, independent of how deep the jump sits in the alt body. + let maxTele := jpInfo.altLayouts.foldl (fun acc l => max acc l.bodyTeleLen) 0 + let upperBound := jpInfo.outerLCtxSize + maxTele + let mut found : Option (Nat × Expr × Expr) := none + for idx in [:info.altInfos.size] do + let red? ← observing? <| Lean.Elab.Tactic.Do.rwIfOrMatcher idx matchExpr + (assumptionLowerBound := jpInfo.outerLCtxSize) (assumptionUpperBound := upperBound) + let some red := red? | continue + let some redProof := red.proof? | continue + found := some (idx, red.expr, redProof) + break + let some (altIdx, redExpr, redProof) := found | return none + unless altIdx < jpInfo.hypsMVars.size do return none + let hypsMVar := jpInfo.hypsMVars[altIdx]! + trace[Elab.Tactic.Do.vcgen] "JP jump: alt {altIdx} args={joinArgs}" + let layout := jpInfo.altLayouts[altIdx]! + Meta.forallTelescopeReducing (← hypsMVar.getType) fun allBinders _ => do let numJP := joinArgs.size unless numJP ≤ allBinders.size do return none let jpBinders := allBinders.extract 0 numJP @@ -477,7 +492,7 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e : Expr) : let φPropClosed := φPropClosed.replaceFVars matchedLocals matchedBinders -- The `∃` binders are exactly the non-let rest locals, in order; hand them back as witnesses. return some (altIdx, ← Meta.mkLambdaFVars allBinders φPropClosed, - (restDecls.filter (·.value?.isNone)).map LocalDecl.toExpr) + (restDecls.filter (·.value?.isNone)).map LocalDecl.toExpr, redExpr, redProof) /-- Prove `∃ locals, ⋀ joinArgs = joinArgs` by supplying each `∃` binder from `witnesses` (the actual locals) and closing the residual equalities by `rfl`. -/ @@ -499,39 +514,6 @@ private partial def fillJPExists (g : MVarId) (witnesses : List Expr) : MetaM Un | Eq _ lhs _ => g.assign (← Meta.mkEqRefl lhs) | _ => throwError "JP witness: unexpected residual{indentExpr ty}" -/-- Close a JP jump's post-monotonicity premise `∀ xs, lhs ⊑ rhs` by reflexivity. Both sides are the -shared continuation the synthetic spec carries as its postcondition, defeq up to the join-point `let`s -and eta, so `rel_refl lhs` is assigned and the kernel discharges the defeq. Left to the worklist, the -target simp would re-verify that continuation at every jump. -/ -private def tryCloseTrivialRefl (g : MVarId) : VCGenM Bool := - g.withContext do - forallTelescope (← g.getType) fun xs body => do - let_expr PartialOrder.rel α inst lhs _rhs := body | return false - let prf ← mkAppOptM ``Lean.Order.PartialOrder.rel_refl #[α, inst, lhs] - g.assign (← mkLambdaFVars xs prf) - return true - -/-- Record a JP jump's precondition VC `pre ⊑ ⌜match discrs => ?Hᵢ⌝` for `finalizeJPs`, verifying -that the match reduces to the applicable alt with the jump's discriminant evidence. Returns `true` -when `g` was recorded (and thus withheld from the worklist); other subgoals are left. -/ -private def tryDeferJPPrecond (g hypsMVar : MVarId) (altIdx : Nat) (payload : Expr) - (witnesses : Array Expr) : VCGenM Bool := - g.withContext do - let_expr PartialOrder.rel _l _inst _pre rhs := ← g.getType | return false - -- `rhs` is `⌜match discrs => ?Hᵢ⌝`, on a stateful assertion applied to the introduced state args. - let rhsArgs := rhs.getAppArgs - unless rhs.getAppFn.isConstOf ``CompleteLattice.ofProp && rhsArgs.size ≥ 3 do return false - let matchExpr := rhsArgs[2]! - let some red ← liftMetaM <| (try - some <$> Lean.Elab.Tactic.Do.rwIfOrMatcher altIdx matchExpr - catch _ => pure none) - | return false - let some redProof := red.proof? | return false - let record : JPJumpRecord := - { hypsMVar, goal := g, payload, witnesses, redExpr := red.expr, redProof } - modify fun s => { s with jpJumps := s.jpJumps.push record } - return true - /-- Prove disjunct `idx` of the `count`-fold right-nested disjunction `φ`, witnessing the selected disjunct via `fillJPExists`. -/ private partial def proveJPDisjunct (φ : Expr) (idx count : Nat) (witnesses : List Expr) : @@ -546,24 +528,18 @@ private partial def proveJPDisjunct (φ : Expr) (idx count : Nat) (witnesses : L | idx + 1 => return mkApp3 (mkConst ``Or.inr) a b (← proveJPDisjunct b idx (count - 1) witnesses) /-- Discharge a recorded JP jump: prove its own disjunct (number `idx` of `count`) of the assigned -`?Hᵢ`, then close the jump goal `pre ⊑ ⌜match discrs => ?Hᵢ⌝` with it. The state args a stateful -assertion is applied to are stripped with `ofProp_apply` (`⌜φ⌝ s = ⌜φ⌝`) and the proof transported -back to the original goal. -/ -private def dischargeJPJump (sctx : Meta.Simp.Context) (r : JPJumpRecord) (idx count : Nat) : - VCGenM Unit := - r.goal.withContext do liftMetaM do - let_expr PartialOrder.rel _l _inst pre rhs := ← r.goal.getType - | throwError "JP finalization: unexpected jump goal{indentExpr (← r.goal.getType)}" - let φPrf ← proveJPDisjunct (← instantiateMVars r.redExpr) idx count r.witnesses.toList - let hMatch ← Meta.mkEqMP (← Meta.mkEqSymm r.redProof) φPrf - let leProof ← Meta.mkAppM ``Lean.Order.le_ofProp #[pre, ← Meta.inferType hMatch, hMatch] - let (res, _) ← Meta.simp rhs sctx - match res.proof? with - | some rhsEq => - let motive ← Meta.withLocalDeclD `x (← Meta.inferType rhs) fun x => do - Meta.mkLambdaFVars #[x] (← Meta.mkAppM ``PartialOrder.rel #[pre, x]) - r.goal.assign (← Meta.mkEqMPR (← Meta.mkCongrArg motive rhsEq) leProof) - | none => r.goal.assign leProof +`?Hᵢ`, then close the jump goal `pre ⊑ ⌜match discrs => ?Hᵢ⌝ ss` with it, built by construction. +The disjunct proof `φPrf : redExpr` is transported across the match reduction (`Eq.mpr redProof`) to +`hMatch : matchExpr`, then `le_ofProp` at the postcondition lattice with the constant precondition +`fun _ => pre` yields `(fun _ => pre) ⊑ ⌜matchExpr⌝`; applying the state args reduces the sides to +`pre` and the goal's `rhs` by `β`-reduction, which the kernel discharges. -/ +private def dischargeJPJump (r : JPJumpRecord) (idx count : Nat) : VCGenM Unit := + r.goal.withContext do + let φPrf ← liftMetaM <| proveJPDisjunct (← instantiateMVars r.redExpr) idx count r.witnesses.toList + let hMatch := mkApp4 (mkConst ``Eq.mpr [.zero]) r.matchExpr r.redExpr r.redProof φPrf + let base := mkAppN (mkConst ``Lean.Order.le_ofProp [r.predLevel]) + #[r.Pred, r.instCL, r.constFn, r.matchExpr, hMatch] + r.goal.assign (← mkAppNS base r.ss) /-- Assign every `+jp` alt-precondition mvar `?Hᵢ` the disjunction of the payloads its recorded jumps provided (`False` when no jump reaches the alt, e.g. behind an early `return` or a `throw`), @@ -571,8 +547,6 @@ then discharge each recorded jump goal with its own disjunct. -/ public def finalizeJPs : VCGenM Unit := do let s ← get if s.jpHypsMVars.isEmpty then return - let sthms ← ({} : Meta.SimpTheorems).addConst ``Lean.Order.CompleteLattice.ofProp_apply - let sctx ← Meta.Simp.mkContext (simpTheorems := #[sthms]) let grouped : Std.HashMap MVarId (Array JPJumpRecord) := s.jpJumps.foldl (init := {}) fun m r => m.alter r.hypsMVar (fun rs? => some ((rs?.getD #[]).push r)) @@ -586,7 +560,7 @@ public def finalizeJPs : VCGenM Unit := do | some last => props.pop.foldr (init := last) mkOr mv.assign (← Meta.mkLambdaFVars bs φ) for h : i in [:records.size] do - dischargeJPJump sctx records[i] i records.size + dischargeJPJump records[i] i records.size /-- Close a JP jump `fv joinArgs` directly against the join point's body proof, bypassing the spec and backward-rule machinery. Join points are tail-called, so the use-site post equals the body's post @@ -597,7 +571,8 @@ in the size of the continuation. -/ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM (Option SolveResult) := do let some fvId := info.prog.getAppFn.fvarId? | return none let some jpInfo := scope.knownJP? fvId | return none - let some (altIdx, payload, witnesses) ← mkJPJumpPayload? jpInfo info.prog | return none + let some (altIdx, payload, witnesses, redExpr, redProof) ← mkJPJumpPayload? jpInfo info.prog + | return none goal.withContext do let goalTy ← goal.getType let_expr Lean.Order.PartialOrder.rel α inst pre zGoal := goalTy | return none @@ -608,17 +583,26 @@ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM ( -- before applying the excess state args, which the function-lattice `⊑` accepts pointwise. let jpRel := Expr.proj ``Std.Internal.Do.Triple 0 (← mkAppNS jpInfo.jpProof joinArgs) let jpAppliedSS ← mkAppNS jpRel ss - -- `pjpBodyAbs` is a lambda over the join params; beta-reduce so the head is `⌜·⌝` (`ofProp`), which - -- `tryDeferJPPrecond` matches. The precondition carries no post `Q`, so this stays cheap. - let yBase ← mkAppNS (jpInfo.pjpBodyAbs.beta joinArgs) ss + -- `pjpBodyAbs` is a lambda over the join params; beta-reduce so the head is `⌜·⌝` (`ofProp`). + -- The precondition carries no post `Q`, so this stays cheap. + let ofPropMatch := jpInfo.pjpBodyAbs.beta joinArgs + let yBase ← mkAppNS ofPropMatch ss let hPreTy ← mkAppNS (mkConst ``Lean.Order.PartialOrder.rel lvls) #[α, inst, pre, yBase] let hPre ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar hPreTy (← goal.getTag) let proof ← mkAppNS (mkConst ``Lean.Order.PartialOrder.rel_trans lvls) #[α, inst, pre, yBase, zGoal, hPre, jpAppliedSS] goal.assign proof - let hypsMVar := jpInfo.hypsMVars[altIdx]! - unless ← tryDeferJPPrecond hPre.mvarId! hypsMVar altIdx payload witnesses do - throwError "vcgen +jp: jump{indentExpr info.prog}\nyielded no precondition subgoal to defer" + -- Record the jump's precondition subgoal for `finalizeJPs`, storing the constant precondition + -- `fun _ => pre` for the by-construction close. + let matchExpr := ofPropMatch.getAppArgs[2]! + let constFn := jpInfo.stateTys.foldr (fun ty body => Expr.lam `s ty body .default) pre + -- `ofProp` and `le_ofProp` share the auto-bound `l : Type u`, so the const's level instantiates both. + let predLevel := ofPropMatch.getAppFn.constLevels!.head! + let record : JPJumpRecord := + { hypsMVar := jpInfo.hypsMVars[altIdx]!, goal := hPre.mvarId!, payload, witnesses, + redExpr, redProof, matchExpr, constFn, + Pred := jpInfo.Pred, predLevel, instCL := jpInfo.instCL, ss } + modify fun s => { s with jpJumps := s.jpJumps.push record } return some (.goalsInScope scope []) /-- Select the highest-priority `@[spec]` theorem matching `prog`, or a stop result when none matches. @@ -646,17 +630,8 @@ a stop result when no rule matches the goal's monad. Reached from `applyFrameOrS private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm : SpecTheorem) : VCGenM SolveResult := do trace[Elab.Tactic.Do.vcgen] "Applying spec {thm.proof} for {info.prog}. Excess args: {info.excessArgs}" - -- At a JP jump site, build its alt-precondition payload, then build the rule at a fresh mvar depth - -- so the synthetic body/precondition mvars survive `abstractMVars` as constants (shared across jump - -- sites). - let jpInfo? := info.prog.getAppFn.fvarId?.bind scope.knownJP? - let jpJump? ← match jpInfo? with - | some jpInfo => mkJPJumpPayload? jpInfo info.prog - | none => pure none let some rule ← - try - let build := (mkBackwardRuleFromSpecCached thm info).run - if jpInfo?.isSome then Meta.withNewMCtxDepth (allowLevelAssignments := false) build else build + try (mkBackwardRuleFromSpecCached thm info).run catch ex => throwError "Failed to construct rule {thm.proof} for {indentExpr info.prog}\n\ error: {ex.toMessageData}\n\ @@ -677,20 +652,6 @@ private def applySpec (scope : VCGen.Scope) (goal : MVarId) (info : WPApp) (thm Pred:{indentExpr info.Pred}\n\ excessArgs: {info.excessArgs}\n\ rule type:{indentExpr ruleType}" - if let some (altIdx, payload, witnesses) := jpJump? then - let hypsMVar := (jpInfo?.get!).hypsMVars[altIdx]! - let mut remaining := #[] - let mut deferred := false - for g in goals do - if ← tryDeferJPPrecond g hypsMVar altIdx payload witnesses then - deferred := true - else if ← tryCloseTrivialRefl g then - pure () - else - remaining := remaining.push g - unless deferred do - throwError "vcgen +jp: jump {indentExpr info.prog}\nyielded no precondition subgoal to defer" - return .goalsInScope scope remaining.toList return .goalsInScope scope goals /-- True iff the program matches the `until` pattern, in which case VC generation stops at this @@ -806,9 +767,7 @@ private def applyFrameOrSpec (scope : VCGen.Scope) (goal : MVarId) (pre : Expr) let thm ← match spec with | .ok thm => pure thm | .error res => return res - -- A JP jump site applies its synthetic spec directly, bypassing framing. - let isJP := (info.prog.getAppFn.fvarId?.bind scope.knownJP?).isSome - if thm.conjunctivePre || isFramedPost info.post || isJP then + if thm.conjunctivePre || isFramedPost info.post then return ← applySpec scope goal info thm let procs := (← read).frameProcs.byProg let fp := info.M.getAppFn.constName?.bind (procs[·]?) |>.getD meetFrameProc From 1dc9d5ceb304ab11cb45193f90eeccc5e99c1f67 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 12:59:42 +0000 Subject: [PATCH 22/35] test: add matcher-shaped vcgen +jp benchmark Add `MatchesJP`, the matcher analogue of `IfsJP`, whose `step` chains `match`es with shared continuations to exercise `vcgen +jp` on matcher-shaped join points. The renamed `vcgen_jp` driver runs both cases, and `MatchesJP` is registered in the shared test suite. --- tests/bench/vcgen/cases/Cases.lean | 1 + tests/bench/vcgen/cases/Cases/MatchesJP.lean | 41 ++++++++++++++++++++ tests/bench/vcgen/lakefile.lean | 2 +- tests/bench/vcgen/test_vcgen.lean | 3 ++ tests/bench/vcgen/vcgen_jp.lean | 14 ++++--- 5 files changed, 54 insertions(+), 7 deletions(-) create mode 100644 tests/bench/vcgen/cases/Cases/MatchesJP.lean diff --git a/tests/bench/vcgen/cases/Cases.lean b/tests/bench/vcgen/cases/Cases.lean index 50d6b2286374..3dd39ec1446c 100644 --- a/tests/bench/vcgen/cases/Cases.lean +++ b/tests/bench/vcgen/cases/Cases.lean @@ -5,6 +5,7 @@ import Cases.DiteSplit import Cases.GetThrowSet import Cases.IfsJP import Cases.LetBinding +import Cases.MatchesJP import Cases.MatchIota import Cases.MatchSplit import Cases.PurePrecond diff --git a/tests/bench/vcgen/cases/Cases/MatchesJP.lean b/tests/bench/vcgen/cases/Cases/MatchesJP.lean new file mode 100644 index 000000000000..ff8263690747 --- /dev/null +++ b/tests/bench/vcgen/cases/Cases/MatchesJP.lean @@ -0,0 +1,41 @@ +import Lean +import Std.Tactic.Do + +/-! +Several `match`es with a shared continuation, the matcher analogue of `IfsJP`. Each `match` makes the +do-elaborator emit a `__do_jp` for its trailing code, so `vcgen +jp` proves each continuation once +instead of zeta-unfolding it into every alternative. Exercises `+jp` on matcher-shaped join points +(genuine `rwMatcher` discharge), where `IfsJP` exercises only `ite`. +-/ + +open Lean Meta Order Std.Internal.Do + +namespace MatchesJP + +set_option mvcgen.warning false + +def step (v : Nat) : StateM Nat Unit := do + let s ← get + let mut x := s + match x with + | 0 => x := x + v + | 1 => x := x + (v + 1) + | _ => x := x + (v + 2) + match x with + | 0 => x := x + v + | 1 => x := x + (v + 1) + | _ => x := x + (v + 2) + match x with + | 0 => x := x + v + | 1 => x := x + (v + 1) + | _ => x := x + (v + 2) + set x + +def loop (n : Nat) : StateM Nat Unit := do + match n with + | 0 => pure () + | n+1 => step n; loop n + +def Goal (n : Nat) : Prop := ⦃fun _ => True⦄ loop n ⦃fun _ s => 0 < s⦄ + +end MatchesJP diff --git a/tests/bench/vcgen/lakefile.lean b/tests/bench/vcgen/lakefile.lean index 63b8f7846ace..21f4ae2f5fec 100644 --- a/tests/bench/vcgen/lakefile.lean +++ b/tests/bench/vcgen/lakefile.lean @@ -17,7 +17,7 @@ lean_lib Cases where lean_lib VCGenBench where roots := #[`vcgen_add_sub_cancel, `vcgen_add_sub_cancel_deep, `vcgen_add_sub_cancel_simp, `vcgen_get_throw_set, `vcgen_get_throw_set_grind, `vcgen_pure_precond, - `vcgen_reader_state, `vcgen_match_split, `vcgen_ifs_jp] + `vcgen_reader_state, `vcgen_match_split, `vcgen_jp] moreLeanArgs := #["--tstack=102400"] -- 100 MB in KB @[default_target] diff --git a/tests/bench/vcgen/test_vcgen.lean b/tests/bench/vcgen/test_vcgen.lean index 745a4d2d44d9..3eeaf3d720f5 100644 --- a/tests/bench/vcgen/test_vcgen.lean +++ b/tests/bench/vcgen/test_vcgen.lean @@ -24,6 +24,7 @@ Each case exercises a different aspect of the VC generation: - `MatchIota`: Pattern matching with concrete discriminants (iota-reduced, no split) - `MatchSplit`: Pattern matching with symbolic discriminant (state), exercising match split - `IfsJP`: several `if`s with a shared continuation, exercising `vcgen +jp` +- `MatchesJP`: several `match`es with a shared continuation, exercising `vcgen +jp` on matchers -/ open Lean Order Parser Meta Elab Tactic Sym Std Internal.Do @@ -62,6 +63,8 @@ set_option maxHeartbeats 10000000 -- grows exponentially in the number of `if`s in `step`. runBenchUsingTactic ``IfsJP.Goal [``IfsJP.loop, ``IfsJP.step] `(tactic| vcgen +jp) `(tactic| grind) [3] + runBenchUsingTactic ``MatchesJP.Goal [``MatchesJP.loop, ``MatchesJP.step] + `(tactic| vcgen +jp) `(tactic| sorry) [3] -- Verify `simplifying_assumptions [Nat.add_assoc]` works end-to-end with `simp only` unfolding. /-- diff --git a/tests/bench/vcgen/vcgen_jp.lean b/tests/bench/vcgen/vcgen_jp.lean index e8e20196f492..883c5df4670d 100644 --- a/tests/bench/vcgen/vcgen_jp.lean +++ b/tests/bench/vcgen/vcgen_jp.lean @@ -4,20 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Sebastian Graf -/ import Cases.IfsJP +import Cases.MatchesJP import Driver -/-! Benchmark driver for the `IfsJP` case: `vcgen +jp` on a loop whose body chains `if`s with a -shared continuation. -/ +/-! Benchmark driver for `vcgen +jp`: loops whose bodies chain `if`s (`IfsJP`) or `match`es +(`MatchesJP`) with shared continuations. `+jp` proves each trailing continuation once; without it +every alternative zeta-unfolds the `__do_jp` body and the VC count grows exponentially. -/ set_option mvcgen.warning false open Lean Order Parser Meta Elab Tactic Sym Std Internal.Do -open IfsJP set_option maxRecDepth 10000 set_option maxHeartbeats 10000000 --- `+jp` shares each trailing continuation across the splitter alts; without it every alt --- zeta-unfolds the `__do_jp` body and the VC count grows exponentially in the number of `if`s. -#eval runBenchUsingTactic ``Goal [``loop, ``step] `(tactic| vcgen +jp) `(tactic| sorry) +#eval runBenchUsingTactic ``IfsJP.Goal [``IfsJP.loop, ``IfsJP.step] `(tactic| vcgen +jp) `(tactic| sorry) + [30] + +#eval runBenchUsingTactic ``MatchesJP.Goal [``MatchesJP.loop, ``MatchesJP.step] `(tactic| vcgen +jp) `(tactic| sorry) [30] From 825ea8f034bd2195ce3702c30b3bd778d2366b7b Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 13:06:07 +0000 Subject: [PATCH 23/35] refactor: dedupe the local-decl search predicate and jump match expression Factor the implementation-detail/`isDefEq` check in `findLocalDeclWithType?` so the whole-context and windowed branches share one predicate, and compute a `+jp` jump's precondition match once in `tryJPJump?`, passing it to `mkJPJumpPayload?` rather than recomputing it there. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 15 ++++++------ src/Lean/Meta/Tactic/Assumption.lean | 24 +++++++------------ 2 files changed, 16 insertions(+), 23 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 34a5cd673d23..a6523a0e6020 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -414,7 +414,7 @@ introduced since the join point was registered (context index `≥ outerLCtxSize `__do_jp` let is always outer to the split whose branches jump to it, that slice holds exactly the enclosing split's hypotheses, so the search is bounded by the local nesting rather than the whole context. -/ -private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e : Expr) : +private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : VCGenM (Option (Nat × Expr × Array Expr × Expr × Expr)) := do let info := jpInfo.splitInfo let joinArgs := e.getAppArgs @@ -423,7 +423,6 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e : Expr) : let newLocalDecls := lctx.decls.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push |>.filterMap id |>.filter (fun decl => !decl.isImplementationDetail) - let matchExpr := (jpInfo.pjpBodyAbs.beta joinArgs).getAppArgs[2]! -- The branch hypotheses a jump needs are the enclosing split's telescope, whose length is at most -- `max bodyTeleLen`; the split introduces it right after the join point was registered. So confining -- the assumption search to `[outerLCtxSize, outerLCtxSize + maxTele)` covers every alt's full @@ -571,21 +570,22 @@ in the size of the continuation. -/ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM (Option SolveResult) := do let some fvId := info.prog.getAppFn.fvarId? | return none let some jpInfo := scope.knownJP? fvId | return none - let some (altIdx, payload, witnesses, redExpr, redProof) ← mkJPJumpPayload? jpInfo info.prog + let joinArgs := info.prog.getAppArgs + -- `pjpBodyAbs` is a lambda over the join params; beta-reduce so the head is `⌜·⌝` (`ofProp`). + -- The precondition carries no post `Q`, so this stays cheap. + let ofPropMatch := jpInfo.pjpBodyAbs.beta joinArgs + let matchExpr := ofPropMatch.getAppArgs[2]! + let some (altIdx, payload, witnesses, redExpr, redProof) ← mkJPJumpPayload? jpInfo info.prog matchExpr | return none goal.withContext do let goalTy ← goal.getType let_expr Lean.Order.PartialOrder.rel α inst pre zGoal := goalTy | return none let lvls := goalTy.getAppFn.constLevels! let ss := info.excessArgs - let joinArgs := info.prog.getAppArgs -- `jpProof joinArgs : Triple …` is a one-field structure; project its `⊑ wp` field (`Triple.le_wp`) -- before applying the excess state args, which the function-lattice `⊑` accepts pointwise. let jpRel := Expr.proj ``Std.Internal.Do.Triple 0 (← mkAppNS jpInfo.jpProof joinArgs) let jpAppliedSS ← mkAppNS jpRel ss - -- `pjpBodyAbs` is a lambda over the join params; beta-reduce so the head is `⌜·⌝` (`ofProp`). - -- The precondition carries no post `Q`, so this stays cheap. - let ofPropMatch := jpInfo.pjpBodyAbs.beta joinArgs let yBase ← mkAppNS ofPropMatch ss let hPreTy ← mkAppNS (mkConst ``Lean.Order.PartialOrder.rel lvls) #[α, inst, pre, yBase] let hPre ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar hPreTy (← goal.getTag) @@ -594,7 +594,6 @@ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM ( goal.assign proof -- Record the jump's precondition subgoal for `finalizeJPs`, storing the constant precondition -- `fun _ => pre` for the by-construction close. - let matchExpr := ofPropMatch.getAppArgs[2]! let constFn := jpInfo.stateTys.foldr (fun ty body => Expr.lam `s ty body .default) pre -- `ofProp` and `le_ofProp` share the auto-bound `l : Type u`, so the const's level instantiates both. let predLevel := ofPropMatch.getAppFn.constLevels!.head! diff --git a/src/Lean/Meta/Tactic/Assumption.lean b/src/Lean/Meta/Tactic/Assumption.lean index 2eea11f3ca5b..9be6c8a5c309 100644 --- a/src/Lean/Meta/Tactic/Assumption.lean +++ b/src/Lean/Meta/Tactic/Assumption.lean @@ -18,27 +18,21 @@ first. With `lowerBound > 0` and/or `upperBound > 0`, only declarations at conte the scan is confined to a window of the local context rather than the whole of it. -/ def findLocalDeclWithType? (type : Expr) (lowerBound : Nat := 0) (upperBound : Nat := 0) : MetaM (Option FVarId) := do + let check (localDecl : LocalDecl) : MetaM (Option FVarId) := do + if localDecl.isImplementationDetail then + return none + else if (← isDefEq type localDecl.type) then + return some localDecl.fvarId + else + return none let lctx ← getLCtx if lowerBound == 0 && upperBound == 0 then - lctx.findDeclRevM? fun localDecl => do - if localDecl.isImplementationDetail then - return none - else if (← isDefEq type localDecl.type) then - return some localDecl.fvarId - else - return none + lctx.findDeclRevM? check else let hi := if upperBound == 0 then lctx.decls.size else min upperBound lctx.decls.size let slice := (lctx.decls.foldl (init := (#[] : Array (Option LocalDecl))) (start := lowerBound) Array.push).take (hi - lowerBound) - slice.findSomeRevM? fun localDecl? => do - let some localDecl := localDecl? | return none - if localDecl.isImplementationDetail then - return none - else if (← isDefEq type localDecl.type) then - return some localDecl.fvarId - else - return none + slice.findSomeRevM? fun localDecl? => localDecl?.elim (pure none) check /-- Return `true` if managed to close goal `mvarId` using an assumption. -/ def _root_.Lean.MVarId.assumptionCore (mvarId : MVarId) : MetaM Bool := From 924aa71d89407a59bfe143aa2c1305ebf8702b0a Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 13:43:08 +0000 Subject: [PATCH 24/35] refactor: make the +jp jump alternative search exception-free Report a non-applicable alternative from `rwIfOrMatcher`/`rwMatcher` via `proof? := none` rather than by throwing and catching, so probing alternatives at a join-point jump no longer runs `observing?` (a full state save/restore) or an exception per miss. `rwMatcher`'s outer `try`/`catch` remains only as a safety net for genuine errors; its externally observable result is unchanged. Also carry the applicable alternative out of `mkJPJumpPayload?` as a `JPJump` structure instead of a five-tuple, hold the per-join-point `Pred`/`predLevel`/`instCL`/`stateTys` once in `JPDefInfo` (referenced from each `JPJumpRecord`) rather than copying them into every record, and compute `predLevel` at registration. --- .../Tactic/Do/Internal/VCGen/Context.lean | 14 ++--- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 59 ++++++++++--------- src/Lean/Elab/Tactic/Do/VCGen/Split.lean | 12 ++-- src/Lean/Meta/Match/Rewrite.lean | 37 ++++++++---- 4 files changed, 70 insertions(+), 52 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index 02df7050e246..655f67d93694 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -174,6 +174,8 @@ public structure JPDefInfo where altLayouts : Array JPAltLayout /-- The postcondition lattice, `wp`'s `Pred` argument. Each jump's precondition proof lives here. -/ Pred : Expr + /-- Universe level of `Pred` (the `l : Type u` of `le_ofProp`/`ofProp`), for instantiating `le_ofProp`. -/ + predLevel : Level /-- The `CompleteLattice Pred` instance, for instantiating `le_ofProp`. -/ instCL : Expr /-- State-argument types the postcondition lattice ranges over, for building each jump's @@ -199,6 +201,9 @@ payload's existentials, the reduction of the subgoal's precondition match to the and the data needed to close the subgoal `pre ⊑ ⌜match discrs => ?Hᵢ⌝ ss` by construction. Resolved by `finalizeJPs`. -/ public structure JPJumpRecord where + /-- The join point this jump targets, supplying the `Pred`/`predLevel`/`instCL`/`stateTys` shared + by all of its jumps. -/ + jpInfo : JPDefInfo hypsMVar : MVarId goal : MVarId payload : Expr @@ -207,13 +212,8 @@ public structure JPJumpRecord where redProof : Expr /-- The proposition `match discrs => ?Hᵢ` the jump's precondition embeds via `⌜·⌝`. -/ matchExpr : Expr - /-- Constant function `fun _ => pre` at the postcondition lattice, so `le_ofProp` applied to the - state args reproduces the jump's precondition `pre`. -/ - constFn : Expr - /-- The postcondition lattice `Pred`, its universe level, and its `CompleteLattice` instance. -/ - Pred : Expr - predLevel : Level - instCL : Expr + /-- The jump's precondition; `le_ofProp` at the constant function `fun _ => pre` reproduces it. -/ + pre : Expr /-- The state arguments the postcondition lattice is applied to. -/ ss : Array Expr diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index a6523a0e6020..3638db2d4581 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -300,7 +300,7 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let outerLCtx ← liftMetaM getLCtx let outerLocalInsts ← liftMetaM getLocalInstances let instCL ← liftMetaM <| Meta.synthInstance (← Meta.mkAppM ``Lean.Order.CompleteLattice #[info.Pred]) - let (bodyTy, pjpBodyAbs, hypsMVars, specSizes) ← liftMetaM <| + let (bodyTy, pjpBodyAbs, hypsMVars, specSizes, predLevel) ← liftMetaM <| Meta.forallBoundedTelescope joinTy numJoinParams fun joinParams _ => do let hypsMVarsRef ← IO.mkRef (#[] : Array MVarId) let specSizesRef ← IO.mkRef (#[] : Array Nat) @@ -316,11 +316,13 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : specSizesRef.modify (·.push altFVars.all.size) pure (mkAppN hypsMVar allBinders) let pjpBody ← Meta.mkAppOptM ``Lean.Order.CompleteLattice.ofProp #[info.Pred, instCL, propMatch] + -- `ofProp` and `le_ofProp` share the auto-bound `l : Type u`, so this const level instantiates both. + let predLevel := pjpBody.getAppFn.constLevels!.head! let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple #[info.Pred, info.EPred, info.Prog, info.Value, info.args[4]!, info.args[5]!, mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] pure (← Meta.mkForallFVars joinParams tripleTy, ← Meta.mkLambdaFVars joinParams pjpBody, - ← hypsMVarsRef.get, ← specSizesRef.get) + ← hypsMVarsRef.get, ← specSizesRef.get, predLevel) let bodySizes ← liftMetaM <| computeBodyAltLayouts sinfo info.Prog unless bodySizes.size == specSizes.size do @@ -343,7 +345,7 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let stateTys ← liftMetaM <| info.excessArgs.mapM Meta.inferType let jpDefInfo : JPDefInfo := { jpProof := .fvar jpProofFVar, pjpBodyAbs, hypsMVars, splitInfo := sinfo, outerLCtxSize, altLayouts - Pred := info.Pred, instCL, stateTys } + Pred := info.Pred, predLevel, instCL, stateTys } -- `bodyMV` keeps the original scope so its own head is not treated as a JP. let restScope := scope.registerJP fvId jpDefInfo return some (.goals [(restScope, restGoal), (scope, bodyMV.mvarId!)]) @@ -400,13 +402,19 @@ private def stopOrErrorOnMissingSpec (prog monad : Expr) (thms : Array SpecTheor throwError "No spec matching the monad {monad} found for program {prog}. \ Candidates were {thms.map (·.proof)}." -/-- At a JP jump site `__do_jp args`, build this jump's payload for the applicable alt's -precondition mvar `?Hᵢ`: an existential closure of the join-argument equalities over the jump -site's local context, abstracted over the mvar's binders. Returns `(altIdx, payload, witnesses, -redExpr, redProof)`, where `witnesses` are the actual locals for the payload's `∃` binders and -`redExpr`/`redProof` reduce the precondition match `⌜match discrs => ?Hᵢ⌝` to the applicable alt. -`finalizeJPs` assigns `?Hᵢ` the disjunction of its jumps' payloads and discharges each jump by -construction. +/-- The applicable alternative of a JP jump: its index, the payload proposition (an existential +closure of the join-argument equalities, abstracted over the alt-precondition mvar's binders), the +witnesses for the payload's existentials, and the reduction `redProof : matchExpr = redExpr` of the +precondition match to the alternative. -/ +private structure JPJump where + altIdx : Nat + payload : Expr + witnesses : Array Expr + redExpr : Expr + redProof : Expr + +/-- At a JP jump site `__do_jp args`, build this jump's `JPJump`. `finalizeJPs` assigns `?Hᵢ` the +disjunction of its jumps' payloads and discharges each jump by construction. The applicable alt and its reduction are found by rewriting the precondition match, discharging the branch condition / matcher congruence hypotheses by an assumption search bounded to the locals @@ -415,7 +423,7 @@ introduced since the join point was registered (context index `≥ outerLCtxSize enclosing split's hypotheses, so the search is bounded by the local nesting rather than the whole context. -/ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : - VCGenM (Option (Nat × Expr × Array Expr × Expr × Expr)) := do + VCGenM (Option JPJump) := do let info := jpInfo.splitInfo let joinArgs := e.getAppArgs liftMetaM do @@ -431,9 +439,8 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : let upperBound := jpInfo.outerLCtxSize + maxTele let mut found : Option (Nat × Expr × Expr) := none for idx in [:info.altInfos.size] do - let red? ← observing? <| Lean.Elab.Tactic.Do.rwIfOrMatcher idx matchExpr + let red ← Lean.Elab.Tactic.Do.rwIfOrMatcher idx matchExpr (assumptionLowerBound := jpInfo.outerLCtxSize) (assumptionUpperBound := upperBound) - let some red := red? | continue let some redProof := red.proof? | continue found := some (idx, red.expr, redProof) break @@ -490,8 +497,10 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : return (locals, mkApp2 (mkConst ``Exists [typeLevel]) type (Expr.lam decl.userName type φ .default)) let φPropClosed := φPropClosed.replaceFVars matchedLocals matchedBinders -- The `∃` binders are exactly the non-let rest locals, in order; hand them back as witnesses. - return some (altIdx, ← Meta.mkLambdaFVars allBinders φPropClosed, - (restDecls.filter (·.value?.isNone)).map LocalDecl.toExpr, redExpr, redProof) + return some { + altIdx, redExpr, redProof + payload := ← Meta.mkLambdaFVars allBinders φPropClosed + witnesses := (restDecls.filter (·.value?.isNone)).map LocalDecl.toExpr } /-- Prove `∃ locals, ⋀ joinArgs = joinArgs` by supplying each `∃` binder from `witnesses` (the actual locals) and closing the residual equalities by `rfl`. -/ @@ -536,8 +545,9 @@ private def dischargeJPJump (r : JPJumpRecord) (idx count : Nat) : VCGenM Unit : r.goal.withContext do let φPrf ← liftMetaM <| proveJPDisjunct (← instantiateMVars r.redExpr) idx count r.witnesses.toList let hMatch := mkApp4 (mkConst ``Eq.mpr [.zero]) r.matchExpr r.redExpr r.redProof φPrf - let base := mkAppN (mkConst ``Lean.Order.le_ofProp [r.predLevel]) - #[r.Pred, r.instCL, r.constFn, r.matchExpr, hMatch] + let constFn := r.jpInfo.stateTys.foldr (fun ty body => Expr.lam `s ty body .default) r.pre + let base := mkAppN (mkConst ``Lean.Order.le_ofProp [r.jpInfo.predLevel]) + #[r.jpInfo.Pred, r.jpInfo.instCL, constFn, r.matchExpr, hMatch] r.goal.assign (← mkAppNS base r.ss) /-- Assign every `+jp` alt-precondition mvar `?Hᵢ` the disjunction of the payloads its recorded @@ -575,8 +585,7 @@ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM ( -- The precondition carries no post `Q`, so this stays cheap. let ofPropMatch := jpInfo.pjpBodyAbs.beta joinArgs let matchExpr := ofPropMatch.getAppArgs[2]! - let some (altIdx, payload, witnesses, redExpr, redProof) ← mkJPJumpPayload? jpInfo info.prog matchExpr - | return none + let some jump ← mkJPJumpPayload? jpInfo info.prog matchExpr | return none goal.withContext do let goalTy ← goal.getType let_expr Lean.Order.PartialOrder.rel α inst pre zGoal := goalTy | return none @@ -592,15 +601,11 @@ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM ( let proof ← mkAppNS (mkConst ``Lean.Order.PartialOrder.rel_trans lvls) #[α, inst, pre, yBase, zGoal, hPre, jpAppliedSS] goal.assign proof - -- Record the jump's precondition subgoal for `finalizeJPs`, storing the constant precondition - -- `fun _ => pre` for the by-construction close. - let constFn := jpInfo.stateTys.foldr (fun ty body => Expr.lam `s ty body .default) pre - -- `ofProp` and `le_ofProp` share the auto-bound `l : Type u`, so the const's level instantiates both. - let predLevel := ofPropMatch.getAppFn.constLevels!.head! + -- Record the jump's precondition subgoal for `finalizeJPs`. let record : JPJumpRecord := - { hypsMVar := jpInfo.hypsMVars[altIdx]!, goal := hPre.mvarId!, payload, witnesses, - redExpr, redProof, matchExpr, constFn, - Pred := jpInfo.Pred, predLevel, instCL := jpInfo.instCL, ss } + { jpInfo, hypsMVar := jpInfo.hypsMVars[jump.altIdx]!, goal := hPre.mvarId!, + payload := jump.payload, witnesses := jump.witnesses, redExpr := jump.redExpr, + redProof := jump.redProof, matchExpr, pre, ss } modify fun s => { s with jpJumps := s.jpJumps.push record } return some (.goalsInScope scope []) diff --git a/src/Lean/Elab/Tactic/Do/VCGen/Split.lean b/src/Lean/Elab/Tactic/Do/VCGen/Split.lean index e0e4ac971b7b..ae1b9cfd36c6 100644 --- a/src/Lean/Elab/Tactic/Do/VCGen/Split.lean +++ b/src/Lean/Elab/Tactic/Do/VCGen/Split.lean @@ -188,10 +188,12 @@ def getSplitInfo? (e : Expr) : MetaM (Option SplitInfo) := do else return none -/-- Rewrite the `ite`/`dite`/matcher `e` to its `idx`-th alternative. With a `[assumptionLowerBound, -assumptionUpperBound)` window, the branch condition (ite/dite) and the matcher congruence hypotheses -are discharged by an assumption search confined to that window of the local context rather than the -whole of it (an `assumptionUpperBound` of `0` means the end of the context). -/ +/-- Rewrite the `ite`/`dite`/matcher `e` to its `idx`-th alternative, returning a `Simp.Result` whose +`proof?` is `none` when the alternative does not apply here (the `ite`/`dite` branch condition or the +matcher congruence hypotheses cannot be discharged), never throwing on that account. With a +`[assumptionLowerBound, assumptionUpperBound)` window those hypotheses are discharged by an assumption +search confined to that window of the local context rather than the whole of it (an +`assumptionUpperBound` of `0` means the end of the context). -/ def rwIfOrMatcher (idx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) (assumptionUpperBound : Nat := 0) : MetaM Simp.Result := do if e.isAppOf ``ite || e.isAppOf ``dite then @@ -199,7 +201,7 @@ def rwIfOrMatcher (idx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) let c := if idx = 0 then c else mkNot c let some fv ← findLocalDeclWithType? c (lowerBound := assumptionLowerBound) (upperBound := assumptionUpperBound) - | throwError "Failed to find proof for if condition {c}" + | return { expr := e } rwIfWith (mkFVar fv) e else rwMatcher idx e assumptionLowerBound assumptionUpperBound diff --git a/src/Lean/Meta/Match/Rewrite.lean b/src/Lean/Meta/Match/Rewrite.lean index c8f59a2e008f..fb28bec7fe98 100644 --- a/src/Lean/Meta/Match/Rewrite.lean +++ b/src/Lean/Meta/Match/Rewrite.lean @@ -103,6 +103,12 @@ def rwMatcher (altIdx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) trace[Meta.Match.debug] "When trying to reduce arm {altIdx}, only {eqns.size} equations for {.ofConstName matcherDeclName}" return { expr := e } let eqnThm := eqns[altIdx]! + -- Close `h : a = b` by reflexivity without throwing when it is not reflexive. + let tryRefl (h : MVarId) : MetaM Bool := do + let some (_, a, b) := (← h.getType).eq? | return false + unless ← isDefEq a b do return false + h.refl + return true try withTraceNode `Meta.Match.debug (fun _ => pure m!"rewriting with {.ofConstName eqnThm} in{indentExpr e}") do let eqProof := mkAppN (mkConst eqnThm e.getAppFn.constLevels!) e.getAppArgs @@ -114,8 +120,10 @@ def rwMatcher (altIdx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) if let some (_, lhs, _, rhs) := eqType.heq? then pure (true, lhs, rhs) else if let some (_, lhs, rhs) := eqType.eq? then pure (false, lhs, rhs) else throwError m!"Type of `{.ofConstName eqnThm}` is not an equality" - if !(← isDefEq e lhs) then - throwError m!"Left-hand side `{lhs}` of `{.ofConstName eqnThm}` does not apply to `{e}`" + -- The alternative not applying here (`isDefEq`/discharge failure below) is a normal outcome + -- reported via `proof? := none`, not an error: callers probing alternatives must not pay for + -- exception handling on each miss. + if !(← isDefEq e lhs) then return { expr := e } /- Here we instantiate the hypotheses of the congruence equation theorem There are two sets of hypotheses to instantiate: @@ -129,17 +137,20 @@ def rwMatcher (altIdx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) for h in hyps do unless (← h.isAssigned) do let hType ← h.getType - if Simp.isEqnThmHypothesis hType then - -- Using unrestricted h.substVars here does not work well; it could - -- even introduce a dependency on the `oldIH` we want to eliminate - unless ← assumptionProc h do throwError "Failed to discharge `{h}`" - else if hType.isEq then - unless ← assumptionProc h do h.refl <|> throwError m!"Failed to resolve `{h}`" - else if hType.isHEq then - unless ← assumptionProc h do h.hrefl <|> throwError m!"Failed to resolve `{h}`" - let unassignedHyps ← hyps.filterM fun h => return !(← h.isAssigned) - unless unassignedHyps.isEmpty do - throwError m!"Not all hypotheses of `{.ofConstName eqnThm}` could be discharged: {unassignedHyps}" + let discharged ← + if Simp.isEqnThmHypothesis hType then + -- Using unrestricted h.substVars here does not work well; it could + -- even introduce a dependency on the `oldIH` we want to eliminate + assumptionProc h + else if hType.isEq then + assumptionProc h <||> tryRefl h + else if hType.isHEq then + assumptionProc h <||> (do try h.hrefl; pure true catch _ => pure false) + else + pure true + unless discharged do return { expr := e } + unless (← hyps.filterM fun h => return !(← h.isAssigned)).isEmpty do + return { expr := e } let rhs ← instantiateMVars rhs let proof ← instantiateMVars proof let proof ← if isHeq then From 605e566d951f082e5fd8108c6a08d833c38fa4e6 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 13:50:29 +0000 Subject: [PATCH 25/35] refactor: rename the +jp jump structures to ResolvedJump and DeferredJump `JPJump` (the resolved alternative `mkJPJumpPayload?` computes) and `JPJumpRecord` (the deferred obligation stored until `finalizeJPs`) were near-identical names for different roles. Rename them to `ResolvedJump` and `DeferredJump`, which name the lifecycle stage each represents. --- src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean | 4 ++-- src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index 655f67d93694..9dd1e48c591c 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -200,7 +200,7 @@ subgoal, the payload proposition (abstracted over the mvar's binders), the witne payload's existentials, the reduction of the subgoal's precondition match to the applicable alt, and the data needed to close the subgoal `pre ⊑ ⌜match discrs => ?Hᵢ⌝ ss` by construction. Resolved by `finalizeJPs`. -/ -public structure JPJumpRecord where +public structure DeferredJump where /-- The join point this jump targets, supplying the `Pred`/`predLevel`/`instCL`/`stateTys` shared by all of its jumps. -/ jpInfo : JPDefInfo @@ -281,7 +281,7 @@ public structure VCGen.State where /-- All join-point alt-precondition mvars, in registration order. Assigned by `finalizeJPs`. -/ jpHypsMVars : Array MVarId := #[] /-- Deferred join-point jumps, in jump order. Discharged by `finalizeJPs`. -/ - jpJumps : Array JPJumpRecord := #[] + jpJumps : Array DeferredJump := #[] public abbrev VCGenM := ReaderT VCGen.Context (StateRefT VCGen.State Grind.GrindM) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 3638db2d4581..de050d10aab4 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -406,14 +406,14 @@ private def stopOrErrorOnMissingSpec (prog monad : Expr) (thms : Array SpecTheor closure of the join-argument equalities, abstracted over the alt-precondition mvar's binders), the witnesses for the payload's existentials, and the reduction `redProof : matchExpr = redExpr` of the precondition match to the alternative. -/ -private structure JPJump where +private structure ResolvedJump where altIdx : Nat payload : Expr witnesses : Array Expr redExpr : Expr redProof : Expr -/-- At a JP jump site `__do_jp args`, build this jump's `JPJump`. `finalizeJPs` assigns `?Hᵢ` the +/-- At a JP jump site `__do_jp args`, build this jump's `ResolvedJump`. `finalizeJPs` assigns `?Hᵢ` the disjunction of its jumps' payloads and discharges each jump by construction. The applicable alt and its reduction are found by rewriting the precondition match, discharging the @@ -423,7 +423,7 @@ introduced since the join point was registered (context index `≥ outerLCtxSize enclosing split's hypotheses, so the search is bounded by the local nesting rather than the whole context. -/ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : - VCGenM (Option JPJump) := do + VCGenM (Option ResolvedJump) := do let info := jpInfo.splitInfo let joinArgs := e.getAppArgs liftMetaM do @@ -541,7 +541,7 @@ The disjunct proof `φPrf : redExpr` is transported across the match reduction ( `hMatch : matchExpr`, then `le_ofProp` at the postcondition lattice with the constant precondition `fun _ => pre` yields `(fun _ => pre) ⊑ ⌜matchExpr⌝`; applying the state args reduces the sides to `pre` and the goal's `rhs` by `β`-reduction, which the kernel discharges. -/ -private def dischargeJPJump (r : JPJumpRecord) (idx count : Nat) : VCGenM Unit := +private def dischargeJPJump (r : DeferredJump) (idx count : Nat) : VCGenM Unit := r.goal.withContext do let φPrf ← liftMetaM <| proveJPDisjunct (← instantiateMVars r.redExpr) idx count r.witnesses.toList let hMatch := mkApp4 (mkConst ``Eq.mpr [.zero]) r.matchExpr r.redExpr r.redProof φPrf @@ -556,7 +556,7 @@ then discharge each recorded jump goal with its own disjunct. -/ public def finalizeJPs : VCGenM Unit := do let s ← get if s.jpHypsMVars.isEmpty then return - let grouped : Std.HashMap MVarId (Array JPJumpRecord) := + let grouped : Std.HashMap MVarId (Array DeferredJump) := s.jpJumps.foldl (init := {}) fun m r => m.alter r.hypsMVar (fun rs? => some ((rs?.getD #[]).push r)) for mv in s.jpHypsMVars do @@ -602,7 +602,7 @@ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM ( #[α, inst, pre, yBase, zGoal, hPre, jpAppliedSS] goal.assign proof -- Record the jump's precondition subgoal for `finalizeJPs`. - let record : JPJumpRecord := + let record : DeferredJump := { jpInfo, hypsMVar := jpInfo.hypsMVars[jump.altIdx]!, goal := hPre.mvarId!, payload := jump.payload, witnesses := jump.witnesses, redExpr := jump.redExpr, redProof := jump.redProof, matchExpr, pre, ss } From 8819c8a2659e6a1517180a8b2cd05b36d53c316e Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 14:11:18 +0000 Subject: [PATCH 26/35] fix: guard the old-framework +jp rewrite against a non-applying alternative `rwIfOrMatcher` now reports a non-applying alternative via `proof? := none` instead of throwing. Guard the old-framework join-point jump caller (`Do/VCGen.lean`) against that, so a non-applying `ite` alternative raises a clear error rather than silently building an uncast `Eq.mpr` proof that fails later as an opaque kernel mismatch. --- src/Lean/Elab/Tactic/Do/VCGen.lean | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Lean/Elab/Tactic/Do/VCGen.lean b/src/Lean/Elab/Tactic/Do/VCGen.lean index 9f6d4959639a..41ff2a723cce 100644 --- a/src/Lean/Elab/Tactic/Do/VCGen.lean +++ b/src/Lean/Elab/Tactic/Do/VCGen.lean @@ -343,6 +343,9 @@ where let .forallE _ φ' .. := jumpGoal | throwError "jumpGoal {jumpGoal} is not a forall" trace[Elab.Tactic.Do.vcgen] "φ applied: {φ}, prf applied: {prf}, type: {← inferType prf}" let rwPrf ← rwIfOrMatcher info.altIdx φ' + if rwPrf.proof?.isNone then + throwError "Bug in `mvcgen`: `rwIfOrMatcher` failed to rewrite alternative {info.altIdx} of\ + {indentExpr φ'}" trace[Elab.Tactic.Do.vcgen] "joinPrf: {← inferType info.joinPrf}" let jumpPrf := mkAppN info.joinPrf (joinArgs.push (← rwPrf.mkEqMPR prf)) let prf₁ := mkApp2 (mkConst ``SPred.true_intro [uWP]) σs goal.hyps From 40cc923c4cb5cf6752f70abf89778016e955de6d Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 14:11:18 +0000 Subject: [PATCH 27/35] refactor: simplify +jp jump data flow and refresh stale comments MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Drop `JPDefInfo.stateTys` (captured at the join-point definition site) and instead infer the constant precondition function's arity from the jump's own state arguments in `dischargeJPJump`, removing a registration-vs-jump coupling that could mismatch. Raise dedicated errors when a jump's `⌜·⌝` precondition or its applicable alternative cannot be resolved, rather than letting the jump fall through to a misleading "no spec found" from the frame/spec path. Extract the precondition match with `let_expr` instead of positional `getAppArgs`, and unify `rwMatcher`'s `Eq`/`HEq` reflexivity discharge into one non-throwing helper. Document the invariant that the enclosing split's alt telescope sits at the front of the post-registration local slice, and rewrite the comments that still described the removed synthetic-`Triple`-spec/`applySpec` design as the direct `rel_trans`/`__do_jpProof` flow. --- .../Tactic/Do/Internal/VCGen/Context.lean | 9 ++-- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 41 +++++++++++-------- src/Lean/Meta/Match/Rewrite.lean | 23 ++++++----- 3 files changed, 40 insertions(+), 33 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index 9dd1e48c591c..2a73c6ed6d20 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -152,9 +152,9 @@ public structure JPAltLayout where public def JPAltLayout.bodyTeleLen (l : JPAltLayout) : Nat := l.bodyFields + l.bodyOverlaps + l.bodyDiscrEqs + l.bodyExtraEqs -/-- Definition-site info for a `__do_jp` synthetic spec, indexed by the JP's let-fvar. Recorded when -the JP's synthetic spec is registered and consulted at each jump site to build the jump's payload -for the alt-specific precondition mvar `hypsMVars[altIdx]`. -/ +/-- Definition-site info for a `__do_jp` join point, indexed by the JP's let-fvar. Recorded when the +JP is registered and consulted at each jump site to build the jump's payload for the alt-specific +precondition mvar `hypsMVars[altIdx]`. -/ public structure JPDefInfo where /-- The join point's body proof, `∀ joinParams, Triple ⌜match discrs => ?Hᵢ⌝ (fv joinParams) Q`, bound as a local hypothesis. Each jump is closed by `rel_trans` against `jpProof joinArgs`. -/ @@ -178,9 +178,6 @@ public structure JPDefInfo where predLevel : Level /-- The `CompleteLattice Pred` instance, for instantiating `le_ofProp`. -/ instCL : Expr - /-- State-argument types the postcondition lattice ranges over, for building each jump's - constant precondition function. -/ - stateTys : Array Expr deriving Inhabited public structure VCGen.Scope where diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index de050d10aab4..17f53f13576d 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -221,7 +221,7 @@ private def wpConsumeMData? (goal : MVarId) (info : WPApp) : VCGenM (Option MVar return some (← replaceProgDefEq goal info info.prog.consumeMData) /-- `+jp`: wrap the continuation of a `__do_jp` let in `jpGadget`, tagging the join point so the -usual let-introduction runs (`wpLet?`) and `tryJPGadget?` then sets up the shared spec. -/ +usual let-introduction runs (`wpLet?`) and `tryJPGadget?` then registers it. -/ private def tryMarkJP? (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) := do unless (← read).useJP do return none let .letE name ty val body nondep := info.prog.getAppFn | return none @@ -274,12 +274,13 @@ private def computeBodyAltLayouts (sinfo : Lean.Elab.Tactic.Do.SplitInfo) (progT pure (mkConst ``True) ref.get -/-- `+jp`: at `wp⟦jpGadget fv rest⟧` with `rest` an `if`/`match`, register a `Triple` spec for the -join point `fv` and split into two subgoals, the JP body and the (gadget-stripped) `rest`. `body` -is proved once and each jump `fv args` in `rest` closes via `applySpec`. +/-- `+jp`: at `wp⟦jpGadget fv rest⟧` with `rest` an `if`/`match`, register the join point `fv` and +split into two subgoals, the JP body (proved once, bound as the `__do_jpProof` hypothesis and closed +against by every jump) and the (gadget-stripped) `rest`. -The spec's precondition splits the same way as `rest`: in branch `i` it is a fresh metavariable -`?Hᵢ`, which the jumps in that branch fill in with the facts that hold there. -/ +The body's precondition splits the same way as `rest`: in branch `i` it is a fresh metavariable +`?Hᵢ`, which the jumps reaching that branch fill in with the facts that hold there, and `finalizeJPs` +assigns the disjunction of. -/ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM (Option SolveResult) := do let_expr Std.Internal.Do.jpGadget _α _β fv rest := info.prog | return none @@ -295,8 +296,7 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let joinTy ← liftMetaM <| Meta.inferType fv let numJoinParams ← liftMetaM <| Lean.Elab.Tactic.Do.getNumJoinParams joinTy resTy - -- Create the `?Hᵢ` mvars in the outer local context so the rule construction's `abstractMVars` - -- keeps them shared across jump sites. + -- Create the `?Hᵢ` mvars in the outer local context so they stay shared across jump sites. let outerLCtx ← liftMetaM getLCtx let outerLocalInsts ← liftMetaM getLocalInstances let instCL ← liftMetaM <| Meta.synthInstance (← Meta.mkAppM ``Lean.Order.CompleteLattice #[info.Pred]) @@ -342,10 +342,9 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let (jpProofFVar, restGoal) ← liftMetaM <| restGoal.intro1P let outerLCtxSize := (← restGoal.getDecl).lctx.numIndices - let stateTys ← liftMetaM <| info.excessArgs.mapM Meta.inferType let jpDefInfo : JPDefInfo := { jpProof := .fvar jpProofFVar, pjpBodyAbs, hypsMVars, splitInfo := sinfo, outerLCtxSize, altLayouts - Pred := info.Pred, predLevel, instCL, stateTys } + Pred := info.Pred, predLevel, instCL } -- `bodyMV` keeps the original scope so its own head is not treated as a JP. let restScope := scope.registerJP fvId jpDefInfo return some (.goals [(restScope, restGoal), (scope, bodyMV.mvarId!)]) @@ -428,13 +427,16 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : let joinArgs := e.getAppArgs liftMetaM do let lctx ← getLCtx + -- Locals introduced since the join point was registered. INVARIANT: the enclosing split's alt + -- telescope (`fields ++ overlaps ++ discrEqs ++ extraEqs`, of length `bodyTeleLen`) sits at the + -- front of this slice, with no implementation-detail decls interspersed, so its (filtered) prefix + -- pairs positionally with the recorded `JPAltLayout` and the raw-index window below reaches it. let newLocalDecls := lctx.decls.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push |>.filterMap id |>.filter (fun decl => !decl.isImplementationDetail) - -- The branch hypotheses a jump needs are the enclosing split's telescope, whose length is at most - -- `max bodyTeleLen`; the split introduces it right after the join point was registered. So confining - -- the assumption search to `[outerLCtxSize, outerLCtxSize + maxTele)` covers every alt's full - -- discriminant evidence in a fixed window, independent of how deep the jump sits in the alt body. + -- The branch hypotheses a jump needs are that telescope, whose length is at most `max bodyTeleLen`. + -- So confining the assumption search to `[outerLCtxSize, outerLCtxSize + maxTele)` covers every + -- alt's full discriminant evidence in a fixed window, independent of how deep the jump sits. let maxTele := jpInfo.altLayouts.foldl (fun acc l => max acc l.bodyTeleLen) 0 let upperBound := jpInfo.outerLCtxSize + maxTele let mut found : Option (Nat × Expr × Expr) := none @@ -544,8 +546,11 @@ The disjunct proof `φPrf : redExpr` is transported across the match reduction ( private def dischargeJPJump (r : DeferredJump) (idx count : Nat) : VCGenM Unit := r.goal.withContext do let φPrf ← liftMetaM <| proveJPDisjunct (← instantiateMVars r.redExpr) idx count r.witnesses.toList + -- `matchExpr : Prop`, so its reduction equality lives at `Prop`; `Eq.mpr` transports `φPrf` back. let hMatch := mkApp4 (mkConst ``Eq.mpr [.zero]) r.matchExpr r.redExpr r.redProof φPrf - let constFn := r.jpInfo.stateTys.foldr (fun ty body => Expr.lam `s ty body .default) r.pre + -- `fun _ => pre` at the postcondition lattice, of the state arity `ss` will apply. + let stateTys ← liftMetaM <| r.ss.mapM Meta.inferType + let constFn := stateTys.foldr (fun ty body => Expr.lam `s ty body .default) r.pre let base := mkAppN (mkConst ``Lean.Order.le_ofProp [r.jpInfo.predLevel]) #[r.jpInfo.Pred, r.jpInfo.instCL, constFn, r.matchExpr, hMatch] r.goal.assign (← mkAppNS base r.ss) @@ -584,8 +589,10 @@ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM ( -- `pjpBodyAbs` is a lambda over the join params; beta-reduce so the head is `⌜·⌝` (`ofProp`). -- The precondition carries no post `Q`, so this stays cheap. let ofPropMatch := jpInfo.pjpBodyAbs.beta joinArgs - let matchExpr := ofPropMatch.getAppArgs[2]! - let some jump ← mkJPJumpPayload? jpInfo info.prog matchExpr | return none + let_expr Lean.Order.CompleteLattice.ofProp _ _ matchExpr := ofPropMatch + | throwError "vcgen +jp: join point precondition is not a `⌜·⌝` embedding{indentExpr ofPropMatch}" + let some jump ← mkJPJumpPayload? jpInfo info.prog matchExpr + | throwError "vcgen +jp: could not resolve the alternative of jump{indentExpr info.prog}" goal.withContext do let goalTy ← goal.getType let_expr Lean.Order.PartialOrder.rel α inst pre zGoal := goalTy | return none diff --git a/src/Lean/Meta/Match/Rewrite.lean b/src/Lean/Meta/Match/Rewrite.lean index fb28bec7fe98..46066519a1ef 100644 --- a/src/Lean/Meta/Match/Rewrite.lean +++ b/src/Lean/Meta/Match/Rewrite.lean @@ -103,12 +103,17 @@ def rwMatcher (altIdx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) trace[Meta.Match.debug] "When trying to reduce arm {altIdx}, only {eqns.size} equations for {.ofConstName matcherDeclName}" return { expr := e } let eqnThm := eqns[altIdx]! - -- Close `h : a = b` by reflexivity without throwing when it is not reflexive. - let tryRefl (h : MVarId) : MetaM Bool := do - let some (_, a, b) := (← h.getType).eq? | return false - unless ← isDefEq a b do return false - h.refl - return true + -- Close an `Eq`/`HEq` hypothesis `h` by reflexivity without throwing when it is not reflexive. + let tryRefl (h : MVarId) (hType : Expr) : MetaM Bool := do + if let some (_, a, b) := hType.eq? then + unless ← isDefEq a b do return false + h.refl + return true + if let some (α, a, β, b) := hType.heq? then + unless ← (isDefEq α β <&&> isDefEq a b) do return false + h.hrefl + return true + return false try withTraceNode `Meta.Match.debug (fun _ => pure m!"rewriting with {.ofConstName eqnThm} in{indentExpr e}") do let eqProof := mkAppN (mkConst eqnThm e.getAppFn.constLevels!) e.getAppArgs @@ -142,10 +147,8 @@ def rwMatcher (altIdx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) -- Using unrestricted h.substVars here does not work well; it could -- even introduce a dependency on the `oldIH` we want to eliminate assumptionProc h - else if hType.isEq then - assumptionProc h <||> tryRefl h - else if hType.isHEq then - assumptionProc h <||> (do try h.hrefl; pure true catch _ => pure false) + else if hType.isEq || hType.isHEq then + assumptionProc h <||> tryRefl h hType else pure true unless discharged do return { expr := e } From 492cab3929150b01533a4d0a166beaf31298b2a8 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 14:30:26 +0000 Subject: [PATCH 28/35] refactor: add wp instance/epost accessors and name the +jp body-alt layout Add `instAL`/`instEAL`/`epost` accessors to `WPApp` so `tryJPGadget?` builds the join point's `Triple` type through named fields rather than raw `args` indices. Have `computeBodyAltLayouts` return `Array JPAltLayout` with named body-segment fields (`specBinders` filled by the caller) instead of an opaque four-tuple, and document that the `ite`/`dite` alt telescope is the single condition proof. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 36 +++++++++++-------- .../Elab/Tactic/Do/Internal/VCGen/WPApp.lean | 6 ++++ 2 files changed, 27 insertions(+), 15 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 17f53f13576d..cc78540ac93d 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -257,20 +257,28 @@ private def wpLet? (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) := do | throwError "Failed to intro hoisted let" return some goal -/-- Per-alt segment sizes of the alt telescope the body split (`mkBackwardRuleForSplit`, splitter -form with added equalities) introduces at each jump site, computed the same way over the abstracted -split. -/ +/-- The per-alt body-side binder segment sizes of `JPAltLayout` (`bodyFields`/`bodyOverlaps`/ +`bodyDiscrEqs`/`bodyExtraEqs`), computed the same way the actual jump-site split introduces them +(`mkBackwardRuleForSplit`, splitter form with added equalities). `specBinders` is left `0` and filled +by the caller from the spec-side split. -/ private def computeBodyAltLayouts (sinfo : Lean.Elab.Tactic.Do.SplitInfo) (progTy : Expr) : - MetaM (Array (Nat × Nat × Nat × Nat)) := do + MetaM (Array JPAltLayout) := do match sinfo with - | .ite _ | .dite _ => return #[(1, 0, 0, 0), (1, 0, 0, 0)] + | .ite _ | .dite _ => + -- The body split forces the splitter (`dite`) form, whose alt telescope is exactly the single + -- condition proof; the spec-side split leaves 0 alt binders, reconciled by the `min`-based pairing. + let one : JPAltLayout := + { bodyFields := 1, bodyOverlaps := 0, bodyDiscrEqs := 0, bodyExtraEqs := 0, specBinders := 0 } + return #[one, one] | .matcher _ => - let ref ← IO.mkRef (#[] : Array (Nat × Nat × Nat × Nat)) + let ref ← IO.mkRef (#[] : Array JPAltLayout) discard <| sinfo.withAbstract progTy fun abstractInfo _ => abstractInfo.splitWith (mkSort .zero) (useSplitter := true) fun _name _expAltType _idx altFVars => do - ref.modify (·.push (altFVars.fields.size, altFVars.overlaps.size, - altFVars.discrEqs.size, altFVars.extraEqs.size)) + ref.modify (·.push + { bodyFields := altFVars.fields.size, bodyOverlaps := altFVars.overlaps.size + bodyDiscrEqs := altFVars.discrEqs.size, bodyExtraEqs := altFVars.extraEqs.size + specBinders := 0 }) pure (mkConst ``True) ref.get @@ -319,17 +327,15 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : -- `ofProp` and `le_ofProp` share the auto-bound `l : Type u`, so this const level instantiates both. let predLevel := pjpBody.getAppFn.constLevels!.head! let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple - #[info.Pred, info.EPred, info.Prog, info.Value, info.args[4]!, info.args[5]!, - mkAppN fv joinParams, info.instWP, pjpBody, Q, info.args[9]!] + #[info.Pred, info.EPred, info.Prog, info.Value, info.instAL, info.instEAL, + mkAppN fv joinParams, info.instWP, pjpBody, Q, info.epost] pure (← Meta.mkForallFVars joinParams tripleTy, ← Meta.mkLambdaFVars joinParams pjpBody, ← hypsMVarsRef.get, ← specSizesRef.get, predLevel) - let bodySizes ← liftMetaM <| computeBodyAltLayouts sinfo info.Prog - unless bodySizes.size == specSizes.size do + let bodyLayouts ← liftMetaM <| computeBodyAltLayouts sinfo info.Prog + unless bodyLayouts.size == specSizes.size do throwError "vcgen +jp: alt count mismatch between spec and body splits of{indentExpr rest}" - let altLayouts := bodySizes.zipWith (fun (bF, bO, bD, bE) sB => - { bodyFields := bF, bodyOverlaps := bO, bodyDiscrEqs := bD, bodyExtraEqs := bE - specBinders := sB : JPAltLayout }) specSizes + let altLayouts := bodyLayouts.zipWith (fun layout sB => { layout with specBinders := sB }) specSizes -- `finalizeJPs` assigns each `?Hᵢ` the disjunction of its recorded jump payloads (`False` when -- no jump reaches the alt, e.g. behind an early `return` or a `throw`). diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/WPApp.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/WPApp.lean index 353e7f14976e..f31ef9c19c19 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/WPApp.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/WPApp.lean @@ -45,12 +45,18 @@ public def Value (info : WPApp) : Expr := info.args[1]! public def Pred (info : WPApp) : Expr := info.args[2]! /-- Exception postcondition type argument of `wp`. -/ public def EPred (info : WPApp) : Expr := info.args[3]! +/-- Assertion-lattice instance argument of `wp`. -/ +public def instAL (info : WPApp) : Expr := info.args[4]! +/-- Exception-assertion-lattice instance argument of `wp`. -/ +public def instEAL (info : WPApp) : Expr := info.args[5]! /-- `WP` instance argument of `wp`. -/ public def instWP (info : WPApp) : Expr := info.args[6]! /-- Program expression classified by VCGen. -/ public def prog (info : WPApp) : Expr := info.args[7]! /-- Postcondition argument of `wp`. -/ public def post (info : WPApp) : Expr := info.args[8]! +/-- Exception postcondition argument of `wp`. -/ +public def epost (info : WPApp) : Expr := info.args[9]! end VCGen.WPApp From e9bb1063ef43e07cd37110c5ecf5859f92228c5d Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 21 Jul 2026 14:45:01 +0000 Subject: [PATCH 29/35] refactor: filter implementation-detail locals at the +jp existential closure Keep the raw local-context slice for the alt-telescope pairing, which aligns positionally with the recorded `JPAltLayout`, and drop implementation-detail declarations only where the existential closure of the jump's kept locals is built. A compiler-internal local can then never become an existential binder or witness, and the telescope indexing no longer depends on the impl-detail filter (removing the coupling the earlier global filter created). --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index cc78540ac93d..80c745b16118 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -433,13 +433,10 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : let joinArgs := e.getAppArgs liftMetaM do let lctx ← getLCtx - -- Locals introduced since the join point was registered. INVARIANT: the enclosing split's alt - -- telescope (`fields ++ overlaps ++ discrEqs ++ extraEqs`, of length `bodyTeleLen`) sits at the - -- front of this slice, with no implementation-detail decls interspersed, so its (filtered) prefix - -- pairs positionally with the recorded `JPAltLayout` and the raw-index window below reaches it. - let newLocalDecls := lctx.decls.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push - |>.filterMap id - |>.filter (fun decl => !decl.isImplementationDetail) + -- Locals introduced since the join point was registered. The enclosing split's alt telescope + -- (`fields ++ overlaps ++ discrEqs ++ extraEqs`, of length `bodyTeleLen`) sits at the front and + -- pairs positionally with the recorded `JPAltLayout`; the locals past it are `∃`-closed below. + let slice := lctx.decls.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push |>.filterMap id -- The branch hypotheses a jump needs are that telescope, whose length is at most `max bodyTeleLen`. -- So confining the assumption search to `[outerLCtxSize, outerLCtxSize + maxTele)` covers every -- alt's full discriminant evidence in a fixed window, independent of how deep the jump sits. @@ -474,21 +471,24 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : let pairedFields := min layout.specBinders layout.bodyFields let pairedEqs := min (layout.specBinders - pairedFields) layout.bodyDiscrEqs unless altBinders.size == layout.specBinders && - layout.bodyTeleLen ≤ newLocalDecls.size && + layout.bodyTeleLen ≤ slice.size && layout.specBinders - pairedFields - pairedEqs ≤ 1 do throwError "vcgen +jp: jump-site telescope does not match the recorded alt layout for \ {indentExpr e}" let mut matchedLocals : Array Expr := #[] let mut matchedBinders : Array Expr := #[] for i in [:pairedFields] do - matchedLocals := matchedLocals.push newLocalDecls[i]!.toExpr + matchedLocals := matchedLocals.push slice[i]!.toExpr matchedBinders := matchedBinders.push altBinders[i]! for i in [:pairedEqs] do matchedLocals := matchedLocals.push - newLocalDecls[layout.bodyFields + layout.bodyOverlaps + i]!.toExpr + slice[layout.bodyFields + layout.bodyOverlaps + i]!.toExpr matchedBinders := matchedBinders.push altBinders[pairedFields + i]! let eqs ← (jpBinders.mapIdx fun i jp => (jp, i)).mapM fun (jp, i) => Meta.mkEq jp joinArgs[i]! - let restDecls := newLocalDecls.extract layout.bodyTeleLen newLocalDecls.size + -- Locals past the telescope are `∃`/`let`-closed. Implementation-detail decls (compiler + -- internal) must never become `∃` binders or witnesses, so drop them here. + let restDecls := (slice.extract layout.bodyTeleLen slice.size).filter + (fun decl => !decl.isImplementationDetail) let restLocals := restDecls.map LocalDecl.toExpr -- `∃ rest, joinParams = joinArgs`, existentially/let-closing the kept locals; the paired ones -- are then rewritten to the mvar's own alt binders. From a02b1ee8290197bf87e707f8d9f74542603fc185 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Thu, 23 Jul 2026 13:06:29 +0000 Subject: [PATCH 30/35] refactor: reuse shared helpers in the windowed assumption search Move `LocalDeclKind.ofBinderName` from `Lean.Elab.BindersUtil` to `Lean.LocalContext` beside `LocalDeclKind` so `Sym.introCore` can use it instead of restating the name rule. Rewrite the windowed branch of `findLocalDeclWithType?` as an allocation-free descending index loop, extend `MVarId.assumptionCore` with the same window so `rwMatcher` delegates to it, close reflexive congruence hypotheses by direct assignment after the definitional check, and test for undischarged hypotheses with `anyM` instead of materializing a filtered array. --- src/Lean/Elab/BindersUtil.lean | 11 ----------- src/Lean/LocalContext.lean | 11 +++++++++++ src/Lean/Meta/Match/Rewrite.lean | 13 +++++-------- src/Lean/Meta/Sym/Intro.lean | 6 ++---- src/Lean/Meta/Tactic/Assumption.lean | 21 ++++++++++++++------- 5 files changed, 32 insertions(+), 30 deletions(-) diff --git a/src/Lean/Elab/BindersUtil.lean b/src/Lean/Elab/BindersUtil.lean index e9439e4cc347..a4475e8308bd 100644 --- a/src/Lean/Elab/BindersUtil.lean +++ b/src/Lean/Elab/BindersUtil.lean @@ -13,17 +13,6 @@ import Init.Syntax public section -/-- -Determines the local declaration kind of a binder using its name. - -Names that begin with `__` are implementation details (`.implDetail`). --/ -def Lean.LocalDeclKind.ofBinderName (binderName : Name) : LocalDeclKind := - if binderName.isImplementationDetail then - .implDetail - else - .default - namespace Lean.Elab.Term /-- Recall that diff --git a/src/Lean/LocalContext.lean b/src/Lean/LocalContext.lean index d7d25d1abb83..9ecba339c0f0 100644 --- a/src/Lean/LocalContext.lean +++ b/src/Lean/LocalContext.lean @@ -47,6 +47,17 @@ inductive LocalDeclKind | auxDecl deriving Inhabited, Repr, DecidableEq, Hashable +/-- +Determines the local declaration kind of a binder using its name. + +Names that begin with `__` are implementation details (`.implDetail`). +-/ +def LocalDeclKind.ofBinderName (binderName : Name) : LocalDeclKind := + if binderName.isImplementationDetail then + .implDetail + else + .default + /-- A declaration for a `LocalContext`. This is used to register which free variables are in scope. See `LocalDecl.index`, `LocalDecl.fvarId`, `LocalDecl.userName`, `LocalDecl.type` for accessors for diff --git a/src/Lean/Meta/Match/Rewrite.lean b/src/Lean/Meta/Match/Rewrite.lean index 46066519a1ef..7dcbc43a2554 100644 --- a/src/Lean/Meta/Match/Rewrite.lean +++ b/src/Lean/Meta/Match/Rewrite.lean @@ -76,11 +76,8 @@ def rwMatcher (altIdx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) (assumptionUpperBound : Nat := 0) : MetaM Simp.Result := do -- Close `g` by an assumption at context index in `[assumptionLowerBound, assumptionUpperBound)`, so -- the search for the congruence-equation hypotheses is confined to a window of the local context. - let assumptionProc (g : MVarId) : MetaM Bool := g.withContext do - match ← findLocalDeclWithType? (← g.getType) (lowerBound := assumptionLowerBound) - (upperBound := assumptionUpperBound) with - | some fvarId => g.assign (mkFVar fvarId); return true - | none => return false + let assumptionProc (g : MVarId) : MetaM Bool := + g.assumptionCore assumptionLowerBound assumptionUpperBound if e.isAppOf ``PSum.casesOn || e.isAppOf ``PSigma.casesOn then let mut e := e while true do @@ -107,11 +104,11 @@ def rwMatcher (altIdx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) let tryRefl (h : MVarId) (hType : Expr) : MetaM Bool := do if let some (_, a, b) := hType.eq? then unless ← isDefEq a b do return false - h.refl + h.assign (← mkEqRefl a) return true if let some (α, a, β, b) := hType.heq? then unless ← (isDefEq α β <&&> isDefEq a b) do return false - h.hrefl + h.assign (← mkHEqRefl a) return true return false try @@ -152,7 +149,7 @@ def rwMatcher (altIdx : Nat) (e : Expr) (assumptionLowerBound : Nat := 0) else pure true unless discharged do return { expr := e } - unless (← hyps.filterM fun h => return !(← h.isAssigned)).isEmpty do + if ← hyps.anyM fun h => return !(← h.isAssigned) then return { expr := e } let rhs ← instantiateMVars rhs let proof ← instantiateMVars proof diff --git a/src/Lean/Meta/Sym/Intro.lean b/src/Lean/Meta/Sym/Intro.lean index ce5113d407bb..2178f16cc42d 100644 --- a/src/Lean/Meta/Sym/Intro.lean +++ b/src/Lean/Meta/Sym/Intro.lean @@ -78,8 +78,7 @@ def introCore (mvarId : MVarId) (max : Nat) (names : Array Name) (hygienic : Boo | .forallE n type body bi => let type ← instantiateRevS type fvars let fvarId ← mkFreshFVarId - let kind := if n.isImplementationDetail then .implDetail else .default - let lctx := lctx.mkLocalDecl fvarId (← mkName lctx n i) type bi kind + let lctx := lctx.mkLocalDecl fvarId (← mkName lctx n i) type bi (.ofBinderName n) let fvar ← mkFVarS fvarId let fvars := fvars.push fvar let localInsts := updateLocalInsts localInsts fvar type @@ -95,8 +94,7 @@ def introCore (mvarId : MVarId) (max : Nat) (names : Array Name) (hygienic : Boo An implementation-detail binder (name prefixed with `__`, e.g. a `__do_jp` join point) is marked so downstream consumers such as `grind` skip it and it stays hidden from the user. -/ - let kind := if n.isImplementationDetail then .implDetail else .default - let lctx := lctx.mkLetDecl fvarId (← mkName lctx n i) type value (kind := kind) + let lctx := lctx.mkLetDecl fvarId (← mkName lctx n i) type value (kind := .ofBinderName n) let fvar ← mkFVarS fvarId let fvars := fvars.push fvar let localInsts := updateLocalInsts localInsts fvar type diff --git a/src/Lean/Meta/Tactic/Assumption.lean b/src/Lean/Meta/Tactic/Assumption.lean index 9be6c8a5c309..fc72c779e09f 100644 --- a/src/Lean/Meta/Tactic/Assumption.lean +++ b/src/Lean/Meta/Tactic/Assumption.lean @@ -29,16 +29,23 @@ def findLocalDeclWithType? (type : Expr) (lowerBound : Nat := 0) (upperBound : N if lowerBound == 0 && upperBound == 0 then lctx.findDeclRevM? check else - let hi := if upperBound == 0 then lctx.decls.size else min upperBound lctx.decls.size - let slice := (lctx.decls.foldl (init := (#[] : Array (Option LocalDecl))) (start := lowerBound) - Array.push).take (hi - lowerBound) - slice.findSomeRevM? fun localDecl? => localDecl?.elim (pure none) check + let hi := if upperBound == 0 then lctx.numIndices else min upperBound lctx.numIndices + let rec go : Nat → MetaM (Option FVarId) + | 0 => return none + | i + 1 => do + if i < lowerBound then return none + if let some localDecl := lctx.getAt? i then + if let some fvarId ← check localDecl then return some fvarId + go i + go hi -/-- Return `true` if managed to close goal `mvarId` using an assumption. -/ -def _root_.Lean.MVarId.assumptionCore (mvarId : MVarId) : MetaM Bool := +/-- Return `true` if managed to close goal `mvarId` using an assumption at a context index in +`[lowerBound, upperBound)` (see `findLocalDeclWithType?`). -/ +def _root_.Lean.MVarId.assumptionCore (mvarId : MVarId) (lowerBound : Nat := 0) + (upperBound : Nat := 0) : MetaM Bool := mvarId.withContext do mvarId.checkNotAssigned `assumption - match (← findLocalDeclWithType? (← mvarId.getType)) with + match (← findLocalDeclWithType? (← mvarId.getType) lowerBound upperBound) with | none => return false | some fvarId => mvarId.assign (mkFVar fvarId); return true From 5e18fc9bf7de93589ccd17b1517fcaf9ba57aa72 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Thu, 23 Jul 2026 13:06:29 +0000 Subject: [PATCH 31/35] refactor: derive the +jp jump discharge from the goal type Recover the precondition, lattice, instance, match proposition, and state arguments of a deferred join-point jump by destructuring its subgoal's type in `finalizeJPs`, instead of copying them into every `DeferredJump`; the record shrinks to the resolved alternative, its target mvar, and the subgoal, and `JPDefInfo` loses its `Pred`/`predLevel`/`instCL`/`splitInfo` fields (the split import moves out of `Context`). Introduce the join point's body proof with `Sym.introN`, which derives the implementation-detail kind from the `__`-prefixed name, so local-spec collection can rely on the declaration kind alone. Build the jump payload's witness proof as a term rather than through throwaway metavariables, replace the positional pairing loops with slices, and thread scoped subgoals through `handleInvariantSubgoals` so the driver no longer re-pairs them by membership scan. --- .../Tactic/Do/Internal/VCGen/Context.lean | 42 ++---- .../Elab/Tactic/Do/Internal/VCGen/Driver.lean | 16 +- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 141 +++++++++--------- 3 files changed, 90 insertions(+), 109 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index 2a73c6ed6d20..34924bfbaf67 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -7,7 +7,6 @@ module prelude public import Lean.Elab.Tactic.Do.VCGen.Basic -public import Lean.Elab.Tactic.Do.VCGen.Split public import Lean.Elab.Tactic.Do.Internal.VCGen.SpecDB public import Lean.Elab.Tactic.Do.Internal.VCGen.FrameProc public import Lean.Meta.Sym.Apply @@ -165,19 +164,11 @@ public structure JPDefInfo where /-- Per-alt synthetic-opaque precondition mvars. Each has type `(joinParams ++ altParams) → Prop`, assigned by `finalizeJPs`. -/ hypsMVars : Array MVarId - /-- The join point's continuation splitter; its discriminant selects the alt at each jump site. -/ - splitInfo : Lean.Elab.Tactic.Do.SplitInfo /-- Size of the local context at the JP definition site. Locals introduced beyond this index are alt-local and get existentially closed when building the jump-site `φ`. -/ outerLCtxSize : Nat /-- Per-alt binder layouts, aligned with `hypsMVars`. -/ altLayouts : Array JPAltLayout - /-- The postcondition lattice, `wp`'s `Pred` argument. Each jump's precondition proof lives here. -/ - Pred : Expr - /-- Universe level of `Pred` (the `l : Type u` of `le_ofProp`/`ofProp`), for instantiating `le_ofProp`. -/ - predLevel : Level - /-- The `CompleteLattice Pred` instance, for instantiating `le_ofProp`. -/ - instCL : Expr deriving Inhabited public structure VCGen.Scope where @@ -192,27 +183,24 @@ public structure VCGen.Scope where nextDeclIdx : Nat := 0 deriving Inhabited -/-- A deferred join-point jump: the alt-precondition mvar it targets, its open precondition -subgoal, the payload proposition (abstracted over the mvar's binders), the witnesses for the -payload's existentials, the reduction of the subgoal's precondition match to the applicable alt, -and the data needed to close the subgoal `pre ⊑ ⌜match discrs => ?Hᵢ⌝ ss` by construction. -Resolved by `finalizeJPs`. -/ -public structure DeferredJump where - /-- The join point this jump targets, supplying the `Pred`/`predLevel`/`instCL`/`stateTys` shared - by all of its jumps. -/ - jpInfo : JPDefInfo - hypsMVar : MVarId - goal : MVarId +/-- The applicable alternative of a JP jump: its index, the payload proposition (an existential +closure of the join-argument equalities, abstracted over the alt-precondition mvar's binders), the +witnesses for the payload's existentials, and the reduction `redProof : matchExpr = redExpr` of the +precondition match to the alternative. -/ +public structure ResolvedJump where + altIdx : Nat payload : Expr witnesses : Array Expr redExpr : Expr redProof : Expr - /-- The proposition `match discrs => ?Hᵢ` the jump's precondition embeds via `⌜·⌝`. -/ - matchExpr : Expr - /-- The jump's precondition; `le_ofProp` at the constant function `fun _ => pre` reproduces it. -/ - pre : Expr - /-- The state arguments the postcondition lattice is applied to. -/ - ss : Array Expr + +/-- A deferred join-point jump: its resolved alternative, the alt-precondition mvar it targets, and +its open precondition subgoal `pre ⊑ ⌜match discrs => ?Hᵢ⌝ ss`. Resolved by `finalizeJPs`, which +recovers everything else from the subgoal's type. -/ +public structure DeferredJump where + jump : ResolvedJump + hypsMVar : MVarId + goal : MVarId public structure VCGen.State where /-- @@ -304,7 +292,7 @@ public def Scope.collectLocalSpecs (scope : Scope) (goal : MVarId) : VCGenM Scop -- Skip implementation-detail hypotheses (e.g. the `+jp` body proof `__do_jpProof`, the -- `__do_jp` continuation): they are never user specs, and building a spec pattern from one -- runs `preprocessType` over its post, scaling with the continuation. - if decl.isAuxDecl || decl.userName.isImplementationDetail then return scope + if decl.isImplementationDetail then return scope try if let some thm ← mkSpecTheoremFromLocal decl.fvarId (eval_prio low) then return scope.insertSpec thm diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean index 6ea8bdeb3b78..63d5c5d066fd 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Driver.lean @@ -62,10 +62,11 @@ each in `State.invariants` (1-based stable index) and try to inline-elaborate its matching user alt. Returns the remaining non-invariant subgoals for `work` to enqueue. Eager handling here ensures dependent VCs see `?inv` assigned by the time they reach `emitVC`. -/ -private def handleInvariantSubgoals (subgoals : List MVarId) : VCGenM (Array MVarId) := do +private def handleInvariantSubgoals (subgoals : List (Scope × MVarId)) : + VCGenM (Array (Scope × MVarId)) := do let env ← getEnv - let mut others : Array MVarId := #[] - for sg in subgoals do + let mut others : Array (Scope × MVarId) := #[] + for (scope, sg) in subgoals do if isSpecInvariantType env (← sg.getType) then let n := (← get).invariants.size + 1 modify fun s => { s with invariants := s.invariants.push sg } @@ -74,7 +75,7 @@ private def handleInvariantSubgoals (subgoals : List MVarId) : VCGenM (Array MVa else sg.setKind .syntheticOpaque else - others := others.push sg + others := others.push (scope, sg) return others /-- @@ -115,14 +116,13 @@ public def work (scope : Scope) (goal : Grind.Goal) : VCGenM Unit := do -- Handle invariant subgoals eagerly here, so that VC subgoals popped -- from the worklist later see the invariant MVar already assigned. -- Non-invariant subgoals go to the worklist as usual and will eventually go through `emitVC`. - let mvarIds ← handleInvariantSubgoals (scopedSubgoals.map Prod.snd) + let kept ← handleInvariantSubgoals scopedSubgoals let goal ← - if mvarIds.size > 1 then + if kept.size > 1 then processHypotheses goal else pure goal - let kept := scopedSubgoals.filter (fun (_, mv) => mvarIds.contains mv) - worklist := worklist ++ kept.reverse.toArray.map (fun (scope, mv) => + worklist := worklist ++ kept.reverse.map (fun (scope, mv) => { goal := { goal with mvarId := mv }, scope }) finalizeJPs diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 80c745b16118..640606d43582 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -308,7 +308,7 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let outerLCtx ← liftMetaM getLCtx let outerLocalInsts ← liftMetaM getLocalInstances let instCL ← liftMetaM <| Meta.synthInstance (← Meta.mkAppM ``Lean.Order.CompleteLattice #[info.Pred]) - let (bodyTy, pjpBodyAbs, hypsMVars, specSizes, predLevel) ← liftMetaM <| + let (bodyTy, pjpBodyAbs, hypsMVars, specSizes) ← liftMetaM <| Meta.forallBoundedTelescope joinTy numJoinParams fun joinParams _ => do let hypsMVarsRef ← IO.mkRef (#[] : Array MVarId) let specSizesRef ← IO.mkRef (#[] : Array Nat) @@ -324,13 +324,11 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : specSizesRef.modify (·.push altFVars.all.size) pure (mkAppN hypsMVar allBinders) let pjpBody ← Meta.mkAppOptM ``Lean.Order.CompleteLattice.ofProp #[info.Pred, instCL, propMatch] - -- `ofProp` and `le_ofProp` share the auto-bound `l : Type u`, so this const level instantiates both. - let predLevel := pjpBody.getAppFn.constLevels!.head! let tripleTy ← Meta.mkAppOptM ``Std.Internal.Do.Triple #[info.Pred, info.EPred, info.Prog, info.Value, info.instAL, info.instEAL, mkAppN fv joinParams, info.instWP, pjpBody, Q, info.epost] pure (← Meta.mkForallFVars joinParams tripleTy, ← Meta.mkLambdaFVars joinParams pjpBody, - ← hypsMVarsRef.get, ← specSizesRef.get, predLevel) + ← hypsMVarsRef.get, ← specSizesRef.get) let bodyLayouts ← liftMetaM <| computeBodyAltLayouts sinfo info.Prog unless bodyLayouts.size == specSizes.size do @@ -339,18 +337,21 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : -- `finalizeJPs` assigns each `?Hᵢ` the disjunction of its recorded jump payloads (`False` when -- no jump reaches the alt, e.g. behind an early `return` or a `throw`). - modify fun s => { s with jpHypsMVars := hypsMVars.foldl (·.push ·) s.jpHypsMVars } + modify fun s => { s with jpHypsMVars := s.jpHypsMVars ++ hypsMVars } let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← goal.getTag) -- Bind the body proof as a local hypothesis so each jump references it by fvar (`jpProof joinArgs`), -- keeping the shared continuation proof in one `let` binding that survives proof-term instantiation. + -- `Sym.introN` derives the declaration kind from the `__`-prefixed name, so the hypothesis is an + -- implementation detail and stays out of local-spec collection and assumption search. let restGoal ← liftMetaM <| restGoal.define `__do_jpProof bodyTy bodyMV - let (jpProofFVar, restGoal) ← liftMetaM <| restGoal.intro1P + let .goal newDecls restGoal ← Sym.introN restGoal 1 + | throwError "vcgen +jp: failed to introduce the join point body proof" + let jpProofFVar := newDecls[0]! let outerLCtxSize := (← restGoal.getDecl).lctx.numIndices let jpDefInfo : JPDefInfo := - { jpProof := .fvar jpProofFVar, pjpBodyAbs, hypsMVars, splitInfo := sinfo, outerLCtxSize, altLayouts - Pred := info.Pred, predLevel, instCL } + { jpProof := .fvar jpProofFVar, pjpBodyAbs, hypsMVars, outerLCtxSize, altLayouts } -- `bodyMV` keeps the original scope so its own head is not treated as a JP. let restScope := scope.registerJP fvId jpDefInfo return some (.goals [(restScope, restGoal), (scope, bodyMV.mvarId!)]) @@ -407,17 +408,6 @@ private def stopOrErrorOnMissingSpec (prog monad : Expr) (thms : Array SpecTheor throwError "No spec matching the monad {monad} found for program {prog}. \ Candidates were {thms.map (·.proof)}." -/-- The applicable alternative of a JP jump: its index, the payload proposition (an existential -closure of the join-argument equalities, abstracted over the alt-precondition mvar's binders), the -witnesses for the payload's existentials, and the reduction `redProof : matchExpr = redExpr` of the -precondition match to the alternative. -/ -private structure ResolvedJump where - altIdx : Nat - payload : Expr - witnesses : Array Expr - redExpr : Expr - redProof : Expr - /-- At a JP jump site `__do_jp args`, build this jump's `ResolvedJump`. `finalizeJPs` assigns `?Hᵢ` the disjunction of its jumps' payloads and discharges each jump by construction. @@ -429,28 +419,26 @@ enclosing split's hypotheses, so the search is bounded by the local nesting rath context. -/ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : VCGenM (Option ResolvedJump) := do - let info := jpInfo.splitInfo let joinArgs := e.getAppArgs liftMetaM do let lctx ← getLCtx -- Locals introduced since the join point was registered. The enclosing split's alt telescope -- (`fields ++ overlaps ++ discrEqs ++ extraEqs`, of length `bodyTeleLen`) sits at the front and -- pairs positionally with the recorded `JPAltLayout`; the locals past it are `∃`-closed below. - let slice := lctx.decls.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push |>.filterMap id + let slice := lctx.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push -- The branch hypotheses a jump needs are that telescope, whose length is at most `max bodyTeleLen`. -- So confining the assumption search to `[outerLCtxSize, outerLCtxSize + maxTele)` covers every -- alt's full discriminant evidence in a fixed window, independent of how deep the jump sits. let maxTele := jpInfo.altLayouts.foldl (fun acc l => max acc l.bodyTeleLen) 0 let upperBound := jpInfo.outerLCtxSize + maxTele let mut found : Option (Nat × Expr × Expr) := none - for idx in [:info.altInfos.size] do + for idx in [:jpInfo.altLayouts.size] do let red ← Lean.Elab.Tactic.Do.rwIfOrMatcher idx matchExpr (assumptionLowerBound := jpInfo.outerLCtxSize) (assumptionUpperBound := upperBound) let some redProof := red.proof? | continue found := some (idx, red.expr, redProof) break let some (altIdx, redExpr, redProof) := found | return none - unless altIdx < jpInfo.hypsMVars.size do return none let hypsMVar := jpInfo.hypsMVars[altIdx]! trace[Elab.Tactic.Do.vcgen] "JP jump: alt {altIdx} args={joinArgs}" let layout := jpInfo.altLayouts[altIdx]! @@ -475,20 +463,15 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : layout.specBinders - pairedFields - pairedEqs ≤ 1 do throwError "vcgen +jp: jump-site telescope does not match the recorded alt layout for \ {indentExpr e}" - let mut matchedLocals : Array Expr := #[] - let mut matchedBinders : Array Expr := #[] - for i in [:pairedFields] do - matchedLocals := matchedLocals.push slice[i]!.toExpr - matchedBinders := matchedBinders.push altBinders[i]! - for i in [:pairedEqs] do - matchedLocals := matchedLocals.push - slice[layout.bodyFields + layout.bodyOverlaps + i]!.toExpr - matchedBinders := matchedBinders.push altBinders[pairedFields + i]! - let eqs ← (jpBinders.mapIdx fun i jp => (jp, i)).mapM fun (jp, i) => Meta.mkEq jp joinArgs[i]! + let eqStart := layout.bodyFields + layout.bodyOverlaps + let matchedLocals := (slice.extract 0 pairedFields ++ slice.extract eqStart (eqStart + pairedEqs)) + |>.map LocalDecl.toExpr + let matchedBinders := altBinders.extract 0 (pairedFields + pairedEqs) + let eqs ← jpBinders.mapIdxM fun i jp => Meta.mkEq jp joinArgs[i]! -- Locals past the telescope are `∃`/`let`-closed. Implementation-detail decls (compiler -- internal) must never become `∃` binders or witnesses, so drop them here. - let restDecls := (slice.extract layout.bodyTeleLen slice.size).filter - (fun decl => !decl.isImplementationDetail) + let restDecls := slice.filter (fun decl => !decl.isImplementationDetail) + (start := layout.bodyTeleLen) let restLocals := restDecls.map LocalDecl.toExpr -- `∃ rest, joinParams = joinArgs`, existentially/let-closing the kept locals; the paired ones -- are then rewritten to the mvar's own alt binders. @@ -510,56 +493,68 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : payload := ← Meta.mkLambdaFVars allBinders φPropClosed witnesses := (restDecls.filter (·.value?.isNone)).map LocalDecl.toExpr } -/-- Prove `∃ locals, ⋀ joinArgs = joinArgs` by supplying each `∃` binder from `witnesses` (the actual -locals) and closing the residual equalities by `rfl`. -/ -private partial def fillJPExists (g : MVarId) (witnesses : List Expr) : MetaM Unit := do - let ty ← Meta.whnfR (← g.getType) +/-- Build the proof of `∃ locals, ⋀ joinParams = joinArgs`, supplying each `∃` binder from +`witnesses` (the actual locals) and closing the residual equalities by `rfl`. -/ +private partial def mkJPWitness (ty : Expr) (witnesses : List Expr) : MetaM Expr := do + let ty ← Meta.whnfR ty match_expr ty with | Exists α p => let w :: ws := witnesses | throwError "JP witness underflow" - let hGoal ← Meta.mkFreshExprSyntheticOpaqueMVar (p.beta #[w]) - g.assign (mkApp4 (mkConst ``Exists.intro [← Meta.getLevel α]) α p w hGoal) - fillJPExists hGoal.mvarId! ws + return mkApp4 (mkConst ``Exists.intro [← Meta.getLevel α]) α p w (← mkJPWitness (p.beta #[w]) ws) | And a b => - let ga ← Meta.mkFreshExprSyntheticOpaqueMVar a - let gb ← Meta.mkFreshExprSyntheticOpaqueMVar b - g.assign (mkApp4 (mkConst ``And.intro) a b ga gb) - fillJPExists ga.mvarId! witnesses - fillJPExists gb.mvarId! witnesses - | True => g.assign (mkConst ``True.intro) - | Eq _ lhs _ => g.assign (← Meta.mkEqRefl lhs) + return mkApp4 (mkConst ``And.intro) a b (← mkJPWitness a witnesses) (← mkJPWitness b witnesses) + | True => return mkConst ``True.intro + | Eq _ lhs _ => Meta.mkEqRefl lhs | _ => throwError "JP witness: unexpected residual{indentExpr ty}" /-- Prove disjunct `idx` of the `count`-fold right-nested disjunction `φ`, witnessing the selected -disjunct via `fillJPExists`. -/ +disjunct via `mkJPWitness`. -/ private partial def proveJPDisjunct (φ : Expr) (idx count : Nat) (witnesses : List Expr) : MetaM Expr := do if count == 1 then - let m ← Meta.mkFreshExprSyntheticOpaqueMVar φ - fillJPExists m.mvarId! witnesses - return m - let_expr Or a b := φ | throwError "JP finalization: expected disjunction{indentExpr φ}" - match idx with - | 0 => return mkApp3 (mkConst ``Or.inl) a b (← proveJPDisjunct a 0 1 witnesses) - | idx + 1 => return mkApp3 (mkConst ``Or.inr) a b (← proveJPDisjunct b idx (count - 1) witnesses) + mkJPWitness φ witnesses + else + let_expr Or a b := φ | throwError "JP finalization: expected disjunction{indentExpr φ}" + match idx with + | 0 => return mkApp3 (mkConst ``Or.inl) a b (← proveJPDisjunct a 0 1 witnesses) + | idx + 1 => return mkApp3 (mkConst ``Or.inr) a b (← proveJPDisjunct b idx (count - 1) witnesses) /-- Discharge a recorded JP jump: prove its own disjunct (number `idx` of `count`) of the assigned -`?Hᵢ`, then close the jump goal `pre ⊑ ⌜match discrs => ?Hᵢ⌝ ss` with it, built by construction. -The disjunct proof `φPrf : redExpr` is transported across the match reduction (`Eq.mpr redProof`) to -`hMatch : matchExpr`, then `le_ofProp` at the postcondition lattice with the constant precondition -`fun _ => pre` yields `(fun _ => pre) ⊑ ⌜matchExpr⌝`; applying the state args reduces the sides to -`pre` and the goal's `rhs` by `β`-reduction, which the kernel discharges. -/ +`?Hᵢ`, then close the jump goal `pre ⊑ (⌜match discrs => ?Hᵢ⌝ : Pred) ss` with it, built by +construction from the goal's own type. The disjunct proof `φPrf : redExpr` is transported across the +match reduction (`Eq.mpr redProof`) to `hMatch : matchExpr`, then `le_ofProp` at the postcondition +lattice with the constant precondition `fun _ => pre` yields `(fun _ => pre) ⊑ ⌜matchExpr⌝`; applying +the state args reduces the sides to `pre` and the goal's `rhs` by `β`-reduction, which the kernel +discharges. -/ private def dischargeJPJump (r : DeferredJump) (idx count : Nat) : VCGenM Unit := r.goal.withContext do - let φPrf ← liftMetaM <| proveJPDisjunct (← instantiateMVars r.redExpr) idx count r.witnesses.toList + let goalTy ← r.goal.getType + let_expr Lean.Order.PartialOrder.rel _α _inst pre rhs := goalTy + | throwError "vcgen +jp: unexpected jump goal{indentExpr goalTy}" + -- `rhs` is `ofProp Pred instCL matchExpr s₁ … sₙ`; `ofProp` and `le_ofProp` share the auto-bound + -- `l : Type u`, so its const level instantiates both. + let ofPropFn := rhs.getAppFn + let rhsArgs := rhs.getAppArgs + unless ofPropFn.isConstOf ``Lean.Order.CompleteLattice.ofProp && rhsArgs.size ≥ 3 do + throwError "vcgen +jp: jump precondition is not a `⌜·⌝` embedding{indentExpr rhs}" + let Pred := rhsArgs[0]! + let instCL := rhsArgs[1]! + let matchExpr := rhsArgs[2]! + let ss := rhsArgs.extract 3 rhsArgs.size + let φPrf ← liftMetaM <| + proveJPDisjunct (← instantiateMVars r.jump.redExpr) idx count r.jump.witnesses.toList -- `matchExpr : Prop`, so its reduction equality lives at `Prop`; `Eq.mpr` transports `φPrf` back. - let hMatch := mkApp4 (mkConst ``Eq.mpr [.zero]) r.matchExpr r.redExpr r.redProof φPrf - -- `fun _ => pre` at the postcondition lattice, of the state arity `ss` will apply. - let stateTys ← liftMetaM <| r.ss.mapM Meta.inferType - let constFn := stateTys.foldr (fun ty body => Expr.lam `s ty body .default) r.pre - let base := mkAppN (mkConst ``Lean.Order.le_ofProp [r.jpInfo.predLevel]) - #[r.jpInfo.Pred, r.jpInfo.instCL, constFn, r.matchExpr, hMatch] - r.goal.assign (← mkAppNS base r.ss) + let hMatch := mkApp4 (mkConst ``Eq.mpr [.zero]) matchExpr r.jump.redExpr r.jump.redProof φPrf + -- `fun _ => pre` at the postcondition lattice; the binder domains are `Pred`'s own. + let mut stateTys : Array Expr := #[] + let mut PredIt := Pred + for _ in [:ss.size] do + stateTys := stateTys.push PredIt.bindingDomain! + PredIt := PredIt.bindingBody! + let constFn := stateTys.foldr (fun ty body => Expr.lam `s ty body .default) pre + let base := mkAppN (mkConst ``Lean.Order.le_ofProp ofPropFn.constLevels!) + #[Pred, instCL, constFn, matchExpr, hMatch] + r.goal.assign (← mkAppNS base ss) /-- Assign every `+jp` alt-precondition mvar `?Hᵢ` the disjunction of the payloads its recorded jumps provided (`False` when no jump reaches the alt, e.g. behind an early `return` or a `throw`), @@ -574,7 +569,7 @@ public def finalizeJPs : VCGenM Unit := do let records := grouped.getD mv #[] unless ← mv.isAssigned do liftMetaM <| Meta.forallTelescopeReducing (← mv.getType) fun bs _ => do - let props := records.map (·.payload.beta bs) + let props := records.map (·.jump.payload.beta bs) let φ := match props.back? with | none => mkConst ``False | some last => props.pop.foldr (init := last) mkOr @@ -616,9 +611,7 @@ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM ( goal.assign proof -- Record the jump's precondition subgoal for `finalizeJPs`. let record : DeferredJump := - { jpInfo, hypsMVar := jpInfo.hypsMVars[jump.altIdx]!, goal := hPre.mvarId!, - payload := jump.payload, witnesses := jump.witnesses, redExpr := jump.redExpr, - redProof := jump.redProof, matchExpr, pre, ss } + { jump, hypsMVar := jpInfo.hypsMVars[jump.altIdx]!, goal := hPre.mvarId! } modify fun s => { s with jpJumps := s.jpJumps.push record } return some (.goalsInScope scope []) From 26bfbe2ccd1e48c073423891beb800dd5341be4c Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 24 Jul 2026 06:26:37 +0000 Subject: [PATCH 32/35] perf: keep vcgen +jp jumps on SymM primitives MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Replace the remaining `MetaM` term operations on the per-jump path with their `SymM` or purely syntactic counterparts: the join point's precondition abstraction is internalized once at registration and applied with `betaS`, so the deferred subgoal's type stays shared; the deferred reduction is instantiated with `instantiateMVarsS`; and the witness proof reads its universe levels off the payload's own `Exists`/`Eq` constants and zeta-reduces the payload's `let`-closures syntactically, keeping `whnfR` only as a fallback. `mkJPJumpPayload?` runs in `VCGenM` with `MetaM` lifted per call, and the assumption-search window length is computed once at registration (`JPDefInfo.maxBodyTeleLen`) instead of per jump. Rename the join point's body hypothesis to `__do_jp_spec`. The body's `Triple` type itself is left as built: it embeds the postcondition and the `?Hᵢ` mvars, so hash-consing it would re-walk the continuation at every registration. --- .../Tactic/Do/Internal/VCGen/Context.lean | 5 +- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 108 ++++++++++-------- 2 files changed, 67 insertions(+), 46 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean index 34924bfbaf67..3599b8e319a5 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Context.lean @@ -169,6 +169,9 @@ public structure JPDefInfo where outerLCtxSize : Nat /-- Per-alt binder layouts, aligned with `hypsMVars`. -/ altLayouts : Array JPAltLayout + /-- The largest `bodyTeleLen` over `altLayouts`: the length of the assumption-search window each + jump uses to discharge its branch hypotheses. -/ + maxBodyTeleLen : Nat deriving Inhabited public structure VCGen.Scope where @@ -289,7 +292,7 @@ public def Scope.collectLocalSpecs (scope : Scope) (goal : MVarId) : VCGenM Scop let lctx ← getLCtx if scope.nextDeclIdx == lctx.decls.size then return scope let scope ← lctx.foldlM (init := scope) (start := scope.nextDeclIdx) fun scope decl => do - -- Skip implementation-detail hypotheses (e.g. the `+jp` body proof `__do_jpProof`, the + -- Skip implementation-detail hypotheses (e.g. the `+jp` body proof `__do_jp_spec`, the -- `__do_jp` continuation): they are never user specs, and building a spec pattern from one -- runs `preprocessType` over its post, scaling with the continuation. if decl.isImplementationDetail then return scope diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 640606d43582..15c79f4dd879 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -283,7 +283,7 @@ private def computeBodyAltLayouts (sinfo : Lean.Elab.Tactic.Do.SplitInfo) (progT ref.get /-- `+jp`: at `wp⟦jpGadget fv rest⟧` with `rest` an `if`/`match`, register the join point `fv` and -split into two subgoals, the JP body (proved once, bound as the `__do_jpProof` hypothesis and closed +split into two subgoals, the JP body (proved once, bound as the `__do_jp_spec` hypothesis and closed against by every jump) and the (gadget-stripped) `rest`. The body's precondition splits the same way as `rest`: in branch `i` it is a fresh metavariable @@ -339,19 +339,26 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : -- no jump reaches the alt, e.g. behind an early `return` or a `throw`). modify fun s => { s with jpHypsMVars := s.jpHypsMVars ++ hypsMVars } + -- The telescope built this with `MetaM` primitives; internalize it once here, so the jumps' + -- `betaS` applications of it stay on sharing-preserving `SymM` primitives. `bodyTy` is left as + -- built: it embeds the post `Q` and the `?Hᵢ` mvars, so hash-consing it would re-walk the + -- continuation at every registration. + let pjpBodyAbs ← shareCommonInc pjpBodyAbs + let bodyMV ← liftMetaM <| Meta.mkFreshExprSyntheticOpaqueMVar bodyTy (← goal.getTag) -- Bind the body proof as a local hypothesis so each jump references it by fvar (`jpProof joinArgs`), -- keeping the shared continuation proof in one `let` binding that survives proof-term instantiation. -- `Sym.introN` derives the declaration kind from the `__`-prefixed name, so the hypothesis is an -- implementation detail and stays out of local-spec collection and assumption search. - let restGoal ← liftMetaM <| restGoal.define `__do_jpProof bodyTy bodyMV + let restGoal ← liftMetaM <| restGoal.define `__do_jp_spec bodyTy bodyMV let .goal newDecls restGoal ← Sym.introN restGoal 1 | throwError "vcgen +jp: failed to introduce the join point body proof" let jpProofFVar := newDecls[0]! let outerLCtxSize := (← restGoal.getDecl).lctx.numIndices + let maxBodyTeleLen := altLayouts.foldl (fun acc l => max acc l.bodyTeleLen) 0 let jpDefInfo : JPDefInfo := - { jpProof := .fvar jpProofFVar, pjpBodyAbs, hypsMVars, outerLCtxSize, altLayouts } + { jpProof := .fvar jpProofFVar, pjpBodyAbs, hypsMVars, outerLCtxSize, altLayouts, maxBodyTeleLen } -- `bodyMV` keeps the original scope so its own head is not treated as a JP. let restScope := scope.registerJP fvId jpDefInfo return some (.goals [(restScope, restGoal), (scope, bodyMV.mvarId!)]) @@ -420,29 +427,27 @@ context. -/ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : VCGenM (Option ResolvedJump) := do let joinArgs := e.getAppArgs - liftMetaM do - let lctx ← getLCtx - -- Locals introduced since the join point was registered. The enclosing split's alt telescope - -- (`fields ++ overlaps ++ discrEqs ++ extraEqs`, of length `bodyTeleLen`) sits at the front and - -- pairs positionally with the recorded `JPAltLayout`; the locals past it are `∃`-closed below. - let slice := lctx.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push - -- The branch hypotheses a jump needs are that telescope, whose length is at most `max bodyTeleLen`. - -- So confining the assumption search to `[outerLCtxSize, outerLCtxSize + maxTele)` covers every - -- alt's full discriminant evidence in a fixed window, independent of how deep the jump sits. - let maxTele := jpInfo.altLayouts.foldl (fun acc l => max acc l.bodyTeleLen) 0 - let upperBound := jpInfo.outerLCtxSize + maxTele - let mut found : Option (Nat × Expr × Expr) := none - for idx in [:jpInfo.altLayouts.size] do - let red ← Lean.Elab.Tactic.Do.rwIfOrMatcher idx matchExpr - (assumptionLowerBound := jpInfo.outerLCtxSize) (assumptionUpperBound := upperBound) - let some redProof := red.proof? | continue - found := some (idx, red.expr, redProof) - break - let some (altIdx, redExpr, redProof) := found | return none - let hypsMVar := jpInfo.hypsMVars[altIdx]! - trace[Elab.Tactic.Do.vcgen] "JP jump: alt {altIdx} args={joinArgs}" - let layout := jpInfo.altLayouts[altIdx]! - Meta.forallTelescopeReducing (← hypsMVar.getType) fun allBinders _ => do + let lctx ← liftMetaM getLCtx + -- Locals introduced since the join point was registered. The enclosing split's alt telescope + -- (`fields ++ overlaps ++ discrEqs ++ extraEqs`, of length `bodyTeleLen`) sits at the front and + -- pairs positionally with the recorded `JPAltLayout`; the locals past it are `∃`-closed below. + let slice := lctx.foldl (init := #[]) (start := jpInfo.outerLCtxSize) Array.push + -- The branch hypotheses a jump needs are that telescope, whose length is at most `maxBodyTeleLen`. + -- So confining the assumption search to `[outerLCtxSize, outerLCtxSize + maxBodyTeleLen)` covers + -- every alt's full discriminant evidence in a fixed window, independent of how deep the jump sits. + let upperBound := jpInfo.outerLCtxSize + jpInfo.maxBodyTeleLen + let mut found : Option (Nat × Expr × Expr) := none + for idx in [:jpInfo.altLayouts.size] do + let red ← liftMetaM <| Lean.Elab.Tactic.Do.rwIfOrMatcher idx matchExpr + (assumptionLowerBound := jpInfo.outerLCtxSize) (assumptionUpperBound := upperBound) + let some redProof := red.proof? | continue + found := some (idx, red.expr, redProof) + break + let some (altIdx, redExpr, redProof) := found | return none + let hypsMVar := jpInfo.hypsMVars[altIdx]! + trace[Elab.Tactic.Do.vcgen] "JP jump: alt {altIdx} args={joinArgs}" + let layout := jpInfo.altLayouts[altIdx]! + Meta.forallTelescopeReducing (← liftMetaM hypsMVar.getType) fun allBinders _ => do let numJP := joinArgs.size unless numJP ≤ allBinders.size do return none let jpBinders := allBinders.extract 0 numJP @@ -467,7 +472,7 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : let matchedLocals := (slice.extract 0 pairedFields ++ slice.extract eqStart (eqStart + pairedEqs)) |>.map LocalDecl.toExpr let matchedBinders := altBinders.extract 0 (pairedFields + pairedEqs) - let eqs ← jpBinders.mapIdxM fun i jp => Meta.mkEq jp joinArgs[i]! + let eqs ← liftMetaM <| jpBinders.mapIdxM fun i jp => Meta.mkEq jp joinArgs[i]! -- Locals past the telescope are `∃`/`let`-closed. Implementation-detail decls (compiler -- internal) must never become `∃` binders or witnesses, so drop them here. let restDecls := slice.filter (fun decl => !decl.isImplementationDetail) @@ -478,34 +483,46 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : let (_, φPropClosed) ← restDecls.foldrM (init := (restLocals, (mkAndN eqs.toList).abstract restLocals)) fun decl (locals, φ) => do let locals := locals.pop - let type := (← instantiateMVars decl.type).abstract locals + let type := (← instantiateMVarsS decl.type).abstract locals match decl.value? with | some v => - let val := (← instantiateMVars v).abstract locals + let val := (← instantiateMVarsS v).abstract locals return (locals, Lean.mkLet decl.userName type val φ (nondep := decl.isNondep)) | none => - let typeLevel ← Meta.getLevel decl.type + let typeLevel ← liftMetaM <| Meta.getLevel decl.type return (locals, mkApp2 (mkConst ``Exists [typeLevel]) type (Expr.lam decl.userName type φ .default)) let φPropClosed := φPropClosed.replaceFVars matchedLocals matchedBinders -- The `∃` binders are exactly the non-let rest locals, in order; hand them back as witnesses. return some { altIdx, redExpr, redProof - payload := ← Meta.mkLambdaFVars allBinders φPropClosed + payload := ← liftMetaM <| Meta.mkLambdaFVars allBinders φPropClosed witnesses := (restDecls.filter (·.value?.isNone)).map LocalDecl.toExpr } /-- Build the proof of `∃ locals, ⋀ joinParams = joinArgs`, supplying each `∃` binder from -`witnesses` (the actual locals) and closing the residual equalities by `rfl`. -/ +`witnesses` (the actual locals) and closing the residual equalities by `rfl`. Every node of the +payload is built by `mkJPJumpPayload?`, so its shape is matched syntactically (`let`-closed locals +zeta-reduce as they are passed) and the universe levels are read off the payload's own constants; +`whnfR` remains only as a fallback for a node reached through reduction. -/ private partial def mkJPWitness (ty : Expr) (witnesses : List Expr) : MetaM Expr := do - let ty ← Meta.whnfR ty - match_expr ty with - | Exists α p => - let w :: ws := witnesses | throwError "JP witness underflow" - return mkApp4 (mkConst ``Exists.intro [← Meta.getLevel α]) α p w (← mkJPWitness (p.beta #[w]) ws) - | And a b => - return mkApp4 (mkConst ``And.intro) a b (← mkJPWitness a witnesses) (← mkJPWitness b witnesses) - | True => return mkConst ``True.intro - | Eq _ lhs _ => Meta.mkEqRefl lhs - | _ => throwError "JP witness: unexpected residual{indentExpr ty}" + match ty with + | .letE _ _ v b _ => mkJPWitness (b.instantiate1 v) witnesses + | .mdata _ b => mkJPWitness b witnesses + | _ => + match_expr ty with + | Exists α p => + let w :: ws := witnesses | throwError "JP witness underflow" + return mkApp4 (mkConst ``Exists.intro ty.getAppFn.constLevels!) α p w + (← mkJPWitness (p.beta #[w]) ws) + | And a b => + return mkApp4 (mkConst ``And.intro) a b (← mkJPWitness a witnesses) (← mkJPWitness b witnesses) + | True => return mkConst ``True.intro + | Eq α lhs _ => return mkApp2 (mkConst ``Eq.refl ty.getAppFn.constLevels!) α lhs + | _ => + let ty' ← Meta.whnfR ty + if ty' != ty then + mkJPWitness ty' witnesses + else + throwError "JP witness: unexpected residual{indentExpr ty}" /-- Prove disjunct `idx` of the `count`-fold right-nested disjunction `φ`, witnessing the selected disjunct via `mkJPWitness`. -/ @@ -542,7 +559,7 @@ private def dischargeJPJump (r : DeferredJump) (idx count : Nat) : VCGenM Unit : let matchExpr := rhsArgs[2]! let ss := rhsArgs.extract 3 rhsArgs.size let φPrf ← liftMetaM <| - proveJPDisjunct (← instantiateMVars r.jump.redExpr) idx count r.jump.witnesses.toList + proveJPDisjunct (← instantiateMVarsS r.jump.redExpr) idx count r.jump.witnesses.toList -- `matchExpr : Prop`, so its reduction equality lives at `Prop`; `Eq.mpr` transports `φPrf` back. let hMatch := mkApp4 (mkConst ``Eq.mpr [.zero]) matchExpr r.jump.redExpr r.jump.redProof φPrf -- `fun _ => pre` at the postcondition lattice; the binder domains are `Pred`'s own. @@ -588,8 +605,9 @@ private def tryJPJump? (scope : Scope) (goal : MVarId) (info : WPApp) : VCGenM ( let some jpInfo := scope.knownJP? fvId | return none let joinArgs := info.prog.getAppArgs -- `pjpBodyAbs` is a lambda over the join params; beta-reduce so the head is `⌜·⌝` (`ofProp`). - -- The precondition carries no post `Q`, so this stays cheap. - let ofPropMatch := jpInfo.pjpBodyAbs.beta joinArgs + -- The precondition carries no post `Q`, so this stays cheap. `betaS` keeps the result shared, + -- since it flows into the deferred subgoal's type below. + let ofPropMatch ← betaS jpInfo.pjpBodyAbs joinArgs let_expr Lean.Order.CompleteLattice.ofProp _ _ matchExpr := ofPropMatch | throwError "vcgen +jp: join point precondition is not a `⌜·⌝` embedding{indentExpr ofPropMatch}" let some jump ← mkJPJumpPayload? jpInfo info.prog matchExpr From 137fa15f65940801455ae404ff7918eb9438d009 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 24 Jul 2026 06:43:50 +0000 Subject: [PATCH 33/35] refactor: match the +jp witness payload purely syntactically Drop the `whnfR` fallback from `mkJPWitness`: every node it visits is built by `mkJPJumpPayload?` and reached through pure substitution, so the payload is matched syntactically and an unexpected shape is a loud error rather than something reduction might paper over. --- .../Elab/Tactic/Do/Internal/VCGen/Solve.lean | 36 ++++++++----------- 1 file changed, 14 insertions(+), 22 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 15c79f4dd879..8ad90910a74f 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -500,29 +500,21 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : /-- Build the proof of `∃ locals, ⋀ joinParams = joinArgs`, supplying each `∃` binder from `witnesses` (the actual locals) and closing the residual equalities by `rfl`. Every node of the -payload is built by `mkJPJumpPayload?`, so its shape is matched syntactically (`let`-closed locals -zeta-reduce as they are passed) and the universe levels are read off the payload's own constants; -`whnfR` remains only as a fallback for a node reached through reduction. -/ +payload is built by `mkJPJumpPayload?`, so its shape is matched syntactically: `let`-closed locals +zeta-reduce as they are passed and the universe levels are read off the payload's own constants. -/ private partial def mkJPWitness (ty : Expr) (witnesses : List Expr) : MetaM Expr := do - match ty with - | .letE _ _ v b _ => mkJPWitness (b.instantiate1 v) witnesses - | .mdata _ b => mkJPWitness b witnesses - | _ => - match_expr ty with - | Exists α p => - let w :: ws := witnesses | throwError "JP witness underflow" - return mkApp4 (mkConst ``Exists.intro ty.getAppFn.constLevels!) α p w - (← mkJPWitness (p.beta #[w]) ws) - | And a b => - return mkApp4 (mkConst ``And.intro) a b (← mkJPWitness a witnesses) (← mkJPWitness b witnesses) - | True => return mkConst ``True.intro - | Eq α lhs _ => return mkApp2 (mkConst ``Eq.refl ty.getAppFn.constLevels!) α lhs - | _ => - let ty' ← Meta.whnfR ty - if ty' != ty then - mkJPWitness ty' witnesses - else - throwError "JP witness: unexpected residual{indentExpr ty}" + if let .letE _ _ v b _ := ty then + return ← mkJPWitness (b.instantiate1 v) witnesses + match_expr ty with + | Exists α p => + let w :: ws := witnesses | throwError "JP witness underflow" + return mkApp4 (mkConst ``Exists.intro ty.getAppFn.constLevels!) α p w + (← mkJPWitness (p.beta #[w]) ws) + | And a b => + return mkApp4 (mkConst ``And.intro) a b (← mkJPWitness a witnesses) (← mkJPWitness b witnesses) + | True => return mkConst ``True.intro + | Eq α lhs _ => return mkApp2 (mkConst ``Eq.refl ty.getAppFn.constLevels!) α lhs + | _ => throwError "JP witness: unexpected residual{indentExpr ty}" /-- Prove disjunct `idx` of the `count`-fold right-nested disjunction `φ`, witnessing the selected disjunct via `mkJPWitness`. -/ From a084d2b4e450b23a943c288609272e0ef8f8c015 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 24 Jul 2026 06:59:03 +0000 Subject: [PATCH 34/35] perf: drop reduction from the +jp telescope and level queries MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Telescope the `?Hᵢ` mvar types with `forallTelescope`: they are the syntactic `∀`-chains built at registration, so the reducing variant's whnf at every binder step buys nothing. Build the join-argument equalities and existential levels through the cached `Sym.inferType`/`Sym.getLevel`, and read the `jpGadget` levels the same way, so repeated queries on shared goal subterms hit the pointer cache. --- src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 8ad90910a74f..64c271246366 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -228,8 +228,8 @@ private def tryMarkJP? (goal : MVarId) (info : WPApp) : VCGenM (Option MVarId) : unless Lean.Elab.Tactic.Do.isJP name do return none unless val.isLambda do return none if body.getAppFn.isConstOf ``Std.Internal.Do.jpGadget then return none - let uα ← liftMetaM <| Meta.getLevel info.Prog - let uβ ← liftMetaM <| Meta.getLevel ty + let uα ← Sym.getLevel info.Prog + let uβ ← Sym.getLevel ty let wrapped := Expr.letE name ty val (mkAppN (mkConst ``Std.Internal.Do.jpGadget [uα, uβ]) #[info.Prog, ty, .bvar 0, body]) nondep return some (← replaceProgDefEq goal info (← mkAppRevS wrapped info.prog.getAppRevArgs)) @@ -447,7 +447,8 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : let hypsMVar := jpInfo.hypsMVars[altIdx]! trace[Elab.Tactic.Do.vcgen] "JP jump: alt {altIdx} args={joinArgs}" let layout := jpInfo.altLayouts[altIdx]! - Meta.forallTelescopeReducing (← liftMetaM hypsMVar.getType) fun allBinders _ => do + -- The mvar type is the syntactic `∀`-chain built at registration, so no reducing telescope. + Meta.forallTelescope (← liftMetaM hypsMVar.getType) fun allBinders _ => do let numJP := joinArgs.size unless numJP ≤ allBinders.size do return none let jpBinders := allBinders.extract 0 numJP @@ -472,7 +473,9 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : let matchedLocals := (slice.extract 0 pairedFields ++ slice.extract eqStart (eqStart + pairedEqs)) |>.map LocalDecl.toExpr let matchedBinders := altBinders.extract 0 (pairedFields + pairedEqs) - let eqs ← liftMetaM <| jpBinders.mapIdxM fun i jp => Meta.mkEq jp joinArgs[i]! + let eqs ← jpBinders.mapIdxM fun i jp => do + let τ ← Sym.inferType jp + return mkApp3 (mkConst ``Eq [← Sym.getLevel τ]) τ jp joinArgs[i]! -- Locals past the telescope are `∃`/`let`-closed. Implementation-detail decls (compiler -- internal) must never become `∃` binders or witnesses, so drop them here. let restDecls := slice.filter (fun decl => !decl.isImplementationDetail) @@ -489,7 +492,7 @@ private def mkJPJumpPayload? (jpInfo : JPDefInfo) (e matchExpr : Expr) : let val := (← instantiateMVarsS v).abstract locals return (locals, Lean.mkLet decl.userName type val φ (nondep := decl.isNondep)) | none => - let typeLevel ← liftMetaM <| Meta.getLevel decl.type + let typeLevel ← Sym.getLevel decl.type return (locals, mkApp2 (mkConst ``Exists [typeLevel]) type (Expr.lam decl.userName type φ .default)) let φPropClosed := φPropClosed.replaceFVars matchedLocals matchedBinders -- The `∃` binders are exactly the non-let rest locals, in order; hand them back as witnesses. @@ -577,7 +580,7 @@ public def finalizeJPs : VCGenM Unit := do for mv in s.jpHypsMVars do let records := grouped.getD mv #[] unless ← mv.isAssigned do - liftMetaM <| Meta.forallTelescopeReducing (← mv.getType) fun bs _ => do + liftMetaM <| Meta.forallTelescope (← mv.getType) fun bs _ => do let props := records.map (·.jump.payload.beta bs) let φ := match props.back? with | none => mkConst ``False From a5761e0c2a3867e9779b2a1660ce4d2a5a5a0042 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Fri, 24 Jul 2026 07:04:08 +0000 Subject: [PATCH 35/35] perf: hash-cons the inferred and elaborated terms entering vcgen goals Infer the join point's type and the frame pattern variables' types through `Sym.inferType`, whose results are hash-consed and cached, and explicitly `shareCommon` the elaborated `frames` term and the speculative `@[frameproc]` frame. `instantiateMVarsS` returns a metavariable-free term unshared, so these previously entered the goals without sharing. --- src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean index 64c271246366..c716a5533cbb 100644 --- a/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean +++ b/src/Lean/Elab/Tactic/Do/Internal/VCGen/Solve.lean @@ -301,7 +301,7 @@ private def tryJPGadget? (scope : Scope) (goal : MVarId) (info : WPApp) : let some resTy := sinfo.resTy | return some (.goalsInScope scope [restGoal]) let Q := info.post - let joinTy ← liftMetaM <| Meta.inferType fv + let joinTy ← Sym.inferType fv let numJoinParams ← liftMetaM <| Lean.Elab.Tactic.Do.getNumJoinParams joinTy resTy -- Create the `?Hᵢ` mvars in the outer local context so they stay shared across jump sites. @@ -711,13 +711,15 @@ private def elabFrame (resourceTy : Expr) (entry : FrameEntry) (res : Sym.MatchU for h : i in [0:entry.varNames.size] do if let some nm := entry.varNames[i] then if h2 : i < res.args.size then - decls := decls.push (nm, ← Meta.inferType res.args[i]!, res.args[i]!) + decls := decls.push (nm, ← Sym.inferType res.args[i]!, res.args[i]!) Meta.withDefault <| withLetDeclsDND decls fun fvs => do let frameExpr ← Lean.Elab.Term.TermElabM.run' do let e ← Lean.Elab.Term.elabTermEnsuringType entry.frameStx (some resourceTy) Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing mkLetFVars fvs e - instantiateMVarsS frameExpr + -- The elaborated frame enters the goals, so hash-cons it; `instantiateMVarsS` alone returns an + -- mvar-free elaboration unshared. + shareCommon (← liftMetaM <| instantiateMVars frameExpr) /-- Find an unretired `frames` alternative matching the program (earliest source order wins), elaborate its frame at the resource type `resourceTy`, and retire it so it applies at most once. -/ @@ -809,8 +811,9 @@ private def applyFrameOrSpec (scope : VCGen.Scope) (goal : MVarId) (pre : Expr) | none => pure none let some F := frame? | return .goals scopedSubgoals -- Capture the frame before rolling back: `saved.restore` un-assigns the speculative metavariables, - -- so instantiate `F` against them now (and reshare). - let F ← instantiateMVarsS F + -- so instantiate `F` against them now. `shareCommonInc` hash-conses the frame even when it carried + -- no metavariables (which `instantiateMVarsS` returns unshared). + let F ← shareCommonInc (← instantiateMVarsS F) trace[Elab.Tactic.Do.vcgen] "`@[frameproc]` matched {info.prog}; frame:{indentExpr F}" saved.restore return .goalsInScope scope (← applyFrameRule goal info fp F)