Skip to content

Commit b93a53c

Browse files
committed
refactor: drop wp canonicalization, register the WP interpretations as instances
The default-transparency instance guard alone fixes spec application for goals with a registered `WP` instance: the rule conclusion pins the goal's own instance arguments, premises keep the spec's `WPMonad.toWP` spelling, and `synthPending` assigns the spec's `WPMonad` metavariable during the guard, so goals and rules stay consistent without canonicalizing either. `Sym.canon` on the constructed rule also rewrote tuple matchers into projections, which destroyed the binder names that `binderNameHint` consumption reads and broke `tests/elab/intrinsicVerification.lean` (also on CI). The `WP` interpretations in `Std.WP.Monad.Instances` are proper instances now, with `toWP _ := inferInstance`, so the existing tests exercise the registered-instance path and the dedicated regression test is gone. The `Id`-monad theorems in `tests/elab/vcgenFrames.lean` state their assertions at `Prop`: a hypothesis `[WPMonad Id Pred EPred]` over a generic `Pred` denotes no real instance, and instance search, which ignores `outParam` positions during selection, resolves `WP (Id β) …` to the registered `Prop` instance regardless.
1 parent ddd0a8b commit b93a53c

5 files changed

Lines changed: 34 additions & 152 deletions

File tree

‎src/Lean/Elab/Tactic/VCGen/Driver.lean‎

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ public import Lean.Elab.Tactic.Meta
1010
public import Lean.Elab.Tactic.VCGen.Context
1111
public import Lean.Elab.Tactic.VCGen.Solve
1212
public import Lean.Meta.Sym.Grind
13-
import Lean.Meta.Sym.Canon
1413

1514
open Lean Meta Elab Tactic Sym Sym.Internal Lean.Order
1615
open Lean.Elab.Tactic.Do.SpecAttr
@@ -94,16 +93,8 @@ private structure WorkItem where
9493
goal : Grind.Goal
9594
scope : Scope
9695

97-
/--
98-
Canonicalizes the goal target with `Sym.canon`, so its instance arguments (e.g. the `WP`
99-
instance of a `wp` application) match the canonicalized rules from `tryMkBackwardRuleFromSpec`.
100-
-/
101-
private def canonTarget (mvarId : MVarId) : SymM MVarId := do
102-
mvarId.replaceTargetDefEqFast (← shareCommon (← Sym.canon (← mvarId.getType)))
103-
10496
public def work (scope : Scope) (goal : Grind.Goal) : VCGenM Unit := do
10597
let mvarId ← preprocessMVar goal.mvarId
106-
let mvarId ← canonTarget mvarId
10798
let mut worklist : Array WorkItem := #[{ goal := { goal with mvarId }, scope }]
10899
while let some s := worklist.back? do
109100
worklist := worklist.pop

‎src/Lean/Elab/Tactic/VCGen/RuleConstruction.lean‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,6 @@ public import Lean.Elab.Tactic.VCGen.Reduce
1212
public import Lean.Elab.Tactic.VCGen.SpecDB
1313
public import Lean.Meta.Sym.Apply
1414
public import Lean.Meta.Sym.Util
15-
import Lean.Meta.Sym.Canon
1615
meta import Std.WP.Frame
1716

