feat: lift the restriction in congr theorems that all function arguments on the lhs must be free variables

see #988
This commit is contained in:
Leonardo de Moura 2022-02-02 18:23:18 -08:00
parent b7c853692d
commit c30380e2fa
2 changed files with 23 additions and 4 deletions

View file

@ -5,6 +5,7 @@ Authors: Leonardo de Moura
-/
import Lean.ScopedEnvExtension
import Lean.Util.Recognizers
import Lean.Util.CollectMVars
import Lean.Meta.Basic
namespace Lean.Meta
@ -54,10 +55,8 @@ def mkCongrLemma (declName : Name) (prio : Nat) : MetaM CongrLemma := withReduci
throwError "invalid 'congr' theorem, equality left/right-hand sides must be applications of the same function{indentExpr type}"
let mut foundMVars : MVarIdSet := {}
for lhsArg in lhsArgs do
unless lhsArg.isSort do
unless lhsArg.isMVar do
throwError "invalid 'congr' theorem, arguments in the left-hand-side must be variables or sorts{indentExpr lhs}"
foundMVars := foundMVars.insert lhsArg.mvarId!
for mvarId in (lhsArg.collectMVars {}).result do
foundMVars := foundMVars.insert mvarId
let mut i := 0
let mut hypothesesPos := #[]
for x in xs, bi in bis do

View file

@ -33,3 +33,23 @@ example (as : Array (Nat → Nat)) (h : 0 + x < as.size) :
rfl
example [Decidable p] : decide (p ∧ True) = decide p := by simp -- should work
def Pi.single [DecidableEq ι] {f : ι → Type u} [∀ i, Inhabited (f i)] (i : ι) (x : f i) : ∀ i, f i :=
fun j => if h : j = i then h ▸ x else default
structure Set (α : Type u) where of :: mem : α → Prop
instance : CoeSort (Set α) (Type u) where coe s := Subtype s.mem
@[congr]
theorem dep_congr [DecidableEq ι] {p : ι → Set α} [∀ i, Inhabited (p i)] :
∀ {i j} (h : i = j) (x : p i) (y : α) (hx : x = y), Pi.single (f := (p ·)) i x = Pi.single (f := (p ·)) j ⟨y, hx ▸ h ▸ x.2⟩
| _, _, rfl, _, _, rfl => rfl
theorem aux {p : Nat → Set Nat} {i j y : Nat} (x : p j) (h₁ : x = y) (h₂ : i = j) : Set.mem (p i) y := by
have := x.2
subst h₁ h₂
assumption
example {p : Nat → Set Nat} [∀ i, Inhabited (p i)] (i : Nat) (x : p (0 + i)) (y : Nat) : Pi.single (f := (p ·)) (0 + i) x = Pi.single (f := (p ·)) i ⟨x, aux x rfl (Nat.zero_add i).symm ⟩ := by
simp