Skip to content

Commit 1744bf5

Browse files
authored
feat: improve processLevel at Sym/Pattern.lean (#13896)
This PR improves the support for universe constraints in the `SymM` pattern matcher/unifier. Two new cases are supported 1) `u + 1 =?= v` reduces to `u =?= v'` IF `some v' = decLevel? v` 2) `max u ?v =?= u` is solved using `?v := u`. The solution is an approximation. The same approximation is used at `LevelDefEq.lean`. We say it is an approximation because the solution `?v := 0` is ignored.
1 parent c743a57 commit 1744bf5

2 files changed

Lines changed: 71 additions & 2 deletions

File tree

src/Lean/Meta/Sym/Pattern.lean

Lines changed: 44 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -371,7 +371,40 @@ def substAssignedUVarsAndNormalize (u : Level) : UnifyM Level := do
371371
let v := substAssignedUVars assignment u
372372
return v.normalize
373373

374-
def processLevel (u : Level) (v : Level) : UnifyM Bool := do
374+
/--
375+
Returns true if `u` is `max v ?m` (or variant). That is, we solve `max v ?m =?= v` as `?m := v`.
376+
This is an approximation. For example, we ignore the solution `?m := 0`.
377+
378+
**Note**: The same approximation is used at LevelDefEq.lean
379+
-/
380+
private def tryApproxSelfMax (u v : Level) : UnifyM Bool := do
381+
match u with
382+
| .max (.param uName) v'
383+
| .max v' (.param uName) =>
384+
let some uidx := isUVar? uName | return false
385+
solve v' uidx
386+
| _ => return false
387+
where
388+
solve (v' : Level) (uidx : Nat) : UnifyM Bool := do
389+
if v == v' then
390+
assignLevel uidx v
391+
else
392+
return false
393+
394+
/-- Similar to `Meta.decLevel?`, but never assigns metavariables. -/
395+
partial def decLevel? : Level → Option Level
396+
| .zero | .mvar _ | .param _ => none
397+
| .succ u => some u
398+
| .max u v => processMax u v
399+
/- Remark: If `decLevel? v` returns `some ...`, then `imax u v` is equivalent to `max u v`. -/
400+
| .imax u v => processMax u v
401+
where
402+
processMax (u v : Level) : Option Level := do
403+
let u ← decLevel? u
404+
let v ← decLevel? v
405+
return mkLevelMax' u v
406+
407+
partial def processLevel (u : Level) (v : Level) : UnifyM Bool := do
375408
/-
376409
**Note**: If new uvars in `u` have been assigned, we continue replace them, and
377410
continue the search. The motivation for using `substAssignedUVarsAndNormalize` is
@@ -414,7 +447,16 @@ where
414447
return true
415448
else
416449
return false
417-
| _, _ => return false
450+
| _, _ =>
451+
if (← tryApproxSelfMax u v) then
452+
return true
453+
if let .succ u := u then
454+
if let some v := decLevel? v then
455+
return (← go u v)
456+
if let .succ v := v then
457+
if let some u := decLevel? u then
458+
return (← go u v)
459+
return false
418460

419461
def processLevels (us : List Level) (vs : List Level) : UnifyM Bool := do
420462
match us, vs with

tests/elab/sym_apply_bug.lean

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
inductive PlainRel {α : Sort u} (lhs rhs : α) : Prop where
2+
| intro
3+
4+
theorem plainFoo {σ : Sort u} (pre rhs : σ → Prop) : PlainRel pre rhs :=
5+
PlainRel.intro
6+
7+
theorem plainFoo' {σ : Type u} (pre rhs : σ → Prop) : PlainRel pre rhs :=
8+
PlainRel.intro
9+
10+
example (pre rhs : Nat → Prop) : PlainRel pre rhs := by
11+
sym => apply plainFoo
12+
13+
example (pre rhs : Nat → Prop) : PlainRel pre rhs := by
14+
sym => apply plainFoo'
15+
16+
theorem plainFoo'' {σ : Type u} {σ' : Type u} (pre rhs : σ → σ') : PlainRel pre rhs :=
17+
PlainRel.intro
18+
19+
theorem plainFoo''' {σ : Type u} {σ' : Type v} (pre rhs : σ → σ') : PlainRel pre rhs :=
20+
PlainRel.intro
21+
22+
set_option trace.Meta.debug true in
23+
example (pre rhs : Nat → Prop) : PlainRel pre rhs := by
24+
sym => apply plainFoo'''
25+
26+
example (pre rhs : Nat → Prop) : PlainRel pre rhs := by
27+
sym => apply plainFoo''

0 commit comments

Comments
 (0)