1817
open Lean Meta Elab Tactic Sym
@@ -284,7 +283,7 @@ exposes in the premise program (e.g. for class projection unfold equations like
284283
`MonadState.modifyGet.eq_1`) are reduced by `wpHeadReduce?` before the next spec lookup.
285284
-/
286285
private def eqSpecToWp? (info : WPApp) (eqPrf eqType : Expr) :
287-
OptionT SymM (Expr × Expr) := do
286+
OptionT MetaM (Expr × Expr) := do
288287
let_expr Eq eqα _lhs _rhs := eqType
289288
| throwError "simp spec is not an equation: {eqType}"
290289
-- Unify the equation's type with the goal's program type. First-order approximation decomposes
@@ -316,7 +315,7 @@ same way.
316315
`info.Pred = σ1 → ... → σn → Prop`
317316
-/
318317
public def tryMkBackwardRuleFromSpec (specThm : SpecTheorem) (info : WPApp)
319-
(stateArgNames : Array Name := #[]) : OptionT SymM BackwardRule := do
318+
(stateArgNames : Array Name := #[]) : OptionT MetaM BackwardRule := do
320319
-- Instantiate the spec theorem, creating metavars for all universally quantified params
321320
let (_xs, _bs, specProof, specType) ← specThm.instantiate
322321
-- Equality specs (the simp side of `@[spec]`) are normalized to `⊑ wp` form, then handled like
@@ -329,6 +328,8 @@ public def tryMkBackwardRuleFromSpec (specThm : SpecTheorem) (info : WPApp)
329328
guard <| ← isDefEqGuarded info.Pred Pred'
330329
let_expr Std.WP.wp _Prog' _Value' _Pred' _EPred' _instAL' _instEAL' instWP' prog postSpec epostSpec := rhs
331330
| throwError "target not a wp application {rhs}"
331+
-- `withDefault`: the goal can carry a registered `WP` instance (e.g. `Id.wpInst`) while the
332+
-- spec spells `WPMonad.toWP ?inst`; default transparency unfolds both after `?inst` synthesis.
332333
guard <| ← withDefault <| isDefEqGuarded info.instWP instWP'
333334
-- Use local excess-state binders so explicit post premises can be re-lifted to `⊑`.
334335
-- Name them positionally from `stateArgNames` (else `s`) so the rule's binders carry good names.
@@ -339,8 +340,7 @@ public def tryMkBackwardRuleFromSpec (specThm : SpecTheorem) (info : WPApp)
339340
ssTypes := ssTypes.push ty
340341
ss := ss.push <| ← mkFreshExprMVar (userName := stateArgNames[i]?.getD `s) ty
341342
let res ← mkSpecBackwardProof pre prog postSpec epostSpec specProof info.EPred ss ssTypes stateArgNames
342-
let expr ← Sym.canon res.expr
343-
mkBackwardRuleFromExpr expr res.paramNames.toList
343+
mkBackwardRuleFromExpr res.expr res.paramNames.toList
344344

345345
/-! ## Split rules -/
346346

@@ -446,7 +446,7 @@ condition `WP.Frames op prog F`, with the frame `F` left schematic and the weake
446446
frame. `analyzeFrameRule` records the positions of the schematic slots.
447447
-/
448448
public def mkFrameBackwardRule (fp : FrameProc) (info : WPApp) :
449-
SymM FrameBackwardRule := do
449+
MetaM FrameBackwardRule := do
450450
-- Pin the program and the operator, leaving everything else schematic;
451451
-- `tryMkBackwardRuleFromSpec` turns the unassigned metavariables into rule parameters.
452452
let op ← fp.mkOpAppM info

‎src/Std/WP/Monad/Instances.lean‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -41,13 +41,13 @@ namespace Std.WP
4141
variable {m : Type u → Type z}
4242

4343
/-- `Id`'s `WP` interpretation: `Prop` assertions and no exceptions. -/
44-
@[instance_reducible] def Id.wpInst {α : Type u} : WP (Id α) α Prop EStack⟨⟩ where
44+
instance Id.wpInst {α : Type u} : WP (Id α) α Prop EStack⟨⟩ where
4545
wpTrans x := ⟨fun post _epost => post x⟩
4646
wp_trans_monotone x := fun _ _ _ _ _ hpost => hpost x
4747

4848
/-- `Id` is a WPMonad with `Prop` assertions and no exceptions. -/
4949
instance Id.instWPMonad : WPMonad Id.{u} Prop EStack⟨⟩ where
50-
toWP _ := Id.wpInst
50+
toWP _ := inferInstance
5151
pure_le_wp_pure _ _ _ := PartialOrder.rel_refl
5252
bind_le_wp_bind _ _ _ _ := PartialOrder.rel_refl
5353

@@ -86,7 +86,7 @@ instance {ε : Type u} {Pred : Type v} {EPred : Type w} {ε' : Type u}
8686

8787
/-- `ExceptT`'s `WP` interpretation: lift the base interpretation by adding an exception
8888
postcondition layer. -/
89-
@[instance_reducible] def ExceptT.wpInst {Pred : Type v}
89+
instance ExceptT.wpInst {Pred : Type v}
9090
[Assertion Pred] [Assertion EPred] [WP (m (Except ε α)) (Except ε α) Pred EPred] :
9191
WP (ExceptT ε m α) α Pred ((ε → Pred) × EPred) where
9292
wpTrans x := PredTrans.pushExceptT (WP.wpTrans x.run)
@@ -103,7 +103,7 @@ postcondition layer. -/
103103
instance ExceptT.instWPMonad {Pred : Type v}
104104
[Monad m] [Assertion Pred] [Assertion EPred] [WPMonad m Pred EPred] :
105105
WPMonad (ExceptT ε m) Pred ((ε → Pred) × EPred) where
106-
toWP _ := ExceptT.wpInst
106+
toWP _ := inferInstance
107107
pure_le_wp_pure x := fun post epost =>
108108
WPMonad.pure_le_wp_pure (m := m) (Except.ok x) (pushExcept post epost.fst) epost.snd
109109
bind_le_wp_bind x f := fun post epost => by
@@ -124,7 +124,7 @@ theorem ExceptT.wp_apply_eq {α ε Pred EPred}
124124

125125
/-- `OptionT`'s `WP` interpretation: lift the base interpretation by adding a `Unit` exception
126126
postcondition layer. -/
127-
@[instance_reducible] def OptionT.wpInst {Pred : Type u}
127+
instance OptionT.wpInst {Pred : Type u}
128128
[Assertion Pred] [Assertion EPred] [WP (m (Option α)) (Option α) Pred EPred] :
129129
WP (OptionT m α) α Pred ((Unit → Pred) × EPred) where
130130
wpTrans x := PredTrans.pushOptionT (WP.wpTrans x.run)
@@ -140,7 +140,7 @@ postcondition layer. -/
140140
instance OptionT.instWPMonad {Pred : Type u}
141141
[Monad m] [Assertion Pred] [Assertion EPred] [WPMonad m Pred EPred] :
142142
WPMonad (OptionT m) Pred ((Unit → Pred) × EPred) where
143-
toWP _ := OptionT.wpInst
143+
toWP _ := inferInstance
144144
pure_le_wp_pure x := fun post epost =>
145145
WPMonad.pure_le_wp_pure (m := m) (some x) (pushOption post epost.fst) epost.snd
146146
bind_le_wp_bind x f := fun post epost => by
@@ -160,7 +160,7 @@ theorem OptionT.wp_apply_eq {α : Type u} {Pred : Type u} {EPred}
160160
wp x post epost = wp x.run (pushOption post epost.fst) epost.snd := rfl
161161

162162
/-- `StateT`'s `WP` interpretation: lift the base interpretation by adding a state argument. -/
163-
@[instance_reducible] def StateT.wpInst {EPred : Type v} {σ : Type u} {Pred : Type w}
163+
instance StateT.wpInst {EPred : Type v} {σ : Type u} {Pred : Type w}
164164
[Assertion Pred] [Assertion EPred] [WP (m (α × σ)) (α × σ) Pred EPred] :
165165
WP (StateT σ m α) α (σ → Pred) EPred where
166166
wpTrans x := pushArg (WP.wpTrans <| x.run ·)
@@ -174,7 +174,7 @@ theorem OptionT.wp_apply_eq {α : Type u} {Pred : Type u} {EPred}
174174
instance (priority := low) StateT.instWPMonad {EPred : Type v} {σ : Type u} {Pred : Type w}
175175
[Monad m] [Assertion Pred] [Assertion EPred] [WPMonad m Pred EPred] :
176176
WPMonad (StateT σ m) (σ → Pred) EPred where
177-
toWP _ := StateT.wpInst
177+
toWP _ := inferInstance
178178
pure_le_wp_pure x := fun post epost s =>
179179
WPMonad.pure_le_wp_pure (m := m) (x, s) (fun p => post p.1 p.2) epost
180180
bind_le_wp_bind x f := fun post epost s => by
@@ -187,7 +187,7 @@ theorem StateT.wp_apply_eq {σ : Type u}
187187
wp x post epost s = wp (x.run s) (fun (a, s) => post a s) epost := rfl
188188

189189
/-- `ReaderT`'s `WP` interpretation: lift the base interpretation by adding a reader argument. -/
190-
@[instance_reducible] def ReaderT.wpInst {Pred : Type v}
190+
instance ReaderT.wpInst {Pred : Type v}
191191
[Assertion Pred] [Assertion EPred] [WP (m α) α Pred EPred] :
192192
WP (ReaderT ρ m α) α (ρ → Pred) EPred where
193193
wpTrans x := ⟨fun post epost r => wp (x.run r) (fun a => post a r) epost⟩
@@ -201,7 +201,7 @@ theorem StateT.wp_apply_eq {σ : Type u}
201201
instance ReaderT.instWPMonad {Pred : Type v}
202202
[Monad m] [Assertion Pred] [Assertion EPred] [WPMonad m Pred EPred] :
203203
WPMonad (ReaderT ρ m) (ρ → Pred) EPred where
204-
toWP _ := ReaderT.wpInst
204+
toWP _ := inferInstance
205205
pure_le_wp_pure x := fun post epost r =>
206206
WPMonad.pure_le_wp_pure (m := m) x (fun a => post a r) epost
207207
bind_le_wp_bind x f := fun post epost r => by
@@ -224,7 +224,7 @@ theorem ReaderT.wp_apply_eq {ρ : Type u}
224224

225225
/-- `Option`'s `WP` interpretation: `Prop` assertions and a `Unit`-indexed exception
226226
postcondition. -/
227-
@[instance_reducible] def Option.wpInst {α : Type u} : WP (Option α) α Prop (Unit → Prop) where
227+
instance Option.wpInst {α : Type u} : WP (Option α) α Prop (Unit → Prop) where
228228
wpTrans x := ⟨fun post epost => pushOption post epost x⟩
229229
wp_trans_monotone x := fun post post' epost epost' hepost hpost => by
230230
cases x with
@@ -233,13 +233,13 @@ postcondition. -/
233233

234234
/-- `Option` is a WPMonad with `Prop` assertions and a `Unit`-indexed exception postcondition. -/
235235
instance Option.instWPMonad : WPMonad Option.{u} Prop (Unit → Prop) where
236-
toWP _ := Option.wpInst
236+
toWP _ := inferInstance
237237
pure_le_wp_pure _ _ _ := PartialOrder.rel_refl
238238
bind_le_wp_bind x f := fun post epost => by cases x <;> exact id
239239

240240
/-- `Except ε`'s `WP` interpretation: `Prop` assertions and an `ε`-indexed exception
241241
postcondition. -/
242-
@[instance_reducible] def Except.wpInst {α : Type u} : WP (Except ε α) α Prop (ε → Prop) where
242+
instance Except.wpInst {α : Type u} : WP (Except ε α) α Prop (ε → Prop) where
243243
wpTrans x := ⟨fun post epost => pushExcept post epost x⟩
244244
wp_trans_monotone x := fun post post' epost epost' hepost hpost => by
245245
cases x with
@@ -248,12 +248,12 @@ postcondition. -/
248248

249249
/-- `Except ε` is a WPMonad with `Prop` assertions and an `ε`-indexed exception postcondition. -/
250250
instance Except.instWPMonad : WPMonad (Except ε) Prop (ε → Prop) where
251-
toWP _ := Except.wpInst
251+
toWP _ := inferInstance
252252
pure_le_wp_pure _ _ _ := PartialOrder.rel_refl
253253
bind_le_wp_bind x f := fun post epost => by cases x <;> exact id
254254

255255
/-- `EStateM ε σ`'s `WP` interpretation combining state and exceptions. -/
256-
@[instance_reducible] def EStateM.wpInst {α : Type} : WP (EStateM ε σ α) α (σ → Prop) (ε → σ → Prop) where
256+
instance EStateM.wpInst {α : Type} : WP (EStateM ε σ α) α (σ → Prop) (ε → σ → Prop) where
257257
wpTrans x := ⟨fun post epost s => match x s with
258258
| .ok a s' => post a s'
259259
| .error el s' => epost el s'⟩
@@ -266,7 +266,7 @@ instance Except.instWPMonad : WPMonad (Except ε) Prop (ε → Prop) where
266266

267267
/-- `EStateM ε σ` is a WPMonad combining state and exceptions. -/
268268
instance EStateM.instWPMonad : WPMonad (EStateM ε σ) (σ → Prop) (ε → σ → Prop) where
269-
toWP _ := EStateM.wpInst
269+
toWP _ := inferInstance
270270
pure_le_wp_pure x := fun post epost s => PartialOrder.rel_refl
271271
bind_le_wp_bind x f := fun post epost s => by
272272
simp only [WP.wp, WP.wpTrans, bind, EStateM.bind]

‎tests/elab/vcgenBespokeWPInstance.lean‎

Lines changed: 0 additions & 98 deletions
This file was deleted.

0 commit comments

Comments
 (0)