Compare commits

..

2 Commits

Author SHA1 Message Date
Kim Morrison
135872c136 slightly unhappy change to test 2024-10-21 16:42:37 +11:00
Kim Morrison
8dd2aa529a chore: Array cleanup
.

.

.
2024-10-21 13:41:03 +11:00
34 changed files with 124 additions and 677 deletions

View File

@@ -35,4 +35,3 @@ import Init.Ext
import Init.Omega
import Init.MacroTrace
import Init.Grind
import Init.While

View File

@@ -80,26 +80,6 @@ theorem ext' {as bs : Array α} (h : as.toList = bs.toList) : as = bs := by
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
@[simp] theorem getElem_toList {a : Array α} {i : Nat} (h : i < a.size) : a.toList[i] = a[i] := rfl
end Array
namespace List
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[simp] theorem getElem_toArray {a : List α} {i : Nat} (h : i < a.toArray.size) :
a.toArray[i] = a[i]'(by simpa using h) := rfl
@[simp] theorem getElem?_toArray {a : List α} {i : Nat} : a.toArray[i]? = a[i]? := rfl
@[simp] theorem getElem!_toArray [Inhabited α] {a : List α} {i : Nat} :
a.toArray[i]! = a[i]! := rfl
end List
namespace Array
@[deprecated toList_toArray (since := "2024-09-09")] abbrev data_toArray := @toList_toArray
@[deprecated Array.toList (since := "2024-09-10")] abbrev Array.data := @Array.toList
@@ -418,25 +398,20 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
decreasing_by simp_wf; decreasing_trivial_pre_omega
map 0 (mkEmpty as.size)
/-- Variant of `mapIdxM` which receives the index as a `Fin as.size`. -/
@[inline]
def mapFinIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m]
(as : Array α) (f : Fin as.size α m β) : m (Array β) :=
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : Fin as.size α m β) : m (Array β) :=
let rec @[specialize] map (i : Nat) (j : Nat) (inv : i + j = as.size) (bs : Array β) : m (Array β) := do
match i, inv with
| 0, _ => pure bs
| i+1, inv =>
have j_lt : j < as.size := by
have : j < as.size := by
rw [ inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_comm]
apply Nat.le_add_right
let idx : Fin as.size := j, this
have : i + (j + 1) = as.size := by rw [ inv, Nat.add_comm j 1, Nat.add_assoc]
map i (j+1) this (bs.push ( f j, j_lt (as.get j, j_lt)))
map i (j+1) this (bs.push ( f idx (as.get idx)))
map as.size 0 rfl (mkEmpty as.size)
@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : Nat α m β) : m (Array β) :=
as.mapFinIdxM fun i a => f i a
@[inline]
def findSomeM? {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : α m (Option β)) : m (Option β) := do
for a in as do
@@ -542,13 +517,8 @@ def foldr {α : Type u} {β : Type v} (f : α → β → β) (init : β) (as : A
def map {α : Type u} {β : Type v} (f : α β) (as : Array α) : Array β :=
Id.run <| as.mapM f
/-- Variant of `mapIdx` which receives the index as a `Fin as.size`. -/
@[inline]
def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size α β) : Array β :=
Id.run <| as.mapFinIdxM f
@[inline]
def mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Nat α β) : Array β :=
def mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size α β) : Array β :=
Id.run <| as.mapIdxM f
/-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/

View File

@@ -42,7 +42,7 @@ theorem foldrM_eq_reverse_foldlM_toList.aux [Monad m]
unfold foldrM.fold
match i with
| 0 => simp [List.foldlM, List.take]
| i+1 => rw [ List.take_concat_get _ _ h]; simp [ (aux f arr · i)]
| i+1 => rw [ List.take_concat_get _ _ h]; simp [ (aux f arr · i)]; rfl
theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.toList.reverse.foldlM (fun x y => f y x) init := by

View File

