e2f5938e74
This PR extracts some refactorings from #10763, including dropping dead code and not failing in `inaccessibleAsCtor`, which leadas to (slightly) better error messages, and also on the grounds that the failing alternative may actually be unreachable.
172 lines
4.7 KiB
Text
172 lines
4.7 KiB
Text
import Lean
|
||
|
||
def checkWithMkMatcherInput (matcher : Lean.Name) : Lean.MetaM Unit :=
|
||
Lean.Meta.Match.withMkMatcherInput matcher fun input => do
|
||
let res ← Lean.Meta.Match.mkMatcher input
|
||
let origMatcher ← Lean.getConstInfo matcher
|
||
if not <| input.matcherName == matcher then
|
||
throwError "matcher name not reconstructed correctly: {matcher} ≟ {input.matcherName}"
|
||
|
||
let lCtx ← Lean.getLCtx
|
||
let fvars := Lean.collectFVars {} res.matcher
|
||
let closure := Lean.Meta.Closure.mkLambda (fvars.fvarSet.toList.toArray.map lCtx.get!) res.matcher
|
||
|
||
let origTy := origMatcher.value!
|
||
let newTy := closure
|
||
if not <| ←Lean.Meta.isDefEq origTy newTy then
|
||
throwError "matcher {matcher} does not round-trip correctly:\n{origTy} ≟ {newTy}"
|
||
|
||
set_option smartUnfolding false
|
||
|
||
def f (xs : List Nat) : List Bool :=
|
||
xs.map fun
|
||
| 0 => true
|
||
| _ => false
|
||
|
||
#guard_msgs in
|
||
#eval checkWithMkMatcherInput ``f.match_1
|
||
|
||
#guard f [1, 2, 0, 2] == [false, false, true, false]
|
||
|
||
theorem ex1 : f [1, 0, 2] = [false, true, false] :=
|
||
rfl
|
||
|
||
#check f
|
||
|
||
set_option pp.raw true
|
||
set_option pp.raw.maxDepth 10
|
||
set_option trace.Elab.step true in
|
||
def g (xs : List Nat) : List Bool :=
|
||
xs.map <| by {
|
||
intro
|
||
| 0 => exact true
|
||
| _ => exact false
|
||
}
|
||
|
||
theorem ex2 : g [1, 0, 2] = [false, true, false] :=
|
||
rfl
|
||
|
||
theorem ex3 {p q r : Prop} : p ∨ q → r → (q ∧ r) ∨ (p ∧ r) :=
|
||
by intro
|
||
| Or.inl hp, h => { apply Or.inr; apply And.intro; assumption; assumption }
|
||
| Or.inr hq, h => { apply Or.inl; exact ⟨hq, h⟩ }
|
||
|
||
inductive C
|
||
| mk₁ : Nat → C
|
||
| mk₂ : Nat → Nat → C
|
||
|
||
def C.x : C → Nat
|
||
| C.mk₁ x => x
|
||
| C.mk₂ x _ => x
|
||
#eval checkWithMkMatcherInput ``C.x.match_1
|
||
|
||
def head : {α : Type} → List α → Option α
|
||
| _, a::as => some a
|
||
| _, _ => none
|
||
#eval checkWithMkMatcherInput ``head.match_1
|
||
|
||
theorem ex4 : head [1, 2] = some 1 :=
|
||
rfl
|
||
|
||
def head2 : {α : Type} → List α → Option α :=
|
||
@fun
|
||
| _, a::as => some a
|
||
| _, _ => none
|
||
|
||
theorem ex5 : head2 [1, 2] = some 1 :=
|
||
rfl
|
||
|
||
def head3 {α : Type} (xs : List α) : Option α :=
|
||
let rec aux {α : Type} : List α → Option α
|
||
| a::_ => some a
|
||
| _ => none;
|
||
aux xs
|
||
|
||
theorem ex6 : head3 [1, 2] = some 1 :=
|
||
rfl
|
||
|
||
inductive Vec.{u} (α : Type u) : Nat → Type u
|
||
| nil : Vec α 0
|
||
| cons {n} (head : α) (tail : Vec α n) : Vec α (n+1)
|
||
|
||
def Vec.mapHead1 {α β δ} : {n : Nat} → Vec α n → Vec β n → (α → β → δ) → Option δ
|
||
| _, nil, nil, f => none
|
||
| _, cons a as, cons b bs, f => some (f a b)
|
||
|
||
|
||
def Vec.mapHead2 {α β δ} : {n : Nat} → Vec α n → Vec β n → (α → β → δ) → Option δ
|
||
| _, nil, nil, f => none
|
||
| _, @cons _ n a as, cons b bs, f => some (f a b)
|
||
set_option pp.match false in
|
||
#print Vec.mapHead2 -- reused Vec.mapHead1.match_1
|
||
|
||
def Vec.mapHead3 {α β δ} : {n : Nat} → Vec α n → Vec β n → (α → β → δ) → Option δ
|
||
| _, nil, nil, f => none
|
||
| _, cons (tail := as) (head := a), cons b bs, f => some (f a b)
|
||
|
||
inductive Foo
|
||
| mk₁ (x y z w : Nat)
|
||
| mk₂ (x y z w : Nat)
|
||
|
||
def Foo.z : Foo → Nat
|
||
| mk₁ (z := z) .. => z
|
||
| mk₂ (z := z) .. => z
|
||
|
||
#eval checkWithMkMatcherInput ``Foo.z.match_1
|
||
|
||
#guard (Foo.mk₁ 10 20 30 40).z == 30
|
||
|
||
theorem ex7 : (Foo.mk₁ 10 20 30 40).z = 30 :=
|
||
rfl
|
||
|
||
def Foo.addY? : Foo × Foo → Option Nat
|
||
| (mk₁ (y := y₁) .., mk₁ (y := y₂) ..) => some (y₁ + y₂)
|
||
| _ => none
|
||
|
||
#eval checkWithMkMatcherInput ``Foo.addY?.match_1
|
||
|
||
#guard Foo.addY? (Foo.mk₁ 1 2 3 4, Foo.mk₁ 10 20 30 40) == some 22
|
||
|
||
theorem ex8 : Foo.addY? (Foo.mk₁ 1 2 3 4, Foo.mk₁ 10 20 30 40) = some 22 :=
|
||
rfl
|
||
|
||
instance {α} : Inhabited (Sigma fun m => Vec α m) :=
|
||
⟨⟨0, Vec.nil⟩⟩
|
||
|
||
partial def filter {α} (p : α → Bool) : {n : Nat} → Vec α n → Sigma fun m => Vec α m
|
||
| _, Vec.nil => ⟨0, Vec.nil⟩
|
||
| _, Vec.cons x xs => match p x, filter p xs with
|
||
| true, ⟨_, ys⟩ => ⟨_, Vec.cons x ys⟩
|
||
| false, ys => ys
|
||
#eval checkWithMkMatcherInput ``filter.match_1
|
||
|
||
inductive Bla
|
||
| ofNat (x : Nat)
|
||
| ofBool (x : Bool)
|
||
|
||
def Bla.optional? : Bla → Option Nat
|
||
| ofNat x => some x
|
||
| ofBool _ => none
|
||
#eval checkWithMkMatcherInput ``Bla.optional?.match_1
|
||
|
||
def Bla.isNat? (b : Bla) : Option { x : Nat // optional? b = some x } :=
|
||
match b.optional? with
|
||
| some y => some ⟨y, rfl⟩
|
||
| none => none
|
||
#eval checkWithMkMatcherInput ``Bla.isNat?.match_1
|
||
|
||
def foo (b : Bla) : Option Nat := b.optional?
|
||
theorem fooEq (b : Bla) : foo b = b.optional? :=
|
||
rfl
|
||
|
||
def Bla.isNat2? (b : Bla) : Option { x : Nat // optional? b = some x } :=
|
||
match h : foo b with
|
||
| some y => some ⟨y, Eq.trans (fooEq b).symm h⟩
|
||
| none => none
|
||
#eval checkWithMkMatcherInput ``Bla.isNat2?.match_1
|
||
|
||
def foo2 (x : Nat) : Nat :=
|
||
match (motive := (y : Nat) → x = y → Nat) x, rfl with
|
||
| 0, h => 0
|
||
| x+1, h => 1
|
||
#eval checkWithMkMatcherInput ``foo2.match_1
|