@@ -6,8 +6,6 @@ Authors: Leonardo de Moura
prelude
import Init.Data.Array.Basic
import Init.Data.BEq
import Init.Data.Nat.Lemmas
import Init.Data.List.Nat.BEq
import Init.ByCases
namespace Array
@@ -28,14 +26,6 @@ theorem rel_of_isEqvAux
subst hj'
exact heqv.left
theorem isEqvAux_of_rel (r : α α Bool) (a b : Array α) (hsz : a.size = b.size) (i : Nat) (hi : i a.size)
(w : j, (hj : j < i) r (a[j]'(Nat.lt_of_lt_of_le hj hi)) (b[j]'(Nat.lt_of_lt_of_le hj (hsz hi)))) : Array.isEqvAux a b hsz r i hi := by
induction i with
| zero => simp [Array.isEqvAux]
| succ i ih =>
simp only [isEqvAux, Bool.and_eq_true]
exact w i (Nat.lt_add_one i), ih _ fun j hj => w j (Nat.lt_add_right 1 hj)
theorem rel_of_isEqv (r : α α Bool) (a b : Array α) :
Array.isEqv a b r h : a.size = b.size, (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h')) := by
simp only [isEqv]
@@ -43,29 +33,6 @@ theorem rel_of_isEqv (r : αα → Bool) (a b : Array α) :
· exact fun h' => h, rel_of_isEqvAux r a b h a.size (Nat.le_refl ..) h'
· intro; contradiction
theorem isEqv_iff_rel (a b : Array α) (r) :
Array.isEqv a b r h : a.size = b.size, (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h')) :=
rel_of_isEqv r a b, fun h, w => by
simp only [isEqv, h, reduceDIte]
exact isEqvAux_of_rel r a b h a.size (by simp [h]) w
theorem isEqv_eq_decide (a b : Array α) (r) :
Array.isEqv a b r =
if h : a.size = b.size then decide ( (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h'))) else false := by
by_cases h : Array.isEqv a b r
· simp only [h, Bool.true_eq]
simp only [isEqv_iff_rel] at h
obtain h, w := h
simp [h, w]
· let h' := h
simp only [Bool.not_eq_true] at h
simp only [h, Bool.false_eq, dite_eq_right_iff, decide_eq_false_iff_not, Classical.not_forall,
Bool.not_eq_true]
simpa [isEqv_iff_rel] using h'
@[simp] theorem isEqv_toList [BEq α] (a b : Array α) : (a.toList.isEqv b.toList r) = (a.isEqv b r) := by
simp [isEqv_eq_decide, List.isEqv_eq_decide]
theorem eq_of_isEqv [DecidableEq α] (a b : Array α) (h : Array.isEqv a b (fun x y => x = y)) : a = b := by
have h, h' := rel_of_isEqv (fun x y => x = y) a b h
exact ext _ _ h (fun i lt _ => by simpa using h' i lt)
@@ -89,22 +56,4 @@ instance [DecidableEq α] : DecidableEq (Array α) :=
| true => isTrue (eq_of_isEqv a b h)
| false => isFalse fun h' => by subst h'; rw [isEqv_self] at h; contradiction
theorem beq_eq_decide [BEq α] (a b : Array α) :
(a == b) = if h : a.size = b.size then
decide ( (i : Nat) (h' : i < a.size), a[i] == b[i]'(h h')) else false := by
simp [BEq.beq, isEqv_eq_decide]
@[simp] theorem beq_toList [BEq α] (a b : Array α) : (a.toList == b.toList) = (a == b) := by
simp [beq_eq_decide, List.beq_eq_decide]
end Array
namespace List
@[simp] theorem isEqv_toArray [BEq α] (a b : List α) : (a.toArray.isEqv b.toArray r) = (a.isEqv b r) := by
simp [isEqv_eq_decide, Array.isEqv_eq_decide]
@[simp] theorem beq_toArray [BEq α] (a b : List α) : (a.toArray == b.toArray) = (a == b) := by
simp [beq_eq_decide, Array.beq_eq_decide]
end List

View File

@@ -41,6 +41,6 @@ where
getLit_eq (as : Array α) (i : Nat) (h₁ : as.size = n) (h₂ : i < n) : as.getLit i h₁ h₂ = getElem as.toList i ((id (α := as.toList.length = n) h₁) h₂) :=
rfl
go (i : Nat) (hi : i as.size) : toListLitAux as n hsz i hi (as.toList.drop i) = as.toList := by
induction i <;> simp only [List.drop, toListLitAux, getLit_eq, List.get_drop_eq_drop, *]
induction i <;> simp [getLit_eq, List.get_drop_eq_drop, toListLitAux, List.drop, *]
end Array

View File

@@ -9,7 +9,6 @@ import Init.Data.List.Impl
import Init.Data.List.Monadic
import Init.Data.List.Range
import Init.Data.List.Nat.TakeDrop
import Init.Data.List.Nat.Modify
import Init.Data.Array.Mem
import Init.TacticsExtra
@@ -19,6 +18,8 @@ import Init.TacticsExtra
namespace Array
@[simp] theorem getElem_toList {a : Array α} {i : Nat} (h : i < a.size) : a.toList[i] = a[i] := rfl
@[simp] theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : (Array.mk xs)[i] = xs[i] := rfl
theorem getElem_eq_getElem_toList {a : Array α} (h : i < a.size) : a[i] = a.toList[i] := by
@@ -85,6 +86,16 @@ We prefer to pull `List.toArray` outwards.
(a.toArrayAux b).size = b.size + a.length := by
simp [size]
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[simp] theorem getElem_toArray {a : List α} {i : Nat} (h : i < a.toArray.size) :
a.toArray[i] = a[i]'(by simpa using h) := rfl
@[simp] theorem getElem?_toArray {a : List α} {i : Nat} : a.toArray[i]? = a[i]? := rfl
@[simp] theorem getElem!_toArray [Inhabited α] {a : List α} {i : Nat} :
a.toArray[i]! = a[i]! := rfl
@[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
apply ext'
simp
@@ -159,9 +170,6 @@ namespace Array
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
-- This is a duplicate of `List.toArray_toList`.
-- It's confusing to guess which namespace this theorem should live in,
-- so we provide both.
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
@@ -852,12 +860,6 @@ theorem getElem_modify {as : Array α} {x i} (h : i < (as.modify x f).size) :
· simp only [Id.bind_eq, get_set _ _ _ (by simpa using h)]; split <;> simp [*]
· rw [if_neg (mt (by rintro rfl; exact h) (by simp_all))]
@[simp] theorem toList_modify (as : Array α) (f : α α) :
(as.modify x f).toList = as.toList.modify f x := by
apply List.ext_getElem
· simp
· simp [getElem_modify, List.getElem_modify]
theorem getElem_modify_self {as : Array α} {i : Nat} (f : α α) (h : i < (as.modify i f).size) :
(as.modify i f)[i] = f (as[i]'(by simpa using h)) := by
simp [getElem_modify h]
@@ -1440,11 +1442,6 @@ theorem all_toArray (p : α → Bool) (l : List α) : l.toArray.all p = l.all p
apply ext'
simp
@[simp] theorem modify_toArray (f : α α) (l : List α) :
l.toArray.modify i f = (l.modify f i).toArray := by
apply ext'
simp
@[simp] theorem filter_toArray' (p : α Bool) (l : List α) (h : stop = l.toArray.size) :
l.toArray.filter p 0 stop = (l.filter p).toArray := by
subst h

View File

@@ -9,19 +9,20 @@ import Init.Data.List.MapIdx
namespace Array
/-! ### mapFinIdx -/
/-! ### mapIdx -/
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
theorem mapFinIdx_induction (as : Array α) (f : Fin as.size α β)
theorem mapIdx_induction (as : Array α) (f : Fin as.size α β)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
motive as.size eq : (Array.mapFinIdx as f).size = as.size,
i h, p i, h ((Array.mapFinIdx as f)[i]) := by
motive as.size eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) := by
let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : i h h', p i, h bs[i]) (hm : motive j) :
let arr : Array β := Array.mapFinIdxM.map (m := Id) as f i j h bs
let arr : Array β := Array.mapIdxM.map (m := Id) as f i j h bs
motive as.size eq : arr.size = as.size, i h, p i, h arr[i] := by
induction i generalizing j bs with simp [mapFinIdxM.map]
induction i generalizing j bs with simp [mapIdxM.map]
| zero =>
have := (Nat.zero_add _).symm.trans h
exact this hm, h₁ this, fun _ _ => h₂ ..
@@ -35,58 +36,29 @@ theorem mapFinIdx_induction (as : Array α) (f : Fin as.size → α → β)
obtain rfl : i = j := by omega
apply (hs i, by omega hm).1
· exact (hs j, by omega hm).2
simp [mapFinIdx, mapFinIdxM]; exact go rfl nofun h0
simp [mapIdx, mapIdxM]; exact go rfl nofun h0
theorem mapFinIdx_spec (as : Array α) (f : Fin as.size α β)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
eq : (Array.mapFinIdx as f).size = as.size,
i h, p i, h ((Array.mapFinIdx as f)[i]) :=
(mapFinIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
@[simp] theorem size_mapFinIdx (a : Array α) (f : Fin a.size α β) : (a.mapFinIdx f).size = a.size :=
(mapFinIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
Array.size_mapFinIdx _ _
@[simp] theorem getElem_mapFinIdx (a : Array α) (f : Fin a.size α β) (i : Nat)
(h : i < (mapFinIdx a f).size) :
(a.mapFinIdx f)[i] = f i, by simp_all (a[i]'(by simp_all)) :=
(mapFinIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i _
@[simp] theorem getElem?_mapFinIdx (a : Array α) (f : Fin a.size α β) (i : Nat) :
(a.mapFinIdx f)[i]? =
a[i]?.pbind fun b h => f i, (getElem?_eq_some_iff.1 h).1 b := by
simp only [getElem?_def, size_mapFinIdx, getElem_mapFinIdx]
split <;> simp_all
/-! ### mapIdx -/
theorem mapIdx_induction (as : Array α) (f : Nat α β)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
motive as.size eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) :=
mapFinIdx_induction as (fun i a => f i a) motive h0 p hs
theorem mapIdx_spec (as : Array α) (f : Nat α β)
theorem mapIdx_spec (as : Array α) (f : Fin as.size α β)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) :=
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
@[simp] theorem size_mapIdx (a : Array α) (f : Nat α β) : (a.mapIdx f).size = a.size :=
@[simp] theorem size_mapIdx (a : Array α) (f : Fin a.size α β) : (a.mapIdx f).size = a.size :=
(mapIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem getElem_mapIdx (a : Array α) (f : Nat α β) (i : Nat)
(h : i < (mapIdx a f).size) :
(a.mapIdx f)[i] = f i (a[i]'(by simp_all)) :=
(mapIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i (by simp_all)
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
Array.size_mapIdx _ _
@[simp] theorem getElem?_mapIdx (a : Array α) (f : Nat α β) (i : Nat) :
@[simp] theorem getElem_mapIdx (a : Array α) (f : Fin a.size α β) (i : Nat)
(h : i < (mapIdx a f).size) :
(a.mapIdx f)[i] = f i, by simp_all (a[i]'(by simp_all)) :=
(mapIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i _
@[simp] theorem getElem?_mapIdx (a : Array α) (f : Fin a.size α β) (i : Nat) :
(a.mapIdx f)[i]? =
a[i]?.map (f i) := by
simp [getElem?_def, size_mapIdx, getElem_mapIdx]
a[i]?.pbind fun b h => f i, (getElem?_eq_some_iff.1 h).1 b := by
simp only [getElem?_def, size_mapIdx, getElem_mapIdx]
split <;> simp_all
end Array

View File

@@ -316,12 +316,6 @@ theorem getLsbD_ofNat (n : Nat) (x : Nat) (i : Nat) :
simp [Nat.sub_sub_eq_min, Nat.min_eq_right]
omega
@[simp] theorem sub_add_bmod_cancel {x y : BitVec w} :
((((2 ^ w : Nat) - y.toNat) : Int) + x.toNat).bmod (2 ^ w) =
((x.toNat : Int) - y.toNat).bmod (2 ^ w) := by
rw [Int.sub_eq_add_neg, Int.add_assoc, Int.add_comm, Int.bmod_add_cancel, Int.add_comm,
Int.sub_eq_add_neg]
private theorem lt_two_pow_of_le {x m n : Nat} (lt : x < 2 ^ m) (le : m n) : x < 2 ^ n :=
Nat.lt_of_lt_of_le lt (Nat.pow_le_pow_of_le_right (by trivial : 0 < 2) le)
@@ -1980,10 +1974,6 @@ theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n ((2^n - y.toNat) + x.toN
@[simp] theorem toNat_sub {n} (x y : BitVec n) :
(x - y).toNat = (((2^n - y.toNat) + x.toNat) % 2^n) := rfl
@[simp, bv_toNat] theorem toInt_sub {x y : BitVec w} :
(x - y).toInt = (x.toInt - y.toInt).bmod (2 ^ w) := by
simp [toInt_eq_toNat_bmod, @Int.ofNat_sub y.toNat (2 ^ w) (by omega)]
-- We prefer this lemma to `toNat_sub` for the `bv_toNat` simp set.
-- For reasons we don't yet understand, unfolding via `toNat_sub` sometimes
-- results in `omega` generating proof terms that are very slow in the kernel.
@@ -2006,8 +1996,6 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
@[simp] protected theorem sub_zero (x : BitVec n) : x - 0#n = x := by apply eq_of_toNat_eq ; simp
@[simp] protected theorem zero_sub (x : BitVec n) : 0#n - x = -x := rfl
@[simp] protected theorem sub_self (x : BitVec n) : x - x = 0#n := by
apply eq_of_toNat_eq
simp only [toNat_sub]
@@ -2020,8 +2008,18 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
theorem toInt_neg {x : BitVec w} :
(-x).toInt = (-x.toInt).bmod (2 ^ w) := by
rw [ BitVec.zero_sub, toInt_sub]
simp [BitVec.toInt_ofNat]
simp only [toInt_eq_toNat_bmod, toNat_neg, Int.ofNat_emod, Int.emod_bmod_congr]
rw [ Int.subNatNat_of_le (by omega), Int.subNatNat_eq_coe, Int.sub_eq_add_neg, Int.add_comm,
Int.bmod_add_cancel]
by_cases h : x.toNat < ((2 ^ w) + 1) / 2
· rw [Int.bmod_pos (x := x.toNat)]
all_goals simp only [toNat_mod_cancel']
norm_cast
· rw [Int.bmod_neg (x := x.toNat)]
· simp only [toNat_mod_cancel']
rw_mod_cast [Int.neg_sub, Int.sub_eq_add_neg, Int.add_comm, Int.bmod_add_cancel]
· norm_cast
simp_all
@[simp] theorem toFin_neg (x : BitVec n) :
(-x).toFin = Fin.ofNat' (2^n) (2^n - x.toNat) :=

View File

@@ -1125,17 +1125,6 @@ theorem emod_add_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n + y) n = Int.bmo
simp [Int.emod_def, Int.sub_eq_add_neg]
rw [Int.mul_neg, Int.add_right_comm, Int.bmod_add_mul_cancel]
@[simp]
theorem emod_sub_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n - y) n = Int.bmod (x - y) n := by
simp only [emod_def, Int.sub_eq_add_neg]
rw [Int.mul_neg, Int.add_right_comm, Int.bmod_add_mul_cancel]
@[simp]
theorem sub_emod_bmod_congr (x : Int) (n : Nat) : Int.bmod (x - y%n) n = Int.bmod (x - y) n := by
simp only [emod_def]
rw [Int.sub_eq_add_neg, Int.neg_sub, Int.sub_eq_add_neg, Int.add_assoc, Int.add_right_comm,
Int.bmod_add_mul_cancel, Int.sub_eq_add_neg]
@[simp]
theorem emod_mul_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n * y) n = Int.bmod (x * y) n := by
simp [Int.emod_def, Int.sub_eq_add_neg]
@@ -1151,28 +1140,9 @@ theorem bmod_add_bmod_congr : Int.bmod (Int.bmod x n + y) n = Int.bmod (x + y) n
rw [Int.sub_eq_add_neg, Int.add_right_comm, Int.sub_eq_add_neg]
simp
@[simp]
theorem bmod_sub_bmod_congr : Int.bmod (Int.bmod x n - y) n = Int.bmod (x - y) n := by
rw [Int.bmod_def x n]
split
next p =>
simp only [emod_sub_bmod_congr]
next p =>
rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_right_comm, Int.sub_eq_add_neg, Int.sub_eq_add_neg]
simp [emod_sub_bmod_congr]
@[simp] theorem add_bmod_bmod : Int.bmod (x + Int.bmod y n) n = Int.bmod (x + y) n := by
rw [Int.add_comm x, Int.bmod_add_bmod_congr, Int.add_comm y]
@[simp] theorem sub_bmod_bmod : Int.bmod (x - Int.bmod y n) n = Int.bmod (x - y) n := by
rw [Int.bmod_def y n]
split
next p =>
simp [sub_emod_bmod_congr]
next p =>
rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.neg_add, Int.neg_neg, Int.add_assoc, Int.sub_eq_add_neg]
simp [sub_emod_bmod_congr]
@[simp]
theorem bmod_mul_bmod : Int.bmod (Int.bmod x n * y) n = Int.bmod (x * y) n := by
rw [bmod_def x n]

View File

@@ -38,7 +38,7 @@ The operations are organized as follow:
* Sublists: `take`, `drop`, `takeWhile`, `dropWhile`, `partition`, `dropLast`,
`isPrefixOf`, `isPrefixOf?`, `isSuffixOf`, `isSuffixOf?`, `Subset`, `Sublist`,
`rotateLeft` and `rotateRight`.
* Manipulating elements: `replace`, `insert`, `modify`, `erase`, `eraseP`, `eraseIdx`.
* Manipulating elements: `replace`, `insert`, `erase`, `eraseP`, `eraseIdx`.
* Finding elements: `find?`, `findSome?`, `findIdx`, `indexOf`, `findIdx?`, `indexOf?`,
`countP`, `count`, and `lookup`.
* Logic: `any`, `all`, `or`, and `and`.
@@ -122,11 +122,6 @@ protected def beq [BEq α] : List α → List α → Bool
| a::as, b::bs => a == b && List.beq as bs
| _, _ => false
@[simp] theorem beq_nil_nil [BEq α] : List.beq ([] : List α) ([] : List α) = true := rfl
@[simp] theorem beq_cons_nil [BEq α] (a : α) (as : List α) : List.beq (a::as) [] = false := rfl
@[simp] theorem beq_nil_cons [BEq α] (a : α) (as : List α) : List.beq [] (a::as) = false := rfl
theorem beq_cons₂ [BEq α] (a b : α) (as bs : List α) : List.beq (a::as) (b::bs) = (a == b && List.beq as bs) := rfl
instance [BEq α] : BEq (List α) := List.beq
instance [BEq α] [LawfulBEq α] : LawfulBEq (List α) where
@@ -1119,35 +1114,6 @@ theorem replace_cons [BEq α] {a : α} :
@[inline] protected def insert [BEq α] (a : α) (l : List α) : List α :=
if l.elem a then l else a :: l
/-! ### modify -/
/--
Apply a function to the nth tail of `l`. Returns the input without
using `f` if the index is larger than the length of the List.
```
modifyTailIdx f 2 [a, b, c] = [a, b] ++ f [c]
```
-/
@[simp] def modifyTailIdx (f : List α List α) : Nat List α List α
| 0, l => f l
| _+1, [] => []
| n+1, a :: l => a :: modifyTailIdx f n l
/-- Apply `f` to the head of the list, if it exists. -/
@[inline] def modifyHead (f : α α) : List α List α
| [] => []
| a :: l => f a :: l
@[simp] theorem modifyHead_nil (f : α α) : [].modifyHead f = [] := by rw [modifyHead]
@[simp] theorem modifyHead_cons (a : α) (l : List α) (f : α α) :
(a :: l).modifyHead f = f a :: l := by rw [modifyHead]
/--
Apply `f` to the nth element of the list, if it exists, replacing that element with the result.
-/
def modify (f : α α) : Nat List α List α :=
modifyTailIdx (modifyHead f)
/-! ### erase -/
/--

View File

@@ -38,7 +38,7 @@ The following operations were already given `@[csimp]` replacements in `Init/Dat
The following operations are given `@[csimp]` replacements below:
`set`, `filterMap`, `foldr`, `append`, `bind`, `join`,
`take`, `takeWhile`, `dropLast`, `replace`, `modify`, `erase`, `eraseIdx`, `zipWith`,
`take`, `takeWhile`, `dropLast`, `replace`, `erase`, `eraseIdx`, `zipWith`,
`enumFrom`, and `intercalate`.
-/
@@ -197,24 +197,6 @@ The following operations are given `@[csimp]` replacements below:
· simp [*]
· intro h; rw [IH] <;> simp_all
/-! ### modify -/
/-- Tail-recursive version of `modify`. -/
def modifyTR (f : α α) (n : Nat) (l : List α) : List α := go l n #[] where
/-- Auxiliary for `modifyTR`: `modifyTR.go f l n acc = acc.toList ++ modify f n l`. -/
go : List α Nat Array α List α
| [], _, acc => acc.toList
| a :: l, 0, acc => acc.toListAppend (f a :: l)
| a :: l, n+1, acc => go l n (acc.push a)
theorem modifyTR_go_eq : l n, modifyTR.go f l n acc = acc.toList ++ modify f n l
| [], n => by cases n <;> simp [modifyTR.go, modify]
| a :: l, 0 => by simp [modifyTR.go, modify]
| a :: l, n+1 => by simp [modifyTR.go, modify, modifyTR_go_eq l]
@[csimp] theorem modify_eq_modifyTR : @modify = @modifyTR := by
funext α f n l; simp [modifyTR, modifyTR_go_eq]
/-! ### erase -/
/-- Tail recursive version of `List.erase`. -/

View File

@@ -12,5 +12,3 @@ import Init.Data.List.Nat.TakeDrop
import Init.Data.List.Nat.Count
import Init.Data.List.Nat.Erase
import Init.Data.List.Nat.Find
import Init.Data.List.Nat.BEq
import Init.Data.List.Nat.Modify

View File

@@ -1,47 +0,0 @@
/-
Copyright (c) 2024 Lean FRO All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Nat.Lemmas
import Init.Data.List.Basic
namespace List
/-! ### isEqv-/
theorem isEqv_eq_decide (a b : List α) (r) :
isEqv a b r = if h : a.length = b.length then
decide ( (i : Nat) (h' : i < a.length), r (a[i]'(h h')) (b[i]'(h h'))) else false := by
induction a generalizing b with
| nil =>
cases b <;> simp
| cons a as ih =>
cases b with
| nil => simp
| cons b bs =>
simp only [isEqv, ih, length_cons, Nat.add_right_cancel_iff]
split <;> simp [Nat.forall_lt_succ_left']
/-! ### beq -/
theorem beq_eq_isEqv [BEq α] (a b : List α) : a.beq b = isEqv a b (· == ·) := by
induction a generalizing b with
| nil =>
cases b <;> simp
| cons a as ih =>
cases b with
| nil => simp
| cons b bs =>
simp only [beq_cons₂, ih, isEqv_eq_decide, length_cons, Nat.add_right_cancel_iff,
Nat.forall_lt_succ_left', getElem_cons_zero, getElem_cons_succ, Bool.decide_and,
Bool.decide_eq_true]
split <;> simp
theorem beq_eq_decide [BEq α] (a b : List α) :
(a == b) = if h : a.length = b.length then
decide ( (i : Nat) (h' : i < a.length), a[i] == b[i]'(h h')) else false := by
simp [BEq.beq, beq_eq_isEqv, isEqv_eq_decide]
end List

View File

@@ -1,102 +0,0 @@
/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/
prelude
import Init.Data.List.Nat.TakeDrop
namespace List
/-! ### modifyHead -/
@[simp] theorem modifyHead_modifyHead (l : List α) (f g : α α) :
(l.modifyHead f).modifyHead g = l.modifyHead (g f) := by cases l <;> simp [modifyHead]
/-! ### modify -/
@[simp] theorem modify_nil (f : α α) (n) : [].modify f n = [] := by cases n <;> rfl
@[simp] theorem modify_zero_cons (f : α α) (a : α) (l : List α) :
(a :: l).modify f 0 = f a :: l := rfl
@[simp] theorem modify_succ_cons (f : α α) (a : α) (l : List α) (n) :
(a :: l).modify f (n + 1) = a :: l.modify f n := by rfl
theorem modifyTailIdx_id : n (l : List α), l.modifyTailIdx id n = l
| 0, _ => rfl
| _+1, [] => rfl
| n+1, a :: l => congrArg (cons a) (modifyTailIdx_id n l)
theorem eraseIdx_eq_modifyTailIdx : n (l : List α), eraseIdx l n = modifyTailIdx tail n l
| 0, l => by cases l <;> rfl
| _+1, [] => rfl
| _+1, _ :: _ => congrArg (cons _) (eraseIdx_eq_modifyTailIdx _ _)
theorem getElem?_modify (f : α α) :
n (l : List α) m, (modify f n l)[m]? = (fun a => if n = m then f a else a) <$> l[m]?
| n, l, 0 => by cases l <;> cases n <;> simp
| n, [], _+1 => by cases n <;> rfl
| 0, _ :: l, m+1 => by cases h : l[m]? <;> simp [h, modify, m.succ_ne_zero.symm]
| n+1, a :: l, m+1 => by
simp only [modify_succ_cons, getElem?_cons_succ, Nat.reduceEqDiff, Option.map_eq_map]
refine (getElem?_modify f n l m).trans ?_
cases h' : l[m]? <;> by_cases h : n = m <;>
simp [h, if_pos, if_neg, Option.map, mt Nat.succ.inj, not_false_iff, h']
@[simp] theorem length_modifyTailIdx (f : List α List α) (H : l, length (f l) = length l) :
n l, length (modifyTailIdx f n l) = length l
| 0, _ => H _
| _+1, [] => rfl
| _+1, _ :: _ => congrArg (·+1) (length_modifyTailIdx _ H _ _)
theorem modifyTailIdx_add (f : List α List α) (n) (l₁ l₂ : List α) :
modifyTailIdx f (l₁.length + n) (l₁ ++ l₂) = l₁ ++ modifyTailIdx f n l₂ := by
induction l₁ <;> simp [*, Nat.succ_add]
@[simp] theorem length_modify (f : α α) : n l, length (modify f n l) = length l :=
length_modifyTailIdx _ fun l => by cases l <;> rfl
@[simp] theorem getElem?_modify_eq (f : α α) (n) (l : List α) :
(modify f n l)[n]? = f <$> l[n]? := by
simp only [getElem?_modify, if_pos]
@[simp] theorem getElem?_modify_ne (f : α α) {m n} (l : List α) (h : m n) :
(modify f m l)[n]? = l[n]? := by
simp only [getElem?_modify, if_neg h, id_map']
theorem getElem_modify (f : α α) (n) (l : List α) (m) (h : m < (modify f n l).length) :
(modify f n l)[m] =
if n = m then f (l[m]'(by simp at h; omega)) else l[m]'(by simp at h; omega) := by
rw [getElem_eq_iff, getElem?_modify]
simp at h
simp [h]
theorem modifyTailIdx_eq_take_drop (f : List α List α) (H : f [] = []) :
n l, modifyTailIdx f n l = take n l ++ f (drop n l)
| 0, _ => rfl
| _ + 1, [] => H.symm
| n + 1, b :: l => congrArg (cons b) (modifyTailIdx_eq_take_drop f H n l)
theorem modify_eq_take_drop (f : α α) :
n l, modify f n l = take n l ++ modifyHead f (drop n l) :=
modifyTailIdx_eq_take_drop _ rfl
theorem modify_eq_take_cons_drop (f : α α) {n l} (h : n < length l) :
modify f n l = take n l ++ f l[n] :: drop (n + 1) l := by
rw [modify_eq_take_drop, drop_eq_getElem_cons h]; rfl
theorem exists_of_modifyTailIdx (f : List α List α) {n} {l : List α} (h : n l.length) :
l₁ l₂, l = l₁ ++ l₂ l₁.length = n modifyTailIdx f n l = l₁ ++ f l₂ :=
have _, _, eq, hl : l₁ l₂, l = l₁ ++ l₂ l₁.length = n :=
_, _, (take_append_drop n l).symm, length_take_of_le h
_, _, eq, hl, hl eq modifyTailIdx_add (n := 0) ..
theorem exists_of_modify (f : α α) {n} {l : List α} (h : n < l.length) :
l₁ a l₂, l = l₁ ++ a :: l₂ l₁.length = n modify f n l = l₁ ++ f a :: l₂ :=
match exists_of_modifyTailIdx _ (Nat.le_of_lt h) with
| _, _::_, eq, hl, H => _, _, _, eq, hl, H
| _, [], eq, hl, _ => nomatch Nat.ne_of_gt h (eq append_nil _ hl)
end List

View File

@@ -32,77 +32,6 @@ namespace Nat
@[simp] theorem exists_add_one_eq : ( n, n + 1 = a) 0 < a :=
fun n, h => by omega, fun h => a - 1, by omega
/-- Dependent variant of `forall_lt_succ_right`. -/
theorem forall_lt_succ_right' {p : (m : Nat) (m < n + 1) Prop} :
( m (h : m < n + 1), p m h) ( m (h : m < n), p m (by omega)) p n (by omega) := by
simp only [Nat.lt_succ_iff, Nat.le_iff_lt_or_eq]
constructor
· intro w
constructor
· intro m h
exact w _ (.inl h)
· exact w _ (.inr rfl)
· rintro w m (h|rfl)
· exact w.1 _ h
· exact w.2
/-- See `forall_lt_succ_right'` for a variant where `p` takes the bound as an argument. -/
theorem forall_lt_succ_right {p : Nat Prop} :
( m, m < n + 1 p m) ( m, m < n p m) p n := by
simpa using forall_lt_succ_right' (p := fun m _ => p m)
/-- Dependent variant of `forall_lt_succ_left`. -/
theorem forall_lt_succ_left' {p : (m : Nat) (m < n + 1) Prop} :
( m (h : m < n + 1), p m h) p 0 (by omega) ( m (h : m < n), p (m + 1) (by omega)) := by
constructor
· intro w
constructor
· exact w 0 (by omega)
· intro m h
exact w (m + 1) (by omega)
· rintro h₀, h₁ m h
cases m with
| zero => exact h₀
| succ m => exact h₁ m (by omega)
/-- See `forall_lt_succ_left'` for a variant where `p` takes the bound as an argument. -/
theorem forall_lt_succ_left {p : Nat Prop} :
( m, m < n + 1 p m) p 0 ( m, m < n p (m + 1)) := by
simpa using forall_lt_succ_left' (p := fun m _ => p m)
/-- Dependent variant of `exists_lt_succ_right`. -/
theorem exists_lt_succ_right' {p : (m : Nat) (m < n + 1) Prop} :
( m, (h : m < n + 1), p m h) ( m, (h : m < n), p m (by omega)) p n (by omega) := by
simp only [Nat.lt_succ_iff, Nat.le_iff_lt_or_eq]
constructor
· rintro m, (h|rfl), w
· exact .inl m, h, w
· exact .inr w
· rintro (m, h, w | w)
· exact m, by omega, w
· exact n, by omega, w
/-- See `exists_lt_succ_right'` for a variant where `p` takes the bound as an argument. -/
theorem exists_lt_succ_right {p : Nat Prop} :
( m, m < n + 1 p m) ( m, m < n p m) p n := by
simpa using exists_lt_succ_right' (p := fun m _ => p m)
/-- Dependent variant of `exists_lt_succ_left`. -/
theorem exists_lt_succ_left' {p : (m : Nat) (m < n + 1) Prop} :
( m, (h : m < n + 1), p m h) p 0 (by omega) ( m, (h : m < n), p (m + 1) (by omega)) := by
constructor
· rintro _|m, h, w
· exact .inl w
· exact .inr m, by omega, w
· rintro (w|m, h, w)
· exact 0, by omega, w
· exact m + 1, by omega, w
/-- See `exists_lt_succ_left'` for a variant where `p` takes the bound as an argument. -/
theorem exists_lt_succ_left {p : Nat Prop} :
( m, m < n + 1 p m) p 0 ( m, m < n p (m + 1)) := by
simpa using exists_lt_succ_left' (p := fun m _ => p m)
/-! ## add -/
protected theorem add_add_add_comm (a b c d : Nat) : (a + b) + (c + d) = (a + c) + (b + d) := by

View File

@@ -10,7 +10,6 @@ import Init.Data.ToString.Basic
import Init.Data.Array.Subarray
import Init.Conv
import Init.Meta
import Init.While
namespace Lean
@@ -345,6 +344,42 @@ syntax (name := solveTactic) "solve" withPosition((ppDedent(ppLine) colGe "| " t
macro_rules
| `(tactic| solve $[| $ts]* ) => `(tactic| focus first $[| ($ts); done]*)
/-! # `repeat` and `while` notation -/
inductive Loop where
| mk
@[inline]
partial def Loop.forIn {β : Type u} {m : Type u Type v} [Monad m] (_ : Loop) (init : β) (f : Unit β m (ForInStep β)) : m β :=
let rec @[specialize] loop (b : β) : m β := do
match f () b with
| ForInStep.done b => pure b
| ForInStep.yield b => loop b
loop init
instance : ForIn m Loop Unit where
forIn := Loop.forIn
syntax "repeat " doSeq : doElem
macro_rules
| `(doElem| repeat $seq) => `(doElem| for _ in Loop.mk do $seq)
syntax "while " ident " : " termBeforeDo " do " doSeq : doElem
macro_rules
| `(doElem| while $h : $cond do $seq) => `(doElem| repeat if $h : $cond then $seq else break)
syntax "while " termBeforeDo " do " doSeq : doElem
macro_rules
| `(doElem| while $cond do $seq) => `(doElem| repeat if $cond then $seq else break)
syntax "repeat " doSeq ppDedent(ppLine) "until " term : doElem
macro_rules
| `(doElem| repeat $seq until $cond) => `(doElem| repeat do $seq:doSeq; if $cond then break)
macro:50 e:term:51 " matches " p:sepBy1(term:51, " | ") : term =>
`(((match $e:term with | $[$p:term]|* => true | _ => false) : Bool))

View File

@@ -1,51 +0,0 @@
/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Core
/-!
# Notation for `while` and `repeat` loops.
-/
namespace Lean
/-! # `repeat` and `while` notation -/
inductive Loop where
| mk
@[inline]
partial def Loop.forIn {β : Type u} {m : Type u Type v} [Monad m] (_ : Loop) (init : β) (f : Unit β m (ForInStep β)) : m β :=
let rec @[specialize] loop (b : β) : m β := do
match f () b with
| ForInStep.done b => pure b
| ForInStep.yield b => loop b
loop init
instance : ForIn m Loop Unit where
forIn := Loop.forIn
syntax "repeat " doSeq : doElem
macro_rules
| `(doElem| repeat $seq) => `(doElem| for _ in Loop.mk do $seq)
syntax "while " ident " : " termBeforeDo " do " doSeq : doElem
macro_rules
| `(doElem| while $h : $cond do $seq) => `(doElem| repeat if $h : $cond then $seq else break)
syntax "while " termBeforeDo " do " doSeq : doElem
macro_rules
| `(doElem| while $cond do $seq) => `(doElem| repeat if $cond then $seq else break)
syntax "repeat " doSeq ppDedent(ppLine) "until " term : doElem
macro_rules
| `(doElem| repeat $seq until $cond) => `(doElem| repeat do $seq:doSeq; if $cond then break)
end Lean

View File

@@ -369,13 +369,8 @@ def RecursorVal.getFirstIndexIdx (v : RecursorVal) : Nat :=
def RecursorVal.getFirstMinorIdx (v : RecursorVal) : Nat :=
v.numParams + v.numMotives
/-- The inductive type of the major argument of the recursor. -/
def RecursorVal.getMajorInduct (v : RecursorVal) : Name :=
go v.getMajorIdx v.type
where
go
| 0, e => e.bindingDomain!.getAppFn.constName!
| n+1, e => go n e.bindingBody!
def RecursorVal.getInduct (v : RecursorVal) : Name :=
v.name.getPrefix
inductive QuotKind where
| type -- `Quot`

View File

@@ -146,7 +146,7 @@ where
let args args.mapM fun arg => withNestedParser do process arg
mkParserSeq args
else
let args args.mapIdxM fun i arg => withReader (fun ctx => { ctx with first := ctx.first && i == 0 }) do process arg
let args args.mapIdxM fun i arg => withReader (fun ctx => { ctx with first := ctx.first && i.val == 0 }) do process arg
mkParserSeq args
ensureNoPrec (stx : Syntax) :=

View File

@@ -119,7 +119,7 @@ private def pre (pattern : AbstractMVarsResult) (state : IO.Ref PatternMatchStat
let ids ids.mapIdxM fun i id =>
match id.getNat with
| 0 => throwErrorAt id "positive integer expected"
| n+1 => pure (n, i)
| n+1 => pure (n, i.1)
let ids := ids.qsort (·.1 < ·.1)
unless @Array.allDiff _ (·.1 == ·.1) ids do
throwError "occurrence list is not distinct"

View File

@@ -54,7 +54,7 @@ def mkContext (declName : Name) : MetaM Context := do
let typeInfos indVal.all.toArray.mapM getConstInfoInduct
let motiveTypes typeInfos.mapM motiveType
let motives motiveTypes.mapIdxM fun j motive =>
return ( motiveName motiveTypes j, motive)
return ( motiveName motiveTypes j.val, motive)
let headers typeInfos.mapM $ mkHeader motives indVal.numParams
return {
motives := motives
@@ -214,7 +214,7 @@ def mkConstructor (ctx : Context) (i : Nat) (ctor : Name) : MetaM Constructor :=
def mkInductiveType
(ctx : Context)
(i : Nat)
(i : Fin ctx.typeInfos.size)
(indVal : InductiveVal) : MetaM InductiveType := do
return {
name := ctx.belowNames[i]!
@@ -340,11 +340,11 @@ where
mkIH
(params : Array Expr)
(motives : Array Expr)
(idx : Nat)
(idx : Fin ctx.motives.size)
(motive : Name × Expr) : MetaM $ Name × (Array Expr MetaM Expr) := do
let name :=
if ctx.motives.size > 1
then mkFreshUserName <| .mkSimple s!"ih_{idx + 1}"
then mkFreshUserName <| .mkSimple s!"ih_{idx.val.succ}"
else mkFreshUserName <| .mkSimple "ih"
let ih instantiateForall motive.2 params
let mkDomain (_ : Array Expr) : MetaM Expr :=
@@ -353,7 +353,7 @@ where
let args := params ++ motives ++ ys
let premise :=
mkAppN
(mkConst ctx.belowNames[idx]! levels) args
(mkConst ctx.belowNames[idx.val]! levels) args
let conclusion :=
mkAppN motives[idx]! ys
mkForallFVars ys (mkArrow premise conclusion)

View File

@@ -70,7 +70,7 @@ def caseArraySizes (mvarId : MVarId) (fvarId : FVarId) (sizes : Array Nat) (xNam
let subst := subgoal.subst
let mvarId := subgoal.mvarId
let hEqSz := (subst.get hEq).fvarId!
if h : i < sizes.size then
if h : i.val < sizes.size then
let n := sizes.get i, h
let mvarId mvarId.clear subgoal.newHs[0]!
let mvarId mvarId.clear (subst.get aSizeFVarId).fvarId!

View File

@@ -545,7 +545,7 @@ private def processValue (p : Problem) : MetaM (Array Problem) := do
let subgoals caseValues p.mvarId x.fvarId! values (substNewEqs := true)
subgoals.mapIdxM fun i subgoal => do
trace[Meta.Match.match] "processValue subgoal\n{MessageData.ofGoal subgoal.mvarId}"
if h : i < values.size then
if h : i.val < values.size then
let value := values.get i, h
-- (x = value) branch
let subst := subgoal.subst
@@ -599,7 +599,7 @@ private def processArrayLit (p : Problem) : MetaM (Array Problem) := do
let sizes := collectArraySizes p
let subgoals caseArraySizes p.mvarId x.fvarId! sizes
subgoals.mapIdxM fun i subgoal => do
if i < sizes.size then
if i.val < sizes.size then
let size := sizes.get! i
let subst := subgoal.subst
let elems := subgoal.elems.toList

View File

@@ -643,7 +643,7 @@ def abstractIndependentMVars (mvars : Array MVarId) (index : Nat) (e : Expr) : M
pure mvar
trace[Meta.FunInd] "abstractIndependentMVars, reverted mvars: {mvars}"
let decls := mvars.mapIdx fun i mvar =>
(.mkSimple s!"case{i+1}", (fun _ => mvar.getType))
(.mkSimple s!"case{i.val+1}", (fun _ => mvar.getType))
Meta.withLocalDeclsD decls fun xs => do
for mvar in mvars, x in xs do
mvar.assign x
@@ -971,7 +971,7 @@ def deriveInductionStructural (names : Array Name) (numFixed : Nat) : MetaM Unit
mkForallFVars ys (.sort levelZero)
let motiveArities infos.mapM fun info => do
lambdaTelescope ( instantiateLambda info.value xs) fun ys _ => pure ys.size
let motiveDecls motiveTypes.mapIdxM fun i motiveType => do
let motiveDecls motiveTypes.mapIdxM fun i,_ motiveType => do
let n := if infos.size = 1 then .mkSimple "motive"
else .mkSimple s!"motive_{i+1}"
pure (n, fun _ => pure motiveType)

View File

@@ -95,7 +95,7 @@ private def toCtorWhenK (recVal : RecursorVal) (major : Expr) : MetaM Expr := do
let majorType inferType major
let majorType instantiateMVars ( whnf majorType)
let majorTypeI := majorType.getAppFn
if !majorTypeI.isConstOf recVal.getMajorInduct then
if !majorTypeI.isConstOf recVal.getInduct then
return major
else if majorType.hasExprMVar && majorType.getAppArgs[recVal.numParams:].any Expr.hasExprMVar then
return major
@@ -197,7 +197,7 @@ private def reduceRec (recVal : RecursorVal) (recLvls : List Level) (recArgs : A
major toCtorWhenK recVal major
major := major.toCtorIfLit
major cleanupNatOffsetMajor major
major toCtorWhenStructure recVal.getMajorInduct major
major toCtorWhenStructure recVal.getInduct major
match getRecRuleFor recVal major with
| some rule =>
let majorArgs := major.getAppArgs

View File

@@ -189,7 +189,7 @@ open PrettyPrinter Syntax.MonadTraverser Formatter in
@[combinator_formatter sepByIndent]
def sepByIndent.formatter (p : Formatter) (_sep : String) (pSep : Formatter) : Formatter := do
let stx getCur
let hasNewlineSep := stx.getArgs.mapIdx (fun i n =>
let hasNewlineSep := stx.getArgs.mapIdx (fun i, _ n =>
i % 2 == 1 && n.matchesNull 0 && i != stx.getArgs.size - 1) |>.any id
visitArgs do
for i in (List.range stx.getArgs.size).reverse do

View File

@@ -1004,7 +1004,7 @@ private def assignSortTexts (completions : CompletionList) : CompletionList := I
if completions.items.isEmpty then
return completions
let items := completions.items.mapIdx fun i item =>
{ item with sortText? := toString i }
{ item with sortText? := toString i.val }
let maxDigits := items[items.size - 1]!.sortText?.get!.length
let items := items.map fun item =>
let sortText := item.sortText?.get!

View File

@@ -126,6 +126,7 @@ constructor_val::constructor_val(name const & n, names const & lparams, expr con
object_ref(lean_mk_constructor_val(n.to_obj_arg(), lparams.to_obj_arg(), type.to_obj_arg(), induct.to_obj_arg(),
nat(cidx).to_obj_arg(), nat(nparams).to_obj_arg(), nat(nfields).to_obj_arg(), is_unsafe)) {
}
bool constructor_val::is_unsafe() const { return lean_constructor_val_is_unsafe(to_obj_arg()); }
extern "C" object * lean_mk_recursor_val(object * n, object * lparams, object * type, object * all,
@@ -142,18 +143,6 @@ recursor_val::recursor_val(name const & n, names const & lparams, expr const & t
nat(nminors).to_obj_arg(), rules.to_obj_arg(), k, is_unsafe)) {
}
name const & recursor_val::get_major_induct() const {
unsigned int n = get_major_idx();
expr const * t = &(to_constant_val().get_type());
for (unsigned int i = 0; i < n; i++) {
t = &(binding_body(*t));
}
t = &(binding_domain(*t));
t = &(get_app_fn(*t));
return const_name(*t);
}
bool recursor_val::is_k() const { return lean_recursor_k(to_obj_arg()); }
bool recursor_val::is_unsafe() const { return lean_recursor_is_unsafe(to_obj_arg()); }

View File

@@ -370,7 +370,7 @@ public:
recursor_val & operator=(recursor_val && other) { object_ref::operator=(std::move(other)); return *this; }
constant_val const & to_constant_val() const { return static_cast<constant_val const &>(cnstr_get_ref(*this, 0)); }
name const & get_name() const { return to_constant_val().get_name(); }
name const & get_major_induct() const;
name const & get_induct() const { return get_name().get_prefix(); }
names const & get_all() const { return static_cast<names const &>(cnstr_get_ref(*this, 1)); }
unsigned get_nparams() const { return static_cast<nat const &>(cnstr_get_ref(*this, 2)).get_small_value(); }
unsigned get_nindices() const { return static_cast<nat const &>(cnstr_get_ref(*this, 3)).get_small_value(); }

View File

@@ -79,22 +79,21 @@ extern "C" object * lean_lit_type(obj_arg e);
expr lit_type(literal const & lit) { return expr(lean_lit_type(lit.to_obj_arg())); }
extern "C" uint64_t lean_expr_hash(obj_arg e);
unsigned hash_core(expr const & e) {
return lean_expr_hash(e.to_obj_arg());
unsigned hash(expr const & e) {
object * o = e.raw();
unsigned r = static_cast<unsigned>(lean_ctor_get_uint64(o, lean_ctor_num_objs(o)*sizeof(object*)));
lean_assert(r == lean_expr_hash(e.to_obj_arg()));
return r;
}
extern "C" uint8 lean_expr_has_fvar(obj_arg e);
bool has_fvar_core(expr const & e) {
return lean_expr_has_fvar(e.to_obj_arg());
}
bool has_fvar(expr const & e) { return lean_expr_has_fvar(e.to_obj_arg()); }
extern "C" uint8 lean_expr_has_expr_mvar(obj_arg e);
bool has_expr_mvar_core(expr const & e) {
return lean_expr_has_expr_mvar(e.to_obj_arg());
}
bool has_expr_mvar(expr const & e) { return lean_expr_has_expr_mvar(e.to_obj_arg()); }
extern "C" uint8 lean_expr_has_level_mvar(obj_arg e);
bool has_univ_mvar_core(expr const & e) { return lean_expr_has_level_mvar(e.to_obj_arg()); }
bool has_univ_mvar(expr const & e) { return lean_expr_has_level_mvar(e.to_obj_arg()); }
extern "C" uint8 lean_expr_has_level_param(obj_arg e);
bool has_univ_param(expr const & e) { return lean_expr_has_level_param(e.to_obj_arg()); }

View File

@@ -123,37 +123,11 @@ inline bool is_eqp(optional<expr> const & a, optional<expr> const & b) {
return static_cast<bool>(a) == static_cast<bool>(b) && (!a || is_eqp(*a, *b));
}
inline uint64_t get_data(expr const & e) {
return lean_ctor_get_uint64(e.raw(), lean_ctor_num_objs(e.raw())*sizeof(object*));
}
/* This is the implementation in Lean */
unsigned hash_core(expr const & e);
inline unsigned hash(expr const & e) {
unsigned r = static_cast<unsigned>(get_data(e));
lean_assert(r == hash_core(e));
return r;
}
/* This is the implementation in Lean */
bool has_expr_mvar_core(expr const & e);
inline bool has_expr_mvar(expr const & e) {
bool r = ((get_data(e) >> 41) & 1) == 1;
lean_assert(r == has_expr_mvar_core(e)); // ensure the C++ implementation matches the Lean one.
return r;
}
bool has_univ_mvar_core(expr const & e);
inline bool has_univ_mvar(expr const & e) {
bool r = ((get_data(e) >> 42) & 1) == 1;
lean_assert(r == has_univ_mvar_core(e)); // ensure the C++ implementation matches the Lean one.
return r;
}
unsigned hash(expr const & e);
bool has_expr_mvar(expr const & e);
bool has_univ_mvar(expr const & e);
inline bool has_mvar(expr const & e) { return has_expr_mvar(e) || has_univ_mvar(e); }
/* This is the implementation in Lean */
bool has_fvar_core(expr const & e);
inline bool has_fvar(expr const & e) {
bool r = ((get_data(e) >> 40) & 1) == 1;
lean_assert(r == has_fvar_core(e)); // ensure the C++ implementation matches the Lean one.
return r;
}
bool has_fvar(expr const & e);
bool has_univ_param(expr const & e);
unsigned get_loose_bvar_range(expr const & e);

View File

@@ -33,7 +33,7 @@ inline expr to_cnstr_when_K(environment const & env, recursor_val const & rval,
lean_assert(rval.is_k());
expr app_type = whnf(infer_type(e));
expr const & app_type_I = get_app_fn(app_type);
if (!is_constant(app_type_I) || const_name(app_type_I) != rval.get_major_induct()) return e; // type incorrect
if (!is_constant(app_type_I) || const_name(app_type_I) != rval.get_induct()) return e; // type incorrect
if (has_expr_mvar(app_type)) {
buffer<expr> app_type_args;
get_app_args(app_type, app_type_args);
@@ -94,7 +94,7 @@ inline optional<expr> inductive_reduce_rec(environment const & env, expr const &
else if (is_string_lit(major))
major = string_lit_to_constructor(major);
else
major = to_cnstr_when_structure(env, rec_val.get_major_induct(), major, whnf, infer_type);
major = to_cnstr_when_structure(env, rec_val.get_induct(), major, whnf, infer_type);
optional<recursor_rule> rule = get_rec_rule_for(rec_val, major);
if (!rule) return none_expr();
buffer<expr> major_args;

View File

@@ -17,8 +17,6 @@ After unfolding the instances 'instDecidableEqNat', 'Array.instDecidableEq' and
example : #[0, 1] = #[0, 1] := by decide
example : let a := Array.range (10^6); a == a := by native_decide
/-!
There are other `Array` functions that use well-founded recursion,
which we've marked as `@[semireducible]`. We test that `decide` can unfold them here.

View File

@@ -1,73 +0,0 @@
import Lean.Meta.Basic
inductive StructLike α where
| mk : α StructLike α
inductive Nested where
| nest : StructLike Nested Nested
| other
/--
info: theorem Nested.nest.sizeOf_spec : ∀ (a : StructLike Nested), sizeOf (Nested.nest a) = 1 + sizeOf a :=
fun a => Eq.refl (1 + sizeOf a)
-/
#guard_msgs in
#print Nested.nest.sizeOf_spec
/-- info: StructLike -/
#guard_msgs in
open Lean Meta in
run_meta do
let i getConstInfoRec ``Nested.rec_1
logInfo m!"{i.getMajorInduct}"
theorem works (x : StructLike Nested) : StructLike.rec
(motive := fun _ => Bool)
(mk := fun _ => true)
x = true
:= rfl
theorem failed_before (x : StructLike Nested) : Nested.rec_1
(motive_1 := fun _ => Bool) (motive_2 := fun _ => Bool)
(nest := fun _ _ => true)
(other := true)
(mk := fun _ _ => true)
x = true
:= rfl
-- The original surface bug
inductive Set (α : Type u) where
| mk (l : List α)
inductive Value where
| prim
| set (s : Set Value)
instance : DecidableEq Value := sorry
mutual
def Value.lt : Value Value Bool
| .prim, .prim => false
| .set (.mk vs₁), .set (.mk vs₂) => Values.lt vs₁ vs₂
| .prim, .set _ => true
| .set _, .prim => false
def Values.lt : List Value List Value Bool
| [], [] => false
| [], _ => true
| _, [] => false
| v₁ :: vs₁, v₂ :: vs₂ => Value.lt v₁ v₂ || (v₁ = v₂ && Values.lt vs₁ vs₂)
end
theorem Value.lt_irrefl (v : Value) :
¬ Value.lt v v
:= by
cases v
case set a =>
show ¬Values.lt a.1 a.1 = true
sorry
all_goals sorry