mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-18 02:44:12 +00:00
Compare commits
55 Commits
dropPrefix
...
array_modi
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
7b7ca92383 | ||
|
|
8d789f7b63 | ||
|
|
82d31a1793 | ||
|
|
76164b284b | ||
|
|
51377afd6c | ||
|
|
6f642abe70 | ||
|
|
8151ac79d6 | ||
|
|
4f18c29cb4 | ||
|
|
5d155d8b02 | ||
|
|
def81076de | ||
|
|
46f1335b80 | ||
|
|
682173d7c0 | ||
|
|
26df545598 | ||
|
|
11ae8bae42 | ||
|
|
a167860e3b | ||
|
|
cc76496050 | ||
|
|
41b35baea2 | ||
|
|
a6243f6076 | ||
|
|
fd15d8f9ed | ||
|
|
1d66ff8231 | ||
|
|
51ab162a5a | ||
|
|
41797a78c3 | ||
|
|
d6a7eb3987 | ||
|
|
fc5e3cc66e | ||
|
|
372f344155 | ||
|
|
f2ac0d03c6 | ||
|
|
08d8a0873e | ||
|
|
68b0471de9 | ||
|
|
3a34a8e0d1 | ||
|
|
6fa75e346a | ||
|
|
2669fb525f | ||
|
|
8632b79023 | ||
|
|
e8970463d1 | ||
|
|
69e8cd3d8a | ||
|
|
565ac23b78 | ||
|
|
c1750f4316 | ||
|
|
092c87a70f | ||
|
|
b8fc6c593a | ||
|
|
7c2425605c | ||
|
|
3f7854203a | ||
|
|
79583d63f3 | ||
|
|
741040d296 | ||
|
|
b69377cc42 | ||
|
|
ef05bdc449 | ||
|
|
50594aa932 | ||
|
|
032c0257c3 | ||
|
|
a2d2977228 | ||
|
|
b333de1a36 | ||
|
|
19e06acc65 | ||
|
|
a04b476431 | ||
|
|
eea953b94f | ||
|
|
dec1262697 | ||
|
|
487c2a937a | ||
|
|
831fa0899f | ||
|
|
94053c9b1b |
8
.github/workflows/check-prelude.yml
vendored
8
.github/workflows/check-prelude.yml
vendored
@@ -11,7 +11,9 @@ jobs:
|
||||
with:
|
||||
# the default is to use a virtual merge commit between the PR and master: just use the PR
|
||||
ref: ${{ github.event.pull_request.head.sha }}
|
||||
sparse-checkout: src/Lean
|
||||
sparse-checkout: |
|
||||
src/Lean
|
||||
src/Std
|
||||
- name: Check Prelude
|
||||
run: |
|
||||
failed_files=""
|
||||
@@ -19,8 +21,8 @@ jobs:
|
||||
if ! grep -q "^prelude$" "$file"; then
|
||||
failed_files="$failed_files$file\n"
|
||||
fi
|
||||
done < <(find src/Lean -name '*.lean' -print0)
|
||||
done < <(find src/Lean src/Std -name '*.lean' -print0)
|
||||
if [ -n "$failed_files" ]; then
|
||||
echo -e "The following files should use 'prelude':\n$failed_files"
|
||||
exit 1
|
||||
fi
|
||||
fi
|
||||
|
||||
11
CODEOWNERS
11
CODEOWNERS
@@ -4,14 +4,14 @@
|
||||
# Listed persons will automatically be asked by GitHub to review a PR touching these paths.
|
||||
# If multiple names are listed, a review by any of them is considered sufficient by default.
|
||||
|
||||
/.github/ @Kha @semorrison
|
||||
/RELEASES.md @semorrison
|
||||
/.github/ @Kha @kim-em
|
||||
/RELEASES.md @kim-em
|
||||
/src/kernel/ @leodemoura
|
||||
/src/lake/ @tydeu
|
||||
/src/Lean/Compiler/ @leodemoura
|
||||
/src/Lean/Data/Lsp/ @mhuisi
|
||||
/src/Lean/Elab/Deriving/ @semorrison
|
||||
/src/Lean/Elab/Tactic/ @semorrison
|
||||
/src/Lean/Elab/Deriving/ @kim-em
|
||||
/src/Lean/Elab/Tactic/ @kim-em
|
||||
/src/Lean/Language/ @Kha
|
||||
/src/Lean/Meta/Tactic/ @leodemoura
|
||||
/src/Lean/Parser/ @Kha
|
||||
@@ -19,7 +19,7 @@
|
||||
/src/Lean/PrettyPrinter/Delaborator/ @kmill
|
||||
/src/Lean/Server/ @mhuisi
|
||||
/src/Lean/Widget/ @Vtec234
|
||||
/src/Init/Data/ @semorrison
|
||||
/src/Init/Data/ @kim-em
|
||||
/src/Init/Data/Array/Lemmas.lean @digama0
|
||||
/src/Init/Data/List/Lemmas.lean @digama0
|
||||
/src/Init/Data/List/BasicAux.lean @digama0
|
||||
@@ -45,3 +45,4 @@
|
||||
/src/Std/ @TwoFX
|
||||
/src/Std/Tactic/BVDecide/ @hargoniX
|
||||
/src/Lean/Elab/Tactic/BVDecide/ @hargoniX
|
||||
/src/Std/Sat/ @hargoniX
|
||||
|
||||
@@ -35,3 +35,4 @@ import Init.Ext
|
||||
import Init.Omega
|
||||
import Init.MacroTrace
|
||||
import Init.Grind
|
||||
import Init.While
|
||||
|
||||
@@ -1385,6 +1385,7 @@ gen_injective_theorems% Except
|
||||
gen_injective_theorems% EStateM.Result
|
||||
gen_injective_theorems% Lean.Name
|
||||
gen_injective_theorems% Lean.Syntax
|
||||
gen_injective_theorems% BitVec
|
||||
|
||||
theorem Nat.succ.inj {m n : Nat} : m.succ = n.succ → m = n :=
|
||||
fun x => Nat.noConfusion x id
|
||||
@@ -1936,15 +1937,6 @@ instance : Subsingleton (Squash α) where
|
||||
apply Quot.sound
|
||||
trivial
|
||||
|
||||
/-! # Relations -/
|
||||
|
||||
/--
|
||||
`Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
|
||||
-/
|
||||
class Antisymm {α : Sort u} (r : α → α → Prop) : Prop where
|
||||
/-- An antisymmetric relation `(·≤·)` satisfies `a ≤ b → b ≤ a → a = b`. -/
|
||||
antisymm {a b : α} : r a b → r b a → a = b
|
||||
|
||||
namespace Lean
|
||||
/-! # Kernel reduction hints -/
|
||||
|
||||
@@ -2120,4 +2112,14 @@ instance : Commutative Or := ⟨fun _ _ => propext or_comm⟩
|
||||
instance : Commutative And := ⟨fun _ _ => propext and_comm⟩
|
||||
instance : Commutative Iff := ⟨fun _ _ => propext iff_comm⟩
|
||||
|
||||
/--
|
||||
`Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
|
||||
-/
|
||||
class Antisymm (r : α → α → Prop) : Prop where
|
||||
/-- An antisymmetric relation `(·≤·)` satisfies `a ≤ b → b ≤ a → a = b`. -/
|
||||
antisymm {a b : α} : r a b → r b a → a = b
|
||||
|
||||
@[deprecated Antisymm (since := "2024-10-16"), inherit_doc Antisymm]
|
||||
abbrev _root_.Antisymm (r : α → α → Prop) : Prop := Std.Antisymm r
|
||||
|
||||
end Std
|
||||
|
||||
@@ -16,3 +16,4 @@ import Init.Data.Array.Lemmas
|
||||
import Init.Data.Array.TakeDrop
|
||||
import Init.Data.Array.Bootstrap
|
||||
import Init.Data.Array.GetLit
|
||||
import Init.Data.Array.MapIdx
|
||||
|
||||
@@ -7,7 +7,7 @@ prelude
|
||||
import Init.WFTactics
|
||||
import Init.Data.Nat.Basic
|
||||
import Init.Data.Fin.Basic
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Data.Repr
|
||||
import Init.Data.ToString.Basic
|
||||
import Init.GetElem
|
||||
@@ -25,6 +25,8 @@ variable {α : Type u}
|
||||
|
||||
namespace Array
|
||||
|
||||
@[deprecated size (since := "2024-10-13")] abbrev data := @toList
|
||||
|
||||
/-! ### Preliminary theorems -/
|
||||
|
||||
@[simp] theorem size_set (a : Array α) (i : Fin a.size) (v : α) : (set a i v).size = a.size :=
|
||||
@@ -78,6 +80,26 @@ 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
|
||||
@@ -396,20 +418,25 @@ 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 mapIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (as : Array α) (f : Fin as.size → α → m β) : m (Array β) :=
|
||||
def mapFinIdxM {α : 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 < as.size := by
|
||||
have j_lt : 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 idx (as.get idx)))
|
||||
map i (j+1) this (bs.push (← f ⟨j, j_lt⟩ (as.get ⟨j, j_lt⟩)))
|
||||
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
|
||||
@@ -515,8 +542,13 @@ 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 mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size → α → β) : Array β :=
|
||||
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 β :=
|
||||
Id.run <| as.mapIdxM f
|
||||
|
||||
/-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/
|
||||
@@ -607,13 +639,17 @@ protected def appendList (as : Array α) (bs : List α) : Array α :=
|
||||
instance : HAppend (Array α) (List α) (Array α) := ⟨Array.appendList⟩
|
||||
|
||||
@[inline]
|
||||
def concatMapM [Monad m] (f : α → m (Array β)) (as : Array α) : m (Array β) :=
|
||||
def flatMapM [Monad m] (f : α → m (Array β)) (as : Array α) : m (Array β) :=
|
||||
as.foldlM (init := empty) fun bs a => do return bs ++ (← f a)
|
||||
|
||||
@[deprecated concatMapM (since := "2024-10-16")] abbrev concatMapM := @flatMapM
|
||||
|
||||
@[inline]
|
||||
def concatMap (f : α → Array β) (as : Array α) : Array β :=
|
||||
def flatMap (f : α → Array β) (as : Array α) : Array β :=
|
||||
as.foldl (init := empty) fun bs a => bs ++ f a
|
||||
|
||||
@[deprecated flatMap (since := "2024-10-16")] abbrev concatMap := @flatMap
|
||||
|
||||
/-- Joins array of array into a single array.
|
||||
|
||||
`flatten #[#[a₁, a₂, ⋯], #[b₁, b₂, ⋯], ⋯]` = `#[a₁, a₂, ⋯, b₁, b₂, ⋯]`
|
||||
@@ -813,9 +849,15 @@ def split (as : Array α) (p : α → Bool) : Array α × Array α :=
|
||||
|
||||
/-! ## Auxiliary functions used in metaprogramming.
|
||||
|
||||
We do not intend to provide verification theorems for these functions.
|
||||
We do not currently intend to provide verification theorems for these functions.
|
||||
-/
|
||||
|
||||
/- ### reduceOption -/
|
||||
|
||||
/-- Drop `none`s from a Array, and replace each remaining `some a` with `a`. -/
|
||||
@[inline] def reduceOption (as : Array (Option α)) : Array α :=
|
||||
as.filterMap id
|
||||
|
||||
/-! ### eraseReps -/
|
||||
|
||||
/--
|
||||
|
||||
@@ -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)]; rfl
|
||||
| i+1 => rw [← List.take_concat_get _ _ h]; simp [← (aux f arr · i)]
|
||||
|
||||
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
|
||||
|
||||
@@ -6,6 +6,8 @@ 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
|
||||
@@ -26,6 +28,14 @@ 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]
|
||||
@@ -33,6 +43,29 @@ 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)
|
||||
@@ -56,4 +89,22 @@ 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
|
||||
|
||||
@@ -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 [getLit_eq, List.get_drop_eq_drop, toListLitAux, List.drop, *]
|
||||
induction i <;> simp only [List.drop, toListLitAux, getLit_eq, List.get_drop_eq_drop, *]
|
||||
|
||||
end Array
|
||||
|
||||
@@ -8,19 +8,17 @@ import Init.Data.Nat.Lemmas
|
||||
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
|
||||
|
||||
/-!
|
||||
## Bootstrapping theorems about arrays
|
||||
|
||||
This file contains some theorems about `Array` and `List` needed for `Init.Data.List.Impl`.
|
||||
## Theorems about `Array`.
|
||||
-/
|
||||
|
||||
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
|
||||
@@ -45,31 +43,32 @@ theorem getElem?_eq_getElem?_toList (a : Array α) (i : Nat) : a[i]? = a.toList[
|
||||
rw [getElem?_eq]
|
||||
split <;> simp_all
|
||||
|
||||
@[deprecated getElem_eq_getElem_toList (since := "2024-09-25")]
|
||||
abbrev getElem_eq_toList_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-09-09")]
|
||||
abbrev getElem_eq_data_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-06-12")]
|
||||
theorem getElem_eq_toList_get (a : Array α) (h : i < a.size) : a[i] = a.toList.get ⟨i, h⟩ := by
|
||||
simp
|
||||
|
||||
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
|
||||
theorem getElem_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
|
||||
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
|
||||
(a.push x)[i] = a[i] := by
|
||||
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append, List.getElem_append_left, h]
|
||||
|
||||
@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
|
||||
@[simp] theorem getElem_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
|
||||
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append]
|
||||
rw [List.getElem_append_right] <;> simp [getElem_eq_getElem_toList, Nat.zero_lt_one]
|
||||
|
||||
theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
|
||||
theorem getElem_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
|
||||
(a.push x)[i] = if h : i < a.size then a[i] else x := by
|
||||
by_cases h' : i < a.size
|
||||
· simp [get_push_lt, h']
|
||||
· simp [getElem_push_lt, h']
|
||||
· simp at h
|
||||
simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
|
||||
simp [getElem_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
|
||||
|
||||
@[deprecated getElem_push (since := "2024-10-21")] abbrev get_push := @getElem_push
|
||||
@[deprecated getElem_push_lt (since := "2024-10-21")] abbrev get_push_lt := @getElem_push_lt
|
||||
@[deprecated getElem_push_eq (since := "2024-10-21")] abbrev get_push_eq := @getElem_push_eq
|
||||
|
||||
@[simp] theorem get!_eq_getElem! [Inhabited α] (a : Array α) (i : Nat) : a.get! i = a[i]! := by
|
||||
simp [getElem!_def, get!, getD]
|
||||
split <;> rename_i h
|
||||
· simp [getElem?_eq_getElem h]
|
||||
rfl
|
||||
· simp [getElem?_eq_none_iff.2 (by simpa using h)]
|
||||
|
||||
end Array
|
||||
|
||||
@@ -77,28 +76,15 @@ namespace List
|
||||
|
||||
open Array
|
||||
|
||||
/-! ### Lemmas about `List.toArray`. -/
|
||||
/-! ### Lemmas about `List.toArray`.
|
||||
|
||||
We prefer to pull `List.toArray` outwards.
|
||||
-/
|
||||
|
||||
@[simp] theorem size_toArrayAux {a : List α} {b : Array α} :
|
||||
(a.toArrayAux b).size = b.size + a.length := by
|
||||
simp [size]
|
||||
|
||||
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
|
||||
@[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
|
||||
|
||||
@[deprecated "Use the reverse direction of `List.push_toArray`." (since := "2024-09-27")]
|
||||
theorem toArray_concat {as : List α} {x : α} :
|
||||
(as ++ [x]).toArray = as.toArray.push x := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
@@ -108,6 +94,14 @@ theorem toArray_concat {as : List α} {x : α} :
|
||||
funext a
|
||||
simp
|
||||
|
||||
@[simp] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
|
||||
cases l <;> simp
|
||||
|
||||
@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = singleton a := rfl
|
||||
|
||||
@[simp] theorem back_toArray [Inhabited α] (l : List α) : l.toArray.back = l.getLast! := by
|
||||
simp only [back, size_toArray, Array.get!_eq_getElem!, getElem!_toArray, getLast!_eq_getElem!]
|
||||
|
||||
theorem foldrM_toArray [Monad m] (f : α → β → m β) (init : β) (l : List α) :
|
||||
l.toArray.foldrM f init = l.foldrM f init := by
|
||||
rw [foldrM_eq_reverse_foldlM_toList]
|
||||
@@ -163,20 +157,15 @@ end List
|
||||
|
||||
namespace Array
|
||||
|
||||
attribute [simp] uset
|
||||
|
||||
@[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
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
|
||||
@[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
|
||||
|
||||
@[deprecated length_toList (since := "2024-09-09")]
|
||||
abbrev data_length := @length_toList
|
||||
|
||||
@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
|
||||
|
||||
@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
|
||||
@@ -225,9 +214,6 @@ where
|
||||
induction l generalizing arr <;> simp [*]
|
||||
simp [H]
|
||||
|
||||
@[deprecated toList_map (since := "2024-09-09")]
|
||||
abbrev map_data := @toList_map
|
||||
|
||||
@[simp] theorem size_map (f : α → β) (arr : Array α) : (arr.map f).size = arr.size := by
|
||||
simp only [← length_toList]
|
||||
simp
|
||||
@@ -242,24 +228,16 @@ abbrev map_data := @toList_map
|
||||
cases arr
|
||||
simp
|
||||
|
||||
theorem foldl_toList_eq_bind (l : List α) (acc : Array β)
|
||||
theorem foldl_toList_eq_flatMap (l : List α) (acc : Array β)
|
||||
(F : Array β → α → Array β) (G : α → List β)
|
||||
(H : ∀ acc a, (F acc a).toList = acc.toList ++ G a) :
|
||||
(l.foldl F acc).toList = acc.toList ++ l.bind G := by
|
||||
induction l generalizing acc <;> simp [*, List.bind]
|
||||
|
||||
@[deprecated foldl_toList_eq_bind (since := "2024-09-09")]
|
||||
abbrev foldl_data_eq_bind := @foldl_toList_eq_bind
|
||||
(l.foldl F acc).toList = acc.toList ++ l.flatMap G := by
|
||||
induction l generalizing acc <;> simp [*, List.flatMap]
|
||||
|
||||
theorem foldl_toList_eq_map (l : List α) (acc : Array β) (G : α → β) :
|
||||
(l.foldl (fun acc a => acc.push (G a)) acc).toList = acc.toList ++ l.map G := by
|
||||
induction l generalizing acc <;> simp [*]
|
||||
|
||||
@[deprecated foldl_toList_eq_map (since := "2024-09-09")]
|
||||
abbrev foldl_data_eq_map := @foldl_toList_eq_map
|
||||
|
||||
theorem size_uset (a : Array α) (v i h) : (uset a i v h).size = a.size := by simp
|
||||
|
||||
theorem anyM_eq_anyM_loop [Monad m] (p : α → m Bool) (as : Array α) (start stop) :
|
||||
anyM p as start stop = anyM.loop p as (min stop as.size) (Nat.min_le_right ..) start := by
|
||||
simp only [anyM, Nat.min_def]; split <;> rfl
|
||||
@@ -274,12 +252,18 @@ theorem mem_def {a : α} {as : Array α} : a ∈ as ↔ a ∈ as.toList :=
|
||||
@[simp] theorem not_mem_empty (a : α) : ¬(a ∈ #[]) := by
|
||||
simp [mem_def]
|
||||
|
||||
/-! # uset -/
|
||||
|
||||
attribute [simp] uset
|
||||
|
||||
theorem size_uset (a : Array α) (v i h) : (uset a i v h).size = a.size := by simp
|
||||
|
||||
/-! # get -/
|
||||
|
||||
@[simp] theorem get_eq_getElem (a : Array α) (i : Fin _) : a.get i = a[i.1] := rfl
|
||||
|
||||
theorem getElem?_lt
|
||||
(a : Array α) {i : Nat} (h : i < a.size) : a[i]? = some (a[i]) := dif_pos h
|
||||
(a : Array α) {i : Nat} (h : i < a.size) : a[i]? = some a[i] := dif_pos h
|
||||
|
||||
theorem getElem?_ge
|
||||
(a : Array α) {i : Nat} (h : i ≥ a.size) : a[i]? = none := dif_neg (Nat.not_lt_of_le h)
|
||||
@@ -302,8 +286,10 @@ theorem getD_get? (a : Array α) (i : Nat) (d : α) :
|
||||
|
||||
theorem get!_eq_getD [Inhabited α] (a : Array α) : a.get! n = a.getD n default := rfl
|
||||
|
||||
@[simp] theorem get!_eq_getElem? [Inhabited α] (a : Array α) (i : Nat) : a.get! i = (a.get? i).getD default := by
|
||||
by_cases p : i < a.size <;> simp [getD_get?, get!_eq_getD, p]
|
||||
@[simp] theorem get!_eq_getElem? [Inhabited α] (a : Array α) (i : Nat) :
|
||||
a.get! i = (a.get? i).getD default := by
|
||||
by_cases p : i < a.size <;>
|
||||
simp only [get!_eq_getD, getD_eq_get?, getD_get?, p, get?_eq_getElem?]
|
||||
|
||||
/-! # set -/
|
||||
|
||||
@@ -383,8 +369,8 @@ theorem getElem_ofFn_go (f : Fin n → α) (i) {acc k}
|
||||
simp only [dif_pos hin]
|
||||
rw [getElem_ofFn_go f (i+1) _ hin (by simp [*]) (fun j hj => ?hacc)]
|
||||
cases (Nat.lt_or_eq_of_le <| Nat.le_of_lt_succ (by simpa using hj)) with
|
||||
| inl hj => simp [get_push, hj, hacc j hj]
|
||||
| inr hj => simp [get_push, *]
|
||||
| inl hj => simp [getElem_push, hj, hacc j hj]
|
||||
| inr hj => simp [getElem_push, *]
|
||||
else
|
||||
simp [hin, hacc k (Nat.lt_of_lt_of_le hki (Nat.le_of_not_lt (hi ▸ hin)))]
|
||||
termination_by n - i
|
||||
@@ -393,6 +379,10 @@ termination_by n - i
|
||||
(ofFn f)[i] = f ⟨i, size_ofFn f ▸ h⟩ :=
|
||||
getElem_ofFn_go _ _ _ (by simp) (by simp) nofun
|
||||
|
||||
theorem getElem?_ofFn (f : Fin n → α) (i : Nat) :
|
||||
(ofFn f)[i]? = if h : i < n then some (f ⟨i, h⟩) else none := by
|
||||
simp [getElem?_def]
|
||||
|
||||
/-- # mkArray -/
|
||||
|
||||
@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
|
||||
@@ -400,19 +390,17 @@ termination_by n - i
|
||||
|
||||
@[simp] theorem toList_mkArray (n : Nat) (v : α) : (mkArray n v).toList = List.replicate n v := rfl
|
||||
|
||||
@[deprecated toList_mkArray (since := "2024-09-09")]
|
||||
abbrev mkArray_data := @toList_mkArray
|
||||
|
||||
@[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) :
|
||||
(mkArray n v)[i] = v := by simp [Array.getElem_eq_getElem_toList]
|
||||
|
||||
theorem getElem?_mkArray (n : Nat) (v : α) (i : Nat) :
|
||||
(mkArray n v)[i]? = if i < n then some v else none := by
|
||||
simp [getElem?_def]
|
||||
|
||||
/-- # mem -/
|
||||
|
||||
theorem mem_toList {a : α} {l : Array α} : a ∈ l.toList ↔ a ∈ l := mem_def.symm
|
||||
|
||||
@[deprecated mem_toList (since := "2024-09-09")]
|
||||
abbrev mem_data := @mem_toList
|
||||
|
||||
theorem not_mem_nil (a : α) : ¬ a ∈ #[] := nofun
|
||||
|
||||
theorem getElem_of_mem {a : α} {as : Array α} :
|
||||
@@ -422,6 +410,12 @@ theorem getElem_of_mem {a : α} {as : Array α} :
|
||||
exists i
|
||||
exists hbound
|
||||
|
||||
theorem getElem?_of_mem {a : α} {as : Array α} :
|
||||
a ∈ as → ∃ (n : Nat), as[n]? = some a := by
|
||||
intro ha
|
||||
rcases List.getElem?_of_mem ha.val with ⟨i, hi⟩
|
||||
exists i
|
||||
|
||||
@[simp] theorem mem_dite_empty_left {x : α} [Decidable p] {l : ¬ p → Array α} :
|
||||
(x ∈ if h : p then #[] else l h) ↔ ∃ h : ¬ p, x ∈ l h := by
|
||||
split <;> simp_all [mem_def]
|
||||
@@ -444,75 +438,60 @@ theorem lt_of_getElem {x : α} {a : Array α} {idx : Nat} {hidx : idx < a.size}
|
||||
idx < a.size :=
|
||||
hidx
|
||||
|
||||
theorem getElem?_mem {l : Array α} {i : Fin l.size} : l[i] ∈ l := by
|
||||
@[simp] theorem getElem_mem {l : Array α} {i : Nat} (h : i < l.size) : l[i] ∈ l := by
|
||||
erw [Array.mem_def, getElem_eq_getElem_toList]
|
||||
apply List.get_mem
|
||||
|
||||
theorem getElem_fin_eq_toList_get (a : Array α) (i : Fin _) : a[i] = a.toList.get i := rfl
|
||||
|
||||
@[deprecated getElem_fin_eq_toList_get (since := "2024-09-09")]
|
||||
abbrev getElem_fin_eq_data_get := @getElem_fin_eq_toList_get
|
||||
theorem getElem_fin_eq_getElem_toList (a : Array α) (i : Fin a.size) : a[i] = a.toList[i] := rfl
|
||||
|
||||
@[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) :
|
||||
a[i] = a[i.toNat] := rfl
|
||||
|
||||
theorem get?_len_le (a : Array α) (i : Nat) (h : a.size ≤ i) : a[i]? = none := by
|
||||
theorem getElem?_size_le (a : Array α) (i : Nat) (h : a.size ≤ i) : a[i]? = none := by
|
||||
simp [getElem?_neg, h]
|
||||
|
||||
@[deprecated getElem?_size_le (since := "2024-10-21")] abbrev get?_len_le := @getElem?_size_le
|
||||
|
||||
theorem getElem_mem_toList (a : Array α) (h : i < a.size) : a[i] ∈ a.toList := by
|
||||
simp only [getElem_eq_getElem_toList, List.getElem_mem]
|
||||
|
||||
@[deprecated getElem_mem_toList (since := "2024-09-09")]
|
||||
abbrev getElem_mem_data := @getElem_mem_toList
|
||||
|
||||
theorem getElem?_eq_toList_getElem? (a : Array α) (i : Nat) : a[i]? = a.toList[i]? := by
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg]
|
||||
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-30")]
|
||||
theorem getElem?_eq_toList_get? (a : Array α) (i : Nat) : a[i]? = a.toList.get? i := by
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-09")]
|
||||
abbrev getElem?_eq_data_get? := @getElem?_eq_toList_get?
|
||||
|
||||
set_option linter.deprecated false in
|
||||
theorem get?_eq_toList_get? (a : Array α) (i : Nat) : a.get? i = a.toList.get? i :=
|
||||
getElem?_eq_toList_get? ..
|
||||
|
||||
@[deprecated get?_eq_toList_get? (since := "2024-09-09")]
|
||||
abbrev get?_eq_data_get? := @get?_eq_toList_get?
|
||||
theorem get?_eq_get?_toList (a : Array α) (i : Nat) : a.get? i = a.toList.get? i := by
|
||||
simp [getElem?_eq_getElem?_toList]
|
||||
|
||||
theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by
|
||||
simp [get!_eq_getD]
|
||||
simp only [get!_eq_getElem?, get?_eq_getElem?]
|
||||
|
||||
theorem getElem?_eq_some_iff {as : Array α} : as[n]? = some a ↔ ∃ h : n < as.size, as[n] = a := by
|
||||
cases as
|
||||
simp [List.getElem?_eq_some_iff]
|
||||
|
||||
@[simp] theorem back_eq_back? [Inhabited α] (a : Array α) : a.back = a.back?.getD default := by
|
||||
simp [back, back?]
|
||||
simp only [back, get!_eq_getElem?, get?_eq_getElem?, back?]
|
||||
|
||||
@[simp] theorem back?_push (a : Array α) : (a.push x).back? = some x := by
|
||||
simp [back?, getElem?_eq_toList_getElem?]
|
||||
simp [back?, getElem?_eq_getElem?_toList]
|
||||
|
||||
theorem back_push [Inhabited α] (a : Array α) : (a.push x).back = x := by simp
|
||||
|
||||
theorem get?_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
|
||||
theorem getElem?_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
|
||||
(a.push x)[i]? = some a[i] := by
|
||||
rw [getElem?_pos, get_push_lt]
|
||||
rw [getElem?_pos, getElem_push_lt]
|
||||
|
||||
theorem get?_push_eq (a : Array α) (x : α) : (a.push x)[a.size]? = some x := by
|
||||
rw [getElem?_pos, get_push_eq]
|
||||
@[deprecated getElem?_push_lt (since := "2024-10-21")] abbrev get?_push_lt := @getElem?_push_lt
|
||||
|
||||
theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x else a[i]? := by
|
||||
theorem getElem?_push_eq (a : Array α) (x : α) : (a.push x)[a.size]? = some x := by
|
||||
rw [getElem?_pos, getElem_push_eq]
|
||||
|
||||
@[deprecated getElem?_push_eq (since := "2024-10-21")] abbrev get?_push_eq := @getElem?_push_eq
|
||||
|
||||
theorem getElem?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x else a[i]? := by
|
||||
match Nat.lt_trichotomy i a.size with
|
||||
| Or.inl g =>
|
||||
have h1 : i < a.size + 1 := by omega
|
||||
have h2 : i ≠ a.size := by omega
|
||||
simp [getElem?_def, size_push, g, h1, h2, get_push_lt]
|
||||
simp [getElem?_def, size_push, g, h1, h2, getElem_push_lt]
|
||||
| Or.inr (Or.inl heq) =>
|
||||
simp [heq, getElem?_pos, get_push_eq]
|
||||
simp [heq, getElem?_pos, getElem_push_eq]
|
||||
| Or.inr (Or.inr g) =>
|
||||
simp only [getElem?_def, size_push]
|
||||
have h1 : ¬ (i < a.size) := by omega
|
||||
@@ -520,13 +499,14 @@ theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x el
|
||||
have h3 : i ≠ a.size := by omega
|
||||
simp [h1, h2, h3]
|
||||
|
||||
@[simp] theorem get?_size {a : Array α} : a[a.size]? = none := by
|
||||
@[deprecated getElem?_push (since := "2024-10-21")] abbrev get?_push := @getElem?_push
|
||||
|
||||
@[simp] theorem getElem?_size {a : Array α} : a[a.size]? = none := by
|
||||
simp only [getElem?_def, Nat.lt_irrefl, dite_false]
|
||||
|
||||
@[simp] theorem toList_set (a : Array α) (i v) : (a.set i v).toList = a.toList.set i.1 v := rfl
|
||||
@[deprecated getElem?_size (since := "2024-10-21")] abbrev get?_size := @getElem?_size
|
||||
|
||||
@[deprecated toList_set (since := "2024-09-09")]
|
||||
abbrev data_set := @toList_set
|
||||
@[simp] theorem toList_set (a : Array α) (i v) : (a.set i v).toList = a.toList.set i.1 v := rfl
|
||||
|
||||
theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) :
|
||||
(a.set i v)[i.1] = v := by
|
||||
@@ -568,16 +548,16 @@ theorem swap_def (a : Array α) (i j : Fin a.size) :
|
||||
@[simp] theorem toList_swap (a : Array α) (i j : Fin a.size) :
|
||||
(a.swap i j).toList = (a.toList.set i (a.get j)).set j (a.get i) := by simp [swap_def]
|
||||
|
||||
@[deprecated toList_swap (since := "2024-09-09")]
|
||||
abbrev data_swap := @toList_swap
|
||||
|
||||
theorem get?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]? =
|
||||
theorem getElem?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]? =
|
||||
if j = k then some a[i.1] else if i = k then some a[j.1] else a[k]? := by
|
||||
simp [swap_def, get?_set, ← getElem_fin_eq_toList_get]
|
||||
simp [swap_def, get?_set, ← getElem_fin_eq_getElem_toList]
|
||||
|
||||
@[simp] theorem swapAt_def (a : Array α) (i : Fin a.size) (v : α) :
|
||||
a.swapAt i v = (a[i.1], a.set i v) := rfl
|
||||
|
||||
@[simp] theorem size_swapAt (a : Array α) (i : Fin a.size) (v : α) :
|
||||
(a.swapAt i v).2.size = a.size := by simp [swapAt_def]
|
||||
|
||||
@[simp]
|
||||
theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
|
||||
a.swapAt! i v = (a[i], a.set ⟨i, h⟩ v) := by simp [swapAt!, h]
|
||||
@@ -591,9 +571,6 @@ theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
|
||||
|
||||
@[simp] theorem toList_pop (a : Array α) : a.pop.toList = a.toList.dropLast := by simp [pop]
|
||||
|
||||
@[deprecated toList_pop (since := "2024-09-09")]
|
||||
abbrev data_pop := @toList_pop
|
||||
|
||||
@[simp] theorem pop_empty : (#[] : Array α).pop = #[] := rfl
|
||||
|
||||
@[simp] theorem pop_push (a : Array α) : (a.push x).pop = a := by simp [pop]
|
||||
@@ -613,11 +590,11 @@ theorem eq_push_pop_back_of_size_ne_zero [Inhabited α] {as : Array α} (h : as.
|
||||
· simp [Nat.sub_add_cancel (Nat.zero_lt_of_ne_zero h)]
|
||||
· intros i h h'
|
||||
if hlt : i < as.pop.size then
|
||||
rw [get_push_lt (h:=hlt), getElem_pop]
|
||||
rw [getElem_push_lt (h:=hlt), getElem_pop]
|
||||
else
|
||||
have heq : i = as.pop.size :=
|
||||
Nat.le_antisymm (size_pop .. ▸ Nat.le_pred_of_lt h) (Nat.le_of_not_gt hlt)
|
||||
cases heq; rw [get_push_eq, back, ←size_pop, get!_eq_getD, getD, dif_pos h]; rfl
|
||||
cases heq; rw [getElem_push_eq, back, ←size_pop, get!_eq_getD, getD, dif_pos h]; rfl
|
||||
|
||||
theorem eq_push_of_size_ne_zero {as : Array α} (h : as.size ≠ 0) :
|
||||
∃ (bs : Array α) (c : α), as = bs.push c :=
|
||||
@@ -626,9 +603,6 @@ theorem eq_push_of_size_ne_zero {as : Array α} (h : as.size ≠ 0) :
|
||||
|
||||
theorem size_eq_length_toList (as : Array α) : as.size = as.toList.length := rfl
|
||||
|
||||
@[deprecated size_eq_length_toList (since := "2024-09-09")]
|
||||
abbrev size_eq_length_data := @size_eq_length_toList
|
||||
|
||||
@[simp] theorem size_swap! (a : Array α) (i j) :
|
||||
(a.swap! i j).size = a.size := by unfold swap!; split <;> (try split) <;> simp [size_swap]
|
||||
|
||||
@@ -653,14 +627,10 @@ abbrev size_eq_length_data := @size_eq_length_toList
|
||||
@[simp] theorem toList_range (n : Nat) : (range n).toList = List.range n := by
|
||||
induction n <;> simp_all [range, Nat.fold, flip, List.range_succ]
|
||||
|
||||
@[deprecated toList_range (since := "2024-09-09")]
|
||||
abbrev data_range := @toList_range
|
||||
|
||||
@[simp]
|
||||
theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Array.range n)[x] = x := by
|
||||
simp [getElem_eq_getElem_toList]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[simp] theorem toList_reverse (a : Array α) : a.reverse.toList = a.toList.reverse := by
|
||||
let rec go (as : Array α) (i j hj)
|
||||
(h : i + j + 1 = a.size) (h₂ : as.size = a.size)
|
||||
@@ -673,9 +643,9 @@ set_option linter.deprecated false in
|
||||
· rwa [Nat.add_right_comm i]
|
||||
· simp [size_swap, h₂]
|
||||
· intro k
|
||||
rw [← getElem?_eq_toList_getElem?, get?_swap]
|
||||
rw [← getElem?_eq_getElem?_toList, getElem?_swap]
|
||||
simp only [H, getElem_eq_getElem_toList, ← List.getElem?_eq_getElem, Nat.le_of_lt h₁,
|
||||
getElem?_eq_toList_getElem?]
|
||||
getElem?_eq_getElem?_toList]
|
||||
split <;> rename_i h₂
|
||||
· simp only [← h₂, Nat.not_le.2 (Nat.lt_succ_self _), Nat.le_refl, and_false]
|
||||
exact (List.getElem?_reverse' (j+1) i (Eq.trans (by simp_arith) h)).symm
|
||||
@@ -702,9 +672,6 @@ set_option linter.deprecated false in
|
||||
true_and, Nat.not_lt] at h
|
||||
rw [List.getElem?_eq_none_iff.2 ‹_›, List.getElem?_eq_none_iff.2 (a.toList.length_reverse ▸ ‹_›)]
|
||||
|
||||
@[deprecated toList_reverse (since := "2024-09-30")]
|
||||
abbrev reverse_toList := @toList_reverse
|
||||
|
||||
/-! ### foldl / foldr -/
|
||||
|
||||
@[simp] theorem foldlM_loop_empty [Monad m] (f : β → α → m β) (init : β) (i j : Nat) :
|
||||
@@ -733,7 +700,7 @@ abbrev reverse_toList := @toList_reverse
|
||||
foldrM f init #[] start stop = return init := by
|
||||
simp [foldrM]
|
||||
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldlM`,
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldlM` in Batteries,
|
||||
-- reproduced to avoid a dependency on `SatisfiesM`.
|
||||
theorem foldl_induction
|
||||
{as : Array α} (motive : Nat → β → Prop) {init : β} (h0 : motive 0 init) {f : β → α → β}
|
||||
@@ -749,7 +716,7 @@ theorem foldl_induction
|
||||
· next hj => exact Nat.le_antisymm h₁ (Nat.ge_of_not_lt hj) ▸ H
|
||||
simpa [foldl, foldlM] using go (Nat.zero_le _) (Nat.le_refl _) h0
|
||||
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldrM`,
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldrM` in Batteries,
|
||||
-- reproduced to avoid a dependency on `SatisfiesM`.
|
||||
theorem foldr_induction
|
||||
{as : Array α} (motive : Nat → β → Prop) {init : β} (h0 : motive as.size init) {f : α → β → β}
|
||||
@@ -795,9 +762,6 @@ theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α → m β) (arr : A
|
||||
toList <$> arr.mapM f = arr.toList.mapM f := by
|
||||
simp [mapM_eq_mapM_toList]
|
||||
|
||||
@[deprecated mapM_eq_mapM_toList (since := "2024-09-09")]
|
||||
abbrev mapM_eq_mapM_data := @mapM_eq_mapM_toList
|
||||
|
||||
theorem mapM_map_eq_foldl (as : Array α) (f : α → β) (i) :
|
||||
mapM.map (m := Id) f as i b = as.foldl (start := i) (fun r a => r.push (f a)) b := by
|
||||
unfold mapM.map
|
||||
@@ -839,9 +803,9 @@ theorem map_induction (as : Array α) (f : α → β) (motive : Nat → Prop) (h
|
||||
· intro j h
|
||||
simp at h ⊢
|
||||
by_cases h' : j < size b
|
||||
· rw [get_push]
|
||||
· rw [getElem_push]
|
||||
simp_all
|
||||
· rw [get_push, dif_neg h']
|
||||
· rw [getElem_push, dif_neg h']
|
||||
simp only [show j = i by omega]
|
||||
exact (hs _ m).1
|
||||
|
||||
@@ -866,59 +830,14 @@ theorem map_spec (as : Array α) (f : α → β) (p : Fin as.size → β → Pro
|
||||
(as.push x).map f = (as.map f).push (f x) := by
|
||||
ext
|
||||
· simp
|
||||
· simp only [getElem_map, get_push, size_map]
|
||||
· simp only [getElem_map, getElem_push, size_map]
|
||||
split <;> rfl
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
|
||||
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.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.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 [mapIdxM.map]
|
||||
| zero =>
|
||||
have := (Nat.zero_add _).symm.trans h
|
||||
exact ⟨this ▸ hm, h₁ ▸ this, fun _ _ => h₂ ..⟩
|
||||
| succ i ih =>
|
||||
apply @ih (bs.push (f ⟨j, by omega⟩ as[j])) (j + 1) (by omega) (by simp; omega)
|
||||
· intro i i_lt h'
|
||||
rw [get_push]
|
||||
split
|
||||
· apply h₂
|
||||
· simp only [size_push] at h'
|
||||
obtain rfl : i = j := by omega
|
||||
apply (hs ⟨i, by omega⟩ hm).1
|
||||
· exact (hs ⟨j, by omega⟩ hm).2
|
||||
simp [mapIdx, mapIdxM]; exact go rfl nofun h0
|
||||
|
||||
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 : Fin a.size → α → β) : (a.mapIdx f).size = a.size :=
|
||||
(mapIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
|
||||
|
||||
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
|
||||
Array.size_mapIdx _ _
|
||||
|
||||
@[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]?.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
|
||||
@[simp] theorem map_pop {f : α → β} {as : Array α} :
|
||||
as.pop.map f = (as.map f).pop := by
|
||||
ext
|
||||
· simp
|
||||
· simp only [getElem_map, getElem_pop, size_map]
|
||||
|
||||
/-! ### modify -/
|
||||
|
||||
@@ -933,6 +852,12 @@ 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]
|
||||
@@ -942,11 +867,10 @@ theorem getElem_modify_of_ne {as : Array α} {i : Nat} (h : i ≠ j)
|
||||
(as.modify i f)[j] = as[j]'(by simpa using hj) := by
|
||||
simp [getElem_modify hj, h]
|
||||
|
||||
@[deprecated getElem_modify (since := "2024-08-08")]
|
||||
theorem get_modify {arr : Array α} {x i} (h : i < (arr.modify x f).size) :
|
||||
(arr.modify x f).get ⟨i, h⟩ =
|
||||
if x = i then f (arr.get ⟨i, by simpa using h⟩) else arr.get ⟨i, by simpa using h⟩ := by
|
||||
simp [getElem_modify h]
|
||||
theorem getElem?_modify {as : Array α} {i : Nat} {f : α → α} {j : Nat} :
|
||||
(as.modify i f)[j]? = if i = j then as[j]?.map f else as[j]? := by
|
||||
simp only [getElem?_def, size_modify, getElem_modify, Option.map_dif]
|
||||
split <;> split <;> rfl
|
||||
|
||||
/-! ### filter -/
|
||||
|
||||
@@ -961,9 +885,6 @@ theorem get_modify {arr : Array α} {x i} (h : i < (arr.modify x f).size) :
|
||||
induction l with simp
|
||||
| cons => split <;> simp [*]
|
||||
|
||||
@[deprecated toList_filter (since := "2024-09-09")]
|
||||
abbrev filter_data := @toList_filter
|
||||
|
||||
@[simp] theorem filter_filter (q) (l : Array α) :
|
||||
filter p (filter q l) = filter (fun a => p a && q a) l := by
|
||||
apply ext'
|
||||
@@ -997,9 +918,6 @@ theorem filter_congr {as bs : Array α} (h : as = bs)
|
||||
· simp_all [Id.run, List.filterMap_cons]
|
||||
split <;> simp_all
|
||||
|
||||
@[deprecated toList_filterMap (since := "2024-09-09")]
|
||||
abbrev filterMap_data := @toList_filterMap
|
||||
|
||||
@[simp] theorem mem_filterMap {f : α → Option β} {l : Array α} {b : β} :
|
||||
b ∈ filterMap f l ↔ ∃ a, a ∈ l ∧ f a = some b := by
|
||||
simp only [mem_def, toList_filterMap, List.mem_filterMap]
|
||||
@@ -1015,10 +933,7 @@ theorem filterMap_congr {as bs : Array α} (h : as = bs)
|
||||
|
||||
theorem size_empty : (#[] : Array α).size = 0 := rfl
|
||||
|
||||
theorem toList_empty : (#[] : Array α).toList = [] := rfl
|
||||
|
||||
@[deprecated toList_empty (since := "2024-09-09")]
|
||||
abbrev empty_data := @toList_empty
|
||||
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
|
||||
|
||||
/-! ### append -/
|
||||
|
||||
@@ -1042,9 +957,6 @@ theorem getElem_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt :
|
||||
conv => rhs; rw [← List.getElem_append_left (bs := bs.toList) (h' := h')]
|
||||
apply List.get_of_eq; rw [toList_append]
|
||||
|
||||
@[deprecated getElem_append_left (since := "2024-09-30")]
|
||||
abbrev get_append_left := @getElem_append_left
|
||||
|
||||
theorem getElem_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle : as.size ≤ i)
|
||||
(hlt : i - as.size < bs.size := Nat.sub_lt_left_of_lt_add hle (size_append .. ▸ h)) :
|
||||
(as ++ bs)[i] = bs[i - as.size] := by
|
||||
@@ -1053,9 +965,6 @@ theorem getElem_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle :
|
||||
conv => rhs; rw [← List.getElem_append_right (h₁ := hle) (h₂ := h')]
|
||||
apply List.get_of_eq; rw [toList_append]
|
||||
|
||||
@[deprecated getElem_append_right (since := "2024-09-30")]
|
||||
abbrev get_append_right := @getElem_append_right
|
||||
|
||||
@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
|
||||
apply ext'; simp only [toList_append, toList_empty, List.append_nil]
|
||||
|
||||
@@ -1182,7 +1091,7 @@ theorem getElem_extract_loop_ge (as bs : Array α) (size start : Nat) (hge : i
|
||||
have h₂ : bs.size < (extract.loop as size (start+1) (bs.push as[start])).size := by
|
||||
rw [size_extract_loop]; apply Nat.lt_of_lt_of_le h₁; exact Nat.le_add_right ..
|
||||
have h : (extract.loop as size (start + 1) (push bs as[start]))[bs.size] = as[start] := by
|
||||
rw [getElem_extract_loop_lt as (bs.push as[start]) size (start+1) h₁ h₂, get_push_eq]
|
||||
rw [getElem_extract_loop_lt as (bs.push as[start]) size (start+1) h₁ h₂, getElem_push_eq]
|
||||
rw [h]; congr; rw [Nat.add_sub_cancel]
|
||||
else
|
||||
have hge : bs.size + 1 ≤ i := Nat.lt_of_le_of_ne hge hi
|
||||
@@ -1209,6 +1118,14 @@ theorem getElem?_extract {as : Array α} {start stop : Nat} :
|
||||
· omega
|
||||
· rfl
|
||||
|
||||
@[simp] theorem toList_extract (as : Array α) (start stop : Nat) :
|
||||
(as.extract start stop).toList = (as.toList.drop start).take (stop - start) := by
|
||||
apply List.ext_getElem
|
||||
· simp only [length_toList, size_extract, List.length_take, List.length_drop]
|
||||
omega
|
||||
· intros n h₁ h₂
|
||||
simp
|
||||
|
||||
@[simp] theorem extract_all (as : Array α) : as.extract 0 as.size = as := by
|
||||
apply ext
|
||||
· rw [size_extract, Nat.min_self, Nat.sub_zero]
|
||||
@@ -1298,9 +1215,6 @@ theorem any_toList {p : α → Bool} (as : Array α) : as.toList.any p = as.any
|
||||
rw [Bool.eq_iff_iff, any_eq_true, List.any_eq_true]; simp only [List.mem_iff_get]
|
||||
exact ⟨fun ⟨_, ⟨i, rfl⟩, h⟩ => ⟨i, h⟩, fun ⟨i, h⟩ => ⟨_, ⟨i, rfl⟩, h⟩⟩
|
||||
|
||||
@[deprecated "Use the reverse direction of `Array.any_toList`" (since := "2024-09-30")]
|
||||
abbrev any_def := @any_toList
|
||||
|
||||
/-! ### all -/
|
||||
|
||||
theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as : Array α) :
|
||||
@@ -1340,9 +1254,6 @@ theorem all_toList {p : α → Bool} (as : Array α) : as.toList.all p = as.all
|
||||
rw [← getElem_eq_getElem_toList]
|
||||
exact w ⟨r, h⟩
|
||||
|
||||
@[deprecated "Use the reverse direction of `Array.all_toList`" (since := "2024-09-30")]
|
||||
abbrev all_def := @all_toList
|
||||
|
||||
theorem all_eq_true_iff_forall_mem {l : Array α} : l.all p ↔ ∀ x, x ∈ l → p x := by
|
||||
simp only [← all_toList, List.all_eq_true, mem_def]
|
||||
|
||||
@@ -1384,7 +1295,7 @@ open Fin
|
||||
· assumption
|
||||
|
||||
theorem getElem_swap' (a : Array α) (i j : Fin a.size) (k : Nat) (hk : k < a.size) :
|
||||
(a.swap i j)[k]'(by simp_all) = if k = i then a[j] else if k = j then a[i] else a[k] := by
|
||||
(a.swap i j)[k]'(by simp_all) = if k = i then a[j] else if k = j then a[i] else a[k] := by
|
||||
split
|
||||
· simp_all only [getElem_swap_left]
|
||||
· split <;> simp_all
|
||||
@@ -1394,7 +1305,7 @@ theorem getElem_swap (a : Array α) (i j : Fin a.size) (k : Nat) (hk : k < (a.sw
|
||||
apply getElem_swap'
|
||||
|
||||
@[simp] theorem swap_swap (a : Array α) {i j : Fin a.size} :
|
||||
(a.swap i j).swap ⟨i.1, (a.size_swap ..).symm ▸i.2⟩ ⟨j.1, (a.size_swap ..).symm ▸j.2⟩ = a := by
|
||||
(a.swap i j).swap ⟨i.1, (a.size_swap ..).symm ▸ i.2⟩ ⟨j.1, (a.size_swap ..).symm ▸ j.2⟩ = a := by
|
||||
apply ext
|
||||
· simp only [size_swap]
|
||||
· intros
|
||||
@@ -1412,33 +1323,8 @@ theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i :=
|
||||
· split <;> simp_all
|
||||
· split <;> simp_all
|
||||
|
||||
@[deprecated getElem_extract_loop_lt_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_lt_aux := @getElem_extract_loop_lt_aux
|
||||
@[deprecated getElem_extract_loop_lt (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_lt := @getElem_extract_loop_lt
|
||||
@[deprecated getElem_extract_loop_ge_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_ge_aux := @getElem_extract_loop_ge_aux
|
||||
@[deprecated getElem_extract_loop_ge (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_ge := @getElem_extract_loop_ge
|
||||
@[deprecated getElem_extract_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_aux := @getElem_extract_aux
|
||||
@[deprecated getElem_extract (since := "2024-09-30")]
|
||||
abbrev get_extract := @getElem_extract
|
||||
|
||||
@[deprecated getElem_swap_right (since := "2024-09-30")]
|
||||
abbrev get_swap_right := @getElem_swap_right
|
||||
@[deprecated getElem_swap_left (since := "2024-09-30")]
|
||||
abbrev get_swap_left := @getElem_swap_left
|
||||
@[deprecated getElem_swap_of_ne (since := "2024-09-30")]
|
||||
abbrev get_swap_of_ne := @getElem_swap_of_ne
|
||||
@[deprecated getElem_swap (since := "2024-09-30")]
|
||||
abbrev get_swap := @getElem_swap
|
||||
@[deprecated getElem_swap' (since := "2024-09-30")]
|
||||
abbrev get_swap' := @getElem_swap'
|
||||
|
||||
end Array
|
||||
|
||||
|
||||
open Array
|
||||
|
||||
namespace List
|
||||
@@ -1554,6 +1440,11 @@ 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
|
||||
@@ -1582,4 +1473,164 @@ theorem filterMap_toArray (f : α → Option β) (l : List α) :
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem toArray_extract (l : List α) (start stop : Nat) :
|
||||
l.toArray.extract start stop = ((l.drop start).take (stop - start)).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
end List
|
||||
|
||||
/-! ### Deprecations -/
|
||||
|
||||
namespace List
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
|
||||
@[deprecated "Use the reverse direction of `List.push_toArray`." (since := "2024-09-27")]
|
||||
theorem toArray_concat {as : List α} {x : α} :
|
||||
(as ++ [x]).toArray = as.toArray.push x := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
end List
|
||||
|
||||
namespace Array
|
||||
|
||||
@[deprecated getElem_eq_getElem_toList (since := "2024-09-25")]
|
||||
abbrev getElem_eq_toList_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-09-09")]
|
||||
abbrev getElem_eq_data_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-06-12")]
|
||||
theorem getElem_eq_toList_get (a : Array α) (h : i < a.size) : a[i] = a.toList.get ⟨i, h⟩ := by
|
||||
simp
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
|
||||
@[deprecated length_toList (since := "2024-09-09")]
|
||||
abbrev data_length := @length_toList
|
||||
|
||||
@[deprecated toList_map (since := "2024-09-09")]
|
||||
abbrev map_data := @toList_map
|
||||
|
||||
@[deprecated foldl_toList_eq_flatMap (since := "2024-10-16")]
|
||||
abbrev foldl_toList_eq_bind := @foldl_toList_eq_flatMap
|
||||
|
||||
@[deprecated foldl_toList_eq_flatMap (since := "2024-10-16")]
|
||||
abbrev foldl_data_eq_bind := @foldl_toList_eq_flatMap
|
||||
|
||||
@[deprecated foldl_toList_eq_map (since := "2024-09-09")]
|
||||
abbrev foldl_data_eq_map := @foldl_toList_eq_map
|
||||
|
||||
@[deprecated toList_mkArray (since := "2024-09-09")]
|
||||
abbrev mkArray_data := @toList_mkArray
|
||||
|
||||
@[deprecated mem_toList (since := "2024-09-09")]
|
||||
abbrev mem_data := @mem_toList
|
||||
|
||||
@[deprecated getElem_mem (since := "2024-10-17")]
|
||||
abbrev getElem?_mem := @getElem_mem
|
||||
|
||||
@[deprecated getElem_fin_eq_getElem_toList (since := "2024-10-17")]
|
||||
abbrev getElem_fin_eq_toList_get := @getElem_fin_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_fin_eq_getElem_toList (since := "2024-09-09")]
|
||||
abbrev getElem_fin_eq_data_get := @getElem_fin_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_mem_toList (since := "2024-09-09")]
|
||||
abbrev getElem_mem_data := @getElem_mem_toList
|
||||
|
||||
@[deprecated getElem?_eq_getElem?_toList (since := "2024-10-17")]
|
||||
abbrev getElem?_eq_toList_getElem? := @getElem?_eq_getElem?_toList
|
||||
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-30")]
|
||||
theorem getElem?_eq_toList_get? (a : Array α) (i : Nat) : a[i]? = a.toList.get? i := by
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-09")]
|
||||
abbrev getElem?_eq_data_get? := @getElem?_eq_toList_get?
|
||||
|
||||
@[deprecated get?_eq_get?_toList (since := "2024-10-17")]
|
||||
abbrev get?_eq_toList_get? := @get?_eq_get?_toList
|
||||
|
||||
@[deprecated get?_eq_toList_get? (since := "2024-09-09")]
|
||||
abbrev get?_eq_data_get? := @get?_eq_get?_toList
|
||||
|
||||
@[deprecated toList_set (since := "2024-09-09")]
|
||||
abbrev data_set := @toList_set
|
||||
|
||||
@[deprecated toList_swap (since := "2024-09-09")]
|
||||
abbrev data_swap := @toList_swap
|
||||
|
||||
@[deprecated getElem?_swap (since := "2024-10-17")] abbrev get?_swap := @getElem?_swap
|
||||
|
||||
@[deprecated toList_pop (since := "2024-09-09")] abbrev data_pop := @toList_pop
|
||||
|
||||
@[deprecated size_eq_length_toList (since := "2024-09-09")]
|
||||
abbrev size_eq_length_data := @size_eq_length_toList
|
||||
|
||||
@[deprecated toList_range (since := "2024-09-09")]
|
||||
abbrev data_range := @toList_range
|
||||
|
||||
@[deprecated toList_reverse (since := "2024-09-30")]
|
||||
abbrev reverse_toList := @toList_reverse
|
||||
|
||||
@[deprecated mapM_eq_mapM_toList (since := "2024-09-09")]
|
||||
abbrev mapM_eq_mapM_data := @mapM_eq_mapM_toList
|
||||
|
||||
@[deprecated getElem_modify (since := "2024-08-08")]
|
||||
theorem get_modify {arr : Array α} {x i} (h : i < (arr.modify x f).size) :
|
||||
(arr.modify x f).get ⟨i, h⟩ =
|
||||
if x = i then f (arr.get ⟨i, by simpa using h⟩) else arr.get ⟨i, by simpa using h⟩ := by
|
||||
simp [getElem_modify h]
|
||||
|
||||
@[deprecated toList_filter (since := "2024-09-09")]
|
||||
abbrev filter_data := @toList_filter
|
||||
|
||||
@[deprecated toList_filterMap (since := "2024-09-09")]
|
||||
abbrev filterMap_data := @toList_filterMap
|
||||
|
||||
@[deprecated toList_empty (since := "2024-09-09")]
|
||||
abbrev empty_data := @toList_empty
|
||||
|
||||
@[deprecated getElem_append_left (since := "2024-09-30")]
|
||||
abbrev get_append_left := @getElem_append_left
|
||||
|
||||
@[deprecated getElem_append_right (since := "2024-09-30")]
|
||||
abbrev get_append_right := @getElem_append_right
|
||||
|
||||
@[deprecated "Use the reverse direction of `Array.any_toList`" (since := "2024-09-30")]
|
||||
abbrev any_def := @any_toList
|
||||
|
||||
@[deprecated "Use the reverse direction of `Array.all_toList`" (since := "2024-09-30")]
|
||||
abbrev all_def := @all_toList
|
||||
|
||||
@[deprecated getElem_extract_loop_lt_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_lt_aux := @getElem_extract_loop_lt_aux
|
||||
@[deprecated getElem_extract_loop_lt (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_lt := @getElem_extract_loop_lt
|
||||
@[deprecated getElem_extract_loop_ge_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_ge_aux := @getElem_extract_loop_ge_aux
|
||||
@[deprecated getElem_extract_loop_ge (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_ge := @getElem_extract_loop_ge
|
||||
@[deprecated getElem_extract_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_aux := @getElem_extract_aux
|
||||
@[deprecated getElem_extract (since := "2024-09-30")]
|
||||
abbrev get_extract := @getElem_extract
|
||||
|
||||
@[deprecated getElem_swap_right (since := "2024-09-30")]
|
||||
abbrev get_swap_right := @getElem_swap_right
|
||||
@[deprecated getElem_swap_left (since := "2024-09-30")]
|
||||
abbrev get_swap_left := @getElem_swap_left
|
||||
@[deprecated getElem_swap_of_ne (since := "2024-09-30")]
|
||||
abbrev get_swap_of_ne := @getElem_swap_of_ne
|
||||
@[deprecated getElem_swap (since := "2024-09-30")]
|
||||
abbrev get_swap := @getElem_swap
|
||||
@[deprecated getElem_swap' (since := "2024-09-30")]
|
||||
abbrev get_swap' := @getElem_swap'
|
||||
|
||||
end Array
|
||||
|
||||
92
src/Init/Data/Array/MapIdx.lean
Normal file
92
src/Init/Data/Array/MapIdx.lean
Normal file
@@ -0,0 +1,92 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro, Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Array.Lemmas
|
||||
import Init.Data.List.MapIdx
|
||||
|
||||
namespace Array
|
||||
|
||||
/-! ### mapFinIdx -/
|
||||
|
||||
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
|
||||
theorem mapFinIdx_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
|
||||
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
|
||||
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]
|
||||
| zero =>
|
||||
have := (Nat.zero_add _).symm.trans h
|
||||
exact ⟨this ▸ hm, h₁ ▸ this, fun _ _ => h₂ ..⟩
|
||||
| succ i ih =>
|
||||
apply @ih (bs.push (f ⟨j, by omega⟩ as[j])) (j + 1) (by omega) (by simp; omega)
|
||||
· intro i i_lt h'
|
||||
rw [getElem_push]
|
||||
split
|
||||
· apply h₂
|
||||
· simp only [size_push] at h'
|
||||
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
|
||||
|
||||
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 → α → β)
|
||||
(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 :=
|
||||
(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 getElem?_mapIdx (a : Array α) (f : Nat → α → β) (i : Nat) :
|
||||
(a.mapIdx f)[i]? =
|
||||
a[i]?.map (f i) := by
|
||||
simp [getElem?_def, size_mapIdx, getElem_mapIdx]
|
||||
|
||||
end Array
|
||||
@@ -8,12 +8,13 @@ import Init.Data.Fin.Basic
|
||||
import Init.Data.Nat.Bitwise.Lemmas
|
||||
import Init.Data.Nat.Power2
|
||||
import Init.Data.Int.Bitwise
|
||||
import Init.Data.BitVec.BasicAux
|
||||
|
||||
/-!
|
||||
We define bitvectors. We choose the `Fin` representation over others for its relative efficiency
|
||||
(Lean has special support for `Nat`), alignment with `UIntXY` types which are also represented
|
||||
with `Fin`, and the fact that bitwise operations on `Fin` are already defined. Some other possible
|
||||
representations are `List Bool`, `{ l : List Bool // l.length = w }`, `Fin w → Bool`.
|
||||
We define the basic algebraic structure of bitvectors. We choose the `Fin` representation over
|
||||
others for its relative efficiency (Lean has special support for `Nat`), and the fact that bitwise
|
||||
operations on `Fin` are already defined. Some other possible representations are `List Bool`,
|
||||
`{ l : List Bool // l.length = w }`, `Fin w → Bool`.
|
||||
|
||||
We define many of the bitvector operations from the
|
||||
[`QF_BV` logic](https://smtlib.cs.uiowa.edu/logics-all.shtml#QF_BV).
|
||||
@@ -22,60 +23,12 @@ of SMT-LIBv2.
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
/--
|
||||
A bitvector of the specified width.
|
||||
|
||||
This is represented as the underlying `Nat` number in both the runtime
|
||||
and the kernel, inheriting all the special support for `Nat`.
|
||||
-/
|
||||
structure BitVec (w : Nat) where
|
||||
/-- Construct a `BitVec w` from a number less than `2^w`.
|
||||
O(1), because we use `Fin` as the internal representation of a bitvector. -/
|
||||
ofFin ::
|
||||
/-- Interpret a bitvector as a number less than `2^w`.
|
||||
O(1), because we use `Fin` as the internal representation of a bitvector. -/
|
||||
toFin : Fin (2^w)
|
||||
|
||||
/--
|
||||
Bitvectors have decidable equality. This should be used via the instance `DecidableEq (BitVec n)`.
|
||||
-/
|
||||
-- We manually derive the `DecidableEq` instances for `BitVec` because
|
||||
-- we want to have builtin support for bit-vector literals, and we
|
||||
-- need a name for this function to implement `canUnfoldAtMatcher` at `WHNF.lean`.
|
||||
def BitVec.decEq (x y : BitVec n) : Decidable (x = y) :=
|
||||
match x, y with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
if h : n = m then
|
||||
isTrue (h ▸ rfl)
|
||||
else
|
||||
isFalse (fun h' => BitVec.noConfusion h' (fun h' => absurd h' h))
|
||||
|
||||
instance : DecidableEq (BitVec n) := BitVec.decEq
|
||||
|
||||
namespace BitVec
|
||||
|
||||
section Nat
|
||||
|
||||
/-- The `BitVec` with value `i`, given a proof that `i < 2^n`. -/
|
||||
@[match_pattern]
|
||||
protected def ofNatLt {n : Nat} (i : Nat) (p : i < 2^n) : BitVec n where
|
||||
toFin := ⟨i, p⟩
|
||||
|
||||
/-- The `BitVec` with value `i mod 2^n`. -/
|
||||
@[match_pattern]
|
||||
protected def ofNat (n : Nat) (i : Nat) : BitVec n where
|
||||
toFin := Fin.ofNat' (2^n) i
|
||||
|
||||
instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
|
||||
instance natCastInst : NatCast (BitVec w) := ⟨BitVec.ofNat w⟩
|
||||
|
||||
/-- Given a bitvector `x`, return the underlying `Nat`. This is O(1) because `BitVec` is a
|
||||
(zero-cost) wrapper around a `Nat`. -/
|
||||
protected def toNat (x : BitVec n) : Nat := x.toFin.val
|
||||
|
||||
/-- Return the bound in terms of toNat. -/
|
||||
theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt
|
||||
|
||||
@[deprecated isLt (since := "2024-03-12")]
|
||||
theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.isLt
|
||||
|
||||
@@ -238,22 +191,6 @@ end repr_toString
|
||||
|
||||
section arithmetic
|
||||
|
||||
/--
|
||||
Addition for bit vectors. This can be interpreted as either signed or unsigned addition
|
||||
modulo `2^n`.
|
||||
|
||||
SMT-Lib name: `bvadd`.
|
||||
-/
|
||||
protected def add (x y : BitVec n) : BitVec n := .ofNat n (x.toNat + y.toNat)
|
||||
instance : Add (BitVec n) := ⟨BitVec.add⟩
|
||||
|
||||
/--
|
||||
Subtraction for bit vectors. This can be interpreted as either signed or unsigned subtraction
|
||||
modulo `2^n`.
|
||||
-/
|
||||
protected def sub (x y : BitVec n) : BitVec n := .ofNat n ((2^n - y.toNat) + x.toNat)
|
||||
instance : Sub (BitVec n) := ⟨BitVec.sub⟩
|
||||
|
||||
/--
|
||||
Negation for bit vectors. This can be interpreted as either signed or unsigned negation
|
||||
modulo `2^n`.
|
||||
@@ -387,10 +324,6 @@ SMT-Lib name: `bvult`.
|
||||
-/
|
||||
protected def ult (x y : BitVec n) : Bool := x.toNat < y.toNat
|
||||
|
||||
instance : LT (BitVec n) where lt := (·.toNat < ·.toNat)
|
||||
instance (x y : BitVec n) : Decidable (x < y) :=
|
||||
inferInstanceAs (Decidable (x.toNat < y.toNat))
|
||||
|
||||
/--
|
||||
Unsigned less-than-or-equal-to for bit vectors.
|
||||
|
||||
@@ -398,10 +331,6 @@ SMT-Lib name: `bvule`.
|
||||
-/
|
||||
protected def ule (x y : BitVec n) : Bool := x.toNat ≤ y.toNat
|
||||
|
||||
instance : LE (BitVec n) where le := (·.toNat ≤ ·.toNat)
|
||||
instance (x y : BitVec n) : Decidable (x ≤ y) :=
|
||||
inferInstanceAs (Decidable (x.toNat ≤ y.toNat))
|
||||
|
||||
/--
|
||||
Signed less-than for bit vectors.
|
||||
|
||||
|
||||
52
src/Init/Data/BitVec/BasicAux.lean
Normal file
52
src/Init/Data/BitVec/BasicAux.lean
Normal file
@@ -0,0 +1,52 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Fin.Basic
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
/-!
|
||||
This module exists to provide the very basic `BitVec` definitions required for
|
||||
`Init.Data.UInt.BasicAux`.
|
||||
-/
|
||||
|
||||
namespace BitVec
|
||||
|
||||
section Nat
|
||||
|
||||
/-- The `BitVec` with value `i mod 2^n`. -/
|
||||
@[match_pattern]
|
||||
protected def ofNat (n : Nat) (i : Nat) : BitVec n where
|
||||
toFin := Fin.ofNat' (2^n) i
|
||||
|
||||
instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
|
||||
|
||||
/-- Return the bound in terms of toNat. -/
|
||||
theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt
|
||||
|
||||
end Nat
|
||||
|
||||
section arithmetic
|
||||
|
||||
/--
|
||||
Addition for bit vectors. This can be interpreted as either signed or unsigned addition
|
||||
modulo `2^n`.
|
||||
|
||||
SMT-Lib name: `bvadd`.
|
||||
-/
|
||||
protected def add (x y : BitVec n) : BitVec n := .ofNat n (x.toNat + y.toNat)
|
||||
instance : Add (BitVec n) := ⟨BitVec.add⟩
|
||||
|
||||
/--
|
||||
Subtraction for bit vectors. This can be interpreted as either signed or unsigned subtraction
|
||||
modulo `2^n`.
|
||||
-/
|
||||
protected def sub (x y : BitVec n) : BitVec n := .ofNat n ((2^n - y.toNat) + x.toNat)
|
||||
instance : Sub (BitVec n) := ⟨BitVec.sub⟩
|
||||
|
||||
end arithmetic
|
||||
|
||||
end BitVec
|
||||
@@ -267,6 +267,21 @@ theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := b
|
||||
|
||||
/-! ### add -/
|
||||
|
||||
theorem getMsbD_add {i : Nat} {i_lt : i < w} {x y : BitVec w} :
|
||||
getMsbD (x + y) i =
|
||||
Bool.xor (getMsbD x i) (Bool.xor (getMsbD y i) (carry (w - 1 - i) x y false)) := by
|
||||
simp [getMsbD, getLsbD_add, i_lt, show w - 1 - i < w by omega]
|
||||
|
||||
theorem msb_add {w : Nat} {x y: BitVec w} :
|
||||
(x + y).msb =
|
||||
Bool.xor x.msb (Bool.xor y.msb (carry (w - 1) x y false)) := by
|
||||
simp only [BitVec.msb, BitVec.getMsbD]
|
||||
by_cases h : w ≤ 0
|
||||
· simp [h, show w = 0 by omega]
|
||||
· rw [getLsbD_add (x := x)]
|
||||
simp [show w > 0 by omega]
|
||||
omega
|
||||
|
||||
/-- Adding a bitvector to its own complement yields the all ones bitpattern -/
|
||||
@[simp] theorem add_not_self (x : BitVec w) : x + ~~~x = allOnes w := by
|
||||
rw [add_eq_adc, adc, iunfoldr_replace (fun _ => false) (allOnes w)]
|
||||
@@ -292,6 +307,26 @@ theorem add_eq_or_of_and_eq_zero {w : Nat} (x y : BitVec w)
|
||||
simp_all [hx]
|
||||
· by_cases hx : x.getLsbD i <;> simp_all [hx]
|
||||
|
||||
/-! ### Sub-/
|
||||
|
||||
theorem getLsbD_sub {i : Nat} {i_lt : i < w} {x y : BitVec w} :
|
||||
(x - y).getLsbD i
|
||||
= (x.getLsbD i ^^ ((~~~y + 1#w).getLsbD i ^^ carry i x (~~~y + 1#w) false)) := by
|
||||
rw [sub_toAdd, BitVec.neg_eq_not_add, getLsbD_add]
|
||||
omega
|
||||
|
||||
theorem getMsbD_sub {i : Nat} {i_lt : i < w} {x y : BitVec w} :
|
||||
(x - y).getMsbD i =
|
||||
(x.getMsbD i ^^ ((~~~y + 1).getMsbD i ^^ carry (w - 1 - i) x (~~~y + 1) false)) := by
|
||||
rw [sub_toAdd, neg_eq_not_add, getMsbD_add]
|
||||
· rfl
|
||||
· omega
|
||||
|
||||
theorem msb_sub {x y: BitVec w} :
|
||||
(x - y).msb
|
||||
= (x.msb ^^ ((~~~y + 1#w).msb ^^ carry (w - 1 - 0) x (~~~y + 1#w) false)) := by
|
||||
simp [sub_toAdd, BitVec.neg_eq_not_add, msb_add]
|
||||
|
||||
/-! ### Negation -/
|
||||
|
||||
theorem bit_not_testBit (x : BitVec w) (i : Fin w) :
|
||||
|
||||
@@ -316,6 +316,12 @@ 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)
|
||||
|
||||
@@ -1974,6 +1980,10 @@ 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.
|
||||
@@ -1996,6 +2006,8 @@ 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]
|
||||
@@ -2008,18 +2020,8 @@ 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
|
||||
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
|
||||
rw [← BitVec.zero_sub, toInt_sub]
|
||||
simp [BitVec.toInt_ofNat]
|
||||
|
||||
@[simp] theorem toFin_neg (x : BitVec n) :
|
||||
(-x).toFin = Fin.ofNat' (2^n) (2^n - x.toNat) :=
|
||||
|
||||
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Author: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
|
||||
/-- Determines if the given integer is a valid [Unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value).
|
||||
|
||||
@@ -42,8 +42,10 @@ theorem isValidUInt32 (n : Nat) (h : isValidCharNat n) : n < UInt32.size := by
|
||||
|
||||
theorem isValidChar_of_isValidCharNat (n : Nat) (h : isValidCharNat n) : isValidChar (UInt32.ofNat' n (isValidUInt32 n h)) :=
|
||||
match h with
|
||||
| Or.inl h => Or.inl h
|
||||
| Or.inr ⟨h₁, h₂⟩ => Or.inr ⟨h₁, h₂⟩
|
||||
| Or.inl h =>
|
||||
Or.inl (UInt32.ofNat'_lt_of_lt _ (by decide) h)
|
||||
| Or.inr ⟨h₁, h₂⟩ =>
|
||||
Or.inr ⟨UInt32.lt_ofNat'_of_lt _ (by decide) h₁, UInt32.ofNat'_lt_of_lt _ (by decide) h₂⟩
|
||||
|
||||
theorem isValidChar_zero : isValidChar 0 :=
|
||||
Or.inl (by decide)
|
||||
@@ -57,7 +59,7 @@ theorem isValidChar_zero : isValidChar 0 :=
|
||||
c.val.toUInt8
|
||||
|
||||
/-- The numbers from 0 to 256 are all valid UTF-8 characters, so we can embed one in the other. -/
|
||||
def ofUInt8 (n : UInt8) : Char := ⟨n.toUInt32, .inl (Nat.lt_trans n.1.2 (by decide))⟩
|
||||
def ofUInt8 (n : UInt8) : Char := ⟨n.toUInt32, .inl (Nat.lt_trans n.toBitVec.isLt (by decide))⟩
|
||||
|
||||
instance : Inhabited Char where
|
||||
default := 'A'
|
||||
|
||||
@@ -51,6 +51,9 @@ instance : Hashable USize where
|
||||
instance : Hashable (Fin n) where
|
||||
hash v := v.val.toUInt64
|
||||
|
||||
instance : Hashable Char where
|
||||
hash c := c.val.toUInt64
|
||||
|
||||
instance : Hashable Int where
|
||||
hash
|
||||
| Int.ofNat n => UInt64.ofNat (2 * n)
|
||||
|
||||
@@ -1125,6 +1125,17 @@ 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]
|
||||
@@ -1140,9 +1151,28 @@ 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]
|
||||
|
||||
@@ -639,14 +639,16 @@ and simplifies these to the function directly taking the value.
|
||||
| nil => simp
|
||||
| cons a l ih => simp [ih, hf, filterMap_cons]
|
||||
|
||||
@[simp] theorem bind_subtype {p : α → Prop} {l : List { x // p x }}
|
||||
@[simp] theorem flatMap_subtype {p : α → Prop} {l : List { x // p x }}
|
||||
{f : { x // p x } → List β} {g : α → List β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
|
||||
(l.bind f) = l.unattach.bind g := by
|
||||
(l.flatMap f) = l.unattach.flatMap g := by
|
||||
unfold unattach
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons a l ih => simp [ih, hf]
|
||||
|
||||
@[deprecated flatMap_subtype (since := "2024-10-16")] abbrev bind_subtype := @flatMap_subtype
|
||||
|
||||
@[simp] theorem unattach_filter {p : α → Prop} {l : List { x // p x }}
|
||||
{f : { x // p x } → Bool} {g : α → Bool} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
|
||||
(l.filter f).unattach = l.unattach.filter g := by
|
||||
|
||||
@@ -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`, `erase`, `eraseP`, `eraseIdx`.
|
||||
* Manipulating elements: `replace`, `insert`, `modify`, `erase`, `eraseP`, `eraseIdx`.
|
||||
* Finding elements: `find?`, `findSome?`, `findIdx`, `indexOf`, `findIdx?`, `indexOf?`,
|
||||
`countP`, `count`, and `lookup`.
|
||||
* Logic: `any`, `all`, `or`, and `and`.
|
||||
@@ -122,6 +122,11 @@ 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
|
||||
@@ -558,28 +563,38 @@ def flatten : List (List α) → List α
|
||||
|
||||
@[deprecated flatten (since := "2024-10-14"), inherit_doc flatten] abbrev join := @flatten
|
||||
|
||||
/-! ### pure -/
|
||||
/-! ### singleton -/
|
||||
|
||||
/-- `pure x = [x]` is the `pure` operation of the list monad. -/
|
||||
@[inline] protected def pure {α : Type u} (a : α) : List α := [a]
|
||||
/-- `singleton x = [x]`. -/
|
||||
@[inline] protected def singleton {α : Type u} (a : α) : List α := [a]
|
||||
|
||||
/-! ### bind -/
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated singleton (since := "2024-10-16")] protected abbrev pure := @singleton
|
||||
|
||||
/-! ### flatMap -/
|
||||
|
||||
/--
|
||||
`bind xs f` is the bind operation of the list monad. It applies `f` to each element of `xs`
|
||||
`flatMap xs f` applies `f` to each element of `xs`
|
||||
to get a list of lists, and then concatenates them all together.
|
||||
* `[2, 3, 2].bind range = [0, 1, 0, 1, 2, 0, 1]`
|
||||
-/
|
||||
@[inline] protected def bind {α : Type u} {β : Type v} (a : List α) (b : α → List β) : List β := flatten (map b a)
|
||||
@[inline] def flatMap {α : Type u} {β : Type v} (a : List α) (b : α → List β) : List β := flatten (map b a)
|
||||
|
||||
@[simp] theorem bind_nil (f : α → List β) : List.bind [] f = [] := by simp [flatten, List.bind]
|
||||
@[simp] theorem bind_cons x xs (f : α → List β) :
|
||||
List.bind (x :: xs) f = f x ++ List.bind xs f := by simp [flatten, List.bind]
|
||||
@[simp] theorem flatMap_nil (f : α → List β) : List.flatMap [] f = [] := by simp [flatten, List.flatMap]
|
||||
@[simp] theorem flatMap_cons x xs (f : α → List β) :
|
||||
List.flatMap (x :: xs) f = f x ++ List.flatMap xs f := by simp [flatten, List.flatMap]
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated bind_nil (since := "2024-06-15")] abbrev nil_bind := @bind_nil
|
||||
@[deprecated flatMap (since := "2024-10-16")] abbrev bind := @flatMap
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated bind_cons (since := "2024-06-15")] abbrev cons_bind := @bind_cons
|
||||
@[deprecated flatMap_nil (since := "2024-10-16")] abbrev nil_flatMap := @flatMap_nil
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated flatMap_cons (since := "2024-10-16")] abbrev cons_flatMap := @flatMap_cons
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated flatMap_nil (since := "2024-06-15")] abbrev nil_bind := @flatMap_nil
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated flatMap_cons (since := "2024-06-15")] abbrev cons_bind := @flatMap_cons
|
||||
|
||||
/-! ### replicate -/
|
||||
|
||||
@@ -1104,6 +1119,35 @@ 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 -/
|
||||
|
||||
/--
|
||||
@@ -1408,11 +1452,15 @@ def sum {α} [Add α] [Zero α] : List α → α :=
|
||||
@[simp] theorem sum_cons [Add α] [Zero α] {a : α} {l : List α} : (a::l).sum = a + l.sum := rfl
|
||||
|
||||
/-- Sum of a list of natural numbers. -/
|
||||
-- We intend to subsequently deprecate this in favor of `List.sum`.
|
||||
@[deprecated List.sum (since := "2024-10-17")]
|
||||
protected def _root_.Nat.sum (l : List Nat) : Nat := l.foldr (·+·) 0
|
||||
|
||||
@[simp] theorem _root_.Nat.sum_nil : Nat.sum ([] : List Nat) = 0 := rfl
|
||||
@[simp] theorem _root_.Nat.sum_cons (a : Nat) (l : List Nat) :
|
||||
set_option linter.deprecated false in
|
||||
@[simp, deprecated sum_nil (since := "2024-10-17")]
|
||||
theorem _root_.Nat.sum_nil : Nat.sum ([] : List Nat) = 0 := rfl
|
||||
set_option linter.deprecated false in
|
||||
@[simp, deprecated sum_cons (since := "2024-10-17")]
|
||||
theorem _root_.Nat.sum_cons (a : Nat) (l : List Nat) :
|
||||
Nat.sum (a::l) = a + Nat.sum l := rfl
|
||||
|
||||
/-! ### range -/
|
||||
|
||||
@@ -232,7 +232,8 @@ theorem sizeOf_get [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.g
|
||||
apply Nat.lt_trans ih
|
||||
simp_arith
|
||||
|
||||
theorem le_antisymm [LT α] [s : Antisymm (¬ · < · : α → α → Prop)] {as bs : List α} (h₁ : as ≤ bs) (h₂ : bs ≤ as) : as = bs :=
|
||||
theorem le_antisymm [LT α] [s : Std.Antisymm (¬ · < · : α → α → Prop)]
|
||||
{as bs : List α} (h₁ : as ≤ bs) (h₂ : bs ≤ as) : as = bs :=
|
||||
match as, bs with
|
||||
| [], [] => rfl
|
||||
| [], _::_ => False.elim <| h₂ (List.lt.nil ..)
|
||||
@@ -248,7 +249,8 @@ theorem le_antisymm [LT α] [s : Antisymm (¬ · < · : α → α → Prop)] {as
|
||||
have : a = b := s.antisymm hab hba
|
||||
simp [this, ih]
|
||||
|
||||
instance [LT α] [Antisymm (¬ · < · : α → α → Prop)] : Antisymm (· ≤ · : List α → List α → Prop) where
|
||||
instance [LT α] [Std.Antisymm (¬ · < · : α → α → Prop)] :
|
||||
Std.Antisymm (· ≤ · : List α → List α → Prop) where
|
||||
antisymm h₁ h₂ := le_antisymm h₁ h₂
|
||||
|
||||
end List
|
||||
|
||||
@@ -378,14 +378,18 @@ theorem find?_flatten_eq_some {xs : List (List α)} {p : α → Bool} {a : α} :
|
||||
· exact h₁ l ml a m
|
||||
· exact h₂ a m
|
||||
|
||||
@[simp] theorem find?_bind (xs : List α) (f : α → List β) (p : β → Bool) :
|
||||
(xs.bind f).find? p = xs.findSome? (fun x => (f x).find? p) := by
|
||||
simp [bind_def, findSome?_map]; rfl
|
||||
@[simp] theorem find?_flatMap (xs : List α) (f : α → List β) (p : β → Bool) :
|
||||
(xs.flatMap f).find? p = xs.findSome? (fun x => (f x).find? p) := by
|
||||
simp [flatMap_def, findSome?_map]; rfl
|
||||
|
||||
theorem find?_bind_eq_none {xs : List α} {f : α → List β} {p : β → Bool} :
|
||||
(xs.bind f).find? p = none ↔ ∀ x ∈ xs, ∀ y ∈ f x, !p y := by
|
||||
@[deprecated find?_flatMap (since := "2024-10-16")] abbrev find?_bind := @find?_flatMap
|
||||
|
||||
theorem find?_flatMap_eq_none {xs : List α} {f : α → List β} {p : β → Bool} :
|
||||
(xs.flatMap f).find? p = none ↔ ∀ x ∈ xs, ∀ y ∈ f x, !p y := by
|
||||
simp
|
||||
|
||||
@[deprecated find?_flatMap_eq_none (since := "2024-10-16")] abbrev find?_bind_eq_none := @find?_flatMap_eq_none
|
||||
|
||||
theorem find?_replicate : find? p (replicate n a) = if n = 0 then none else if p a then some a else none := by
|
||||
cases n
|
||||
· simp
|
||||
|
||||
@@ -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`, `erase`, `eraseIdx`, `zipWith`,
|
||||
`take`, `takeWhile`, `dropLast`, `replace`, `modify`, `erase`, `eraseIdx`, `zipWith`,
|
||||
`enumFrom`, and `intercalate`.
|
||||
|
||||
-/
|
||||
@@ -93,29 +93,29 @@ The following operations are given `@[csimp]` replacements below:
|
||||
@[csimp] theorem foldr_eq_foldrTR : @foldr = @foldrTR := by
|
||||
funext α β f init l; simp [foldrTR, Array.foldr_eq_foldr_toList, -Array.size_toArray]
|
||||
|
||||
/-! ### bind -/
|
||||
/-! ### flatMap -/
|
||||
|
||||
/-- Tail recursive version of `List.bind`. -/
|
||||
@[inline] def bindTR (as : List α) (f : α → List β) : List β := go as #[] where
|
||||
/-- Auxiliary for `bind`: `bind.go f as = acc.toList ++ bind f as` -/
|
||||
/-- Tail recursive version of `List.flatMap`. -/
|
||||
@[inline] def flatMapTR (as : List α) (f : α → List β) : List β := go as #[] where
|
||||
/-- Auxiliary for `flatMap`: `flatMap.go f as = acc.toList ++ bind f as` -/
|
||||
@[specialize] go : List α → Array β → List β
|
||||
| [], acc => acc.toList
|
||||
| x::xs, acc => go xs (acc ++ f x)
|
||||
|
||||
@[csimp] theorem bind_eq_bindTR : @List.bind = @bindTR := by
|
||||
@[csimp] theorem flatMap_eq_flatMapTR : @List.flatMap = @flatMapTR := by
|
||||
funext α β as f
|
||||
let rec go : ∀ as acc, bindTR.go f as acc = acc.toList ++ as.bind f
|
||||
| [], acc => by simp [bindTR.go, bind]
|
||||
| x::xs, acc => by simp [bindTR.go, bind, go xs]
|
||||
let rec go : ∀ as acc, flatMapTR.go f as acc = acc.toList ++ as.flatMap f
|
||||
| [], acc => by simp [flatMapTR.go, flatMap]
|
||||
| x::xs, acc => by simp [flatMapTR.go, flatMap, go xs]
|
||||
exact (go as #[]).symm
|
||||
|
||||
/-! ### flatten -/
|
||||
|
||||
/-- Tail recursive version of `List.flatten`. -/
|
||||
@[inline] def flattenTR (l : List (List α)) : List α := bindTR l id
|
||||
@[inline] def flattenTR (l : List (List α)) : List α := flatMapTR l id
|
||||
|
||||
@[csimp] theorem flatten_eq_flattenTR : @flatten = @flattenTR := by
|
||||
funext α l; rw [← List.bind_id, List.bind_eq_bindTR]; rfl
|
||||
funext α l; rw [← List.flatMap_id, List.flatMap_eq_flatMapTR]; rfl
|
||||
|
||||
/-! ## Sublists -/
|
||||
|
||||
@@ -197,6 +197,24 @@ 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`. -/
|
||||
|
||||
@@ -1047,9 +1047,6 @@ theorem get_cons_length (x : α) (xs : List α) (n : Nat) (h : n = xs.length) :
|
||||
|
||||
@[simp] theorem getLast?_singleton (a : α) : getLast? [a] = a := rfl
|
||||
|
||||
theorem getLast!_of_getLast? [Inhabited α] : ∀ {l : List α}, getLast? l = some a → getLast! l = a
|
||||
| _ :: _, rfl => rfl
|
||||
|
||||
theorem getLast?_eq_getLast : ∀ l h, @getLast? α l = some (getLast l h)
|
||||
| [], h => nomatch h rfl
|
||||
| _ :: _, _ => rfl
|
||||
@@ -1083,6 +1080,21 @@ theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by
|
||||
theorem getLastD_concat (a b l) : @getLastD α (l ++ [b]) a = b := by
|
||||
rw [getLastD_eq_getLast?, getLast?_concat]; rfl
|
||||
|
||||
/-! ### getLast! -/
|
||||
|
||||
@[simp] theorem getLast!_nil [Inhabited α] : ([] : List α).getLast! = default := rfl
|
||||
|
||||
theorem getLast!_of_getLast? [Inhabited α] : ∀ {l : List α}, getLast? l = some a → getLast! l = a
|
||||
| _ :: _, rfl => rfl
|
||||
|
||||
theorem getLast!_eq_getElem! [Inhabited α] {l : List α} : l.getLast! = l[l.length - 1]! := by
|
||||
cases l with
|
||||
| nil => simp
|
||||
| cons _ _ =>
|
||||
apply getLast!_of_getLast?
|
||||
rw [getElem!_pos, getElem_cons_length (h := by simp)]
|
||||
rfl
|
||||
|
||||
/-! ## Head and tail -/
|
||||
|
||||
/-! ### head -/
|
||||
@@ -2097,8 +2109,8 @@ theorem forall_mem_flatten {p : α → Prop} {L : List (List α)} :
|
||||
simp only [mem_flatten, forall_exists_index, and_imp]
|
||||
constructor <;> (intros; solve_by_elim)
|
||||
|
||||
theorem flatten_eq_bind {L : List (List α)} : flatten L = L.bind id := by
|
||||
induction L <;> simp [List.bind]
|
||||
theorem flatten_eq_flatMap {L : List (List α)} : flatten L = L.flatMap id := by
|
||||
induction L <;> simp [List.flatMap]
|
||||
|
||||
theorem head?_flatten {L : List (List α)} : (flatten L).head? = L.findSome? fun l => l.head? := by
|
||||
induction L with
|
||||
@@ -2215,86 +2227,86 @@ theorem eq_iff_flatten_eq : ∀ {L L' : List (List α)},
|
||||
obtain ⟨rfl, h⟩ := append_inj h₁ h₂
|
||||
exact ⟨rfl, h, h₃⟩
|
||||
|
||||
/-! ### bind -/
|
||||
/-! ### flatMap -/
|
||||
|
||||
theorem bind_def (l : List α) (f : α → List β) : l.bind f = flatten (map f l) := by rfl
|
||||
theorem flatMap_def (l : List α) (f : α → List β) : l.flatMap f = flatten (map f l) := by rfl
|
||||
|
||||
@[simp] theorem bind_id (l : List (List α)) : List.bind l id = l.flatten := by simp [bind_def]
|
||||
@[simp] theorem flatMap_id (l : List (List α)) : List.flatMap l id = l.flatten := by simp [flatMap_def]
|
||||
|
||||
@[simp] theorem mem_bind {f : α → List β} {b} {l : List α} : b ∈ l.bind f ↔ ∃ a, a ∈ l ∧ b ∈ f a := by
|
||||
simp [bind_def, mem_flatten]
|
||||
@[simp] theorem mem_flatMap {f : α → List β} {b} {l : List α} : b ∈ l.flatMap f ↔ ∃ a, a ∈ l ∧ b ∈ f a := by
|
||||
simp [flatMap_def, mem_flatten]
|
||||
exact ⟨fun ⟨_, ⟨a, h₁, rfl⟩, h₂⟩ => ⟨a, h₁, h₂⟩, fun ⟨a, h₁, h₂⟩ => ⟨_, ⟨a, h₁, rfl⟩, h₂⟩⟩
|
||||
|
||||
theorem exists_of_mem_bind {b : β} {l : List α} {f : α → List β} :
|
||||
b ∈ l.bind f → ∃ a, a ∈ l ∧ b ∈ f a := mem_bind.1
|
||||
theorem exists_of_mem_flatMap {b : β} {l : List α} {f : α → List β} :
|
||||
b ∈ l.flatMap f → ∃ a, a ∈ l ∧ b ∈ f a := mem_flatMap.1
|
||||
|
||||
theorem mem_bind_of_mem {b : β} {l : List α} {f : α → List β} {a} (al : a ∈ l) (h : b ∈ f a) :
|
||||
b ∈ l.bind f := mem_bind.2 ⟨a, al, h⟩
|
||||
theorem mem_flatMap_of_mem {b : β} {l : List α} {f : α → List β} {a} (al : a ∈ l) (h : b ∈ f a) :
|
||||
b ∈ l.flatMap f := mem_flatMap.2 ⟨a, al, h⟩
|
||||
|
||||
@[simp]
|
||||
theorem bind_eq_nil_iff {l : List α} {f : α → List β} : List.bind l f = [] ↔ ∀ x ∈ l, f x = [] :=
|
||||
theorem flatMap_eq_nil_iff {l : List α} {f : α → List β} : List.flatMap l f = [] ↔ ∀ x ∈ l, f x = [] :=
|
||||
flatten_eq_nil_iff.trans <| by
|
||||
simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
|
||||
|
||||
@[deprecated bind_eq_nil_iff (since := "2024-09-05")] abbrev bind_eq_nil := @bind_eq_nil_iff
|
||||
@[deprecated flatMap_eq_nil_iff (since := "2024-09-05")] abbrev bind_eq_nil := @flatMap_eq_nil_iff
|
||||
|
||||
theorem forall_mem_bind {p : β → Prop} {l : List α} {f : α → List β} :
|
||||
(∀ (x) (_ : x ∈ l.bind f), p x) ↔ ∀ (a) (_ : a ∈ l) (b) (_ : b ∈ f a), p b := by
|
||||
simp only [mem_bind, forall_exists_index, and_imp]
|
||||
theorem forall_mem_flatMap {p : β → Prop} {l : List α} {f : α → List β} :
|
||||
(∀ (x) (_ : x ∈ l.flatMap f), p x) ↔ ∀ (a) (_ : a ∈ l) (b) (_ : b ∈ f a), p b := by
|
||||
simp only [mem_flatMap, forall_exists_index, and_imp]
|
||||
constructor <;> (intros; solve_by_elim)
|
||||
|
||||
theorem bind_singleton (f : α → List β) (x : α) : [x].bind f = f x :=
|
||||
theorem flatMap_singleton (f : α → List β) (x : α) : [x].flatMap f = f x :=
|
||||
append_nil (f x)
|
||||
|
||||
@[simp] theorem bind_singleton' (l : List α) : (l.bind fun x => [x]) = l := by
|
||||
@[simp] theorem flatMap_singleton' (l : List α) : (l.flatMap fun x => [x]) = l := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
theorem head?_bind {l : List α} {f : α → List β} :
|
||||
(l.bind f).head? = l.findSome? fun a => (f a).head? := by
|
||||
theorem head?_flatMap {l : List α} {f : α → List β} :
|
||||
(l.flatMap f).head? = l.findSome? fun a => (f a).head? := by
|
||||
induction l with
|
||||
| nil => rfl
|
||||
| cons =>
|
||||
simp only [findSome?_cons]
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem bind_append (xs ys : List α) (f : α → List β) :
|
||||
(xs ++ ys).bind f = xs.bind f ++ ys.bind f := by
|
||||
induction xs; {rfl}; simp_all [bind_cons, append_assoc]
|
||||
@[simp] theorem flatMap_append (xs ys : List α) (f : α → List β) :
|
||||
(xs ++ ys).flatMap f = xs.flatMap f ++ ys.flatMap f := by
|
||||
induction xs; {rfl}; simp_all [flatMap_cons, append_assoc]
|
||||
|
||||
@[deprecated bind_append (since := "2024-07-24")] abbrev append_bind := @bind_append
|
||||
@[deprecated flatMap_append (since := "2024-07-24")] abbrev append_bind := @flatMap_append
|
||||
|
||||
theorem bind_assoc {α β} (l : List α) (f : α → List β) (g : β → List γ) :
|
||||
(l.bind f).bind g = l.bind fun x => (f x).bind g := by
|
||||
theorem flatMap_assoc {α β} (l : List α) (f : α → List β) (g : β → List γ) :
|
||||
(l.flatMap f).flatMap g = l.flatMap fun x => (f x).flatMap g := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
theorem map_bind (f : β → γ) (g : α → List β) :
|
||||
∀ l : List α, (l.bind g).map f = l.bind fun a => (g a).map f
|
||||
theorem map_flatMap (f : β → γ) (g : α → List β) :
|
||||
∀ l : List α, (l.flatMap g).map f = l.flatMap fun a => (g a).map f
|
||||
| [] => rfl
|
||||
| a::l => by simp only [bind_cons, map_append, map_bind _ _ l]
|
||||
| a::l => by simp only [flatMap_cons, map_append, map_flatMap _ _ l]
|
||||
|
||||
theorem bind_map (f : α → β) (g : β → List γ) (l : List α) :
|
||||
(map f l).bind g = l.bind (fun a => g (f a)) := by
|
||||
induction l <;> simp [bind_cons, *]
|
||||
theorem flatMap_map (f : α → β) (g : β → List γ) (l : List α) :
|
||||
(map f l).flatMap g = l.flatMap (fun a => g (f a)) := by
|
||||
induction l <;> simp [flatMap_cons, *]
|
||||
|
||||
theorem map_eq_bind {α β} (f : α → β) (l : List α) : map f l = l.bind fun x => [f x] := by
|
||||
theorem map_eq_flatMap {α β} (f : α → β) (l : List α) : map f l = l.flatMap fun x => [f x] := by
|
||||
simp only [← map_singleton]
|
||||
rw [← bind_singleton' l, map_bind, bind_singleton']
|
||||
rw [← flatMap_singleton' l, map_flatMap, flatMap_singleton']
|
||||
|
||||
theorem filterMap_bind {β γ} (l : List α) (g : α → List β) (f : β → Option γ) :
|
||||
(l.bind g).filterMap f = l.bind fun a => (g a).filterMap f := by
|
||||
theorem filterMap_flatMap {β γ} (l : List α) (g : α → List β) (f : β → Option γ) :
|
||||
(l.flatMap g).filterMap f = l.flatMap fun a => (g a).filterMap f := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
theorem filter_bind (l : List α) (g : α → List β) (f : β → Bool) :
|
||||
(l.bind g).filter f = l.bind fun a => (g a).filter f := by
|
||||
theorem filter_flatMap (l : List α) (g : α → List β) (f : β → Bool) :
|
||||
(l.flatMap g).filter f = l.flatMap fun a => (g a).filter f := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
theorem bind_eq_foldl (f : α → List β) (l : List α) :
|
||||
l.bind f = l.foldl (fun acc a => acc ++ f a) [] := by
|
||||
suffices ∀ l', l' ++ l.bind f = l.foldl (fun acc a => acc ++ f a) l' by simpa using this []
|
||||
theorem flatMap_eq_foldl (f : α → List β) (l : List α) :
|
||||
l.flatMap f = l.foldl (fun acc a => acc ++ f a) [] := by
|
||||
suffices ∀ l', l' ++ l.flatMap f = l.foldl (fun acc a => acc ++ f a) l' by simpa using this []
|
||||
intro l'
|
||||
induction l generalizing l'
|
||||
· simp
|
||||
· next ih => rw [bind_cons, ← append_assoc, ih, foldl_cons]
|
||||
· next ih => rw [flatMap_cons, ← append_assoc, ih, foldl_cons]
|
||||
|
||||
/-! ### replicate -/
|
||||
|
||||
@@ -2484,10 +2496,10 @@ theorem filterMap_replicate_of_some {f : α → Option β} (h : f a = some b) :
|
||||
simp only [replicate_succ, flatten_cons, ih, append_replicate_replicate, replicate_inj, or_true,
|
||||
and_true, add_one_mul, Nat.add_comm]
|
||||
|
||||
theorem bind_replicate {β} (f : α → List β) : (replicate n a).bind f = (replicate n (f a)).flatten := by
|
||||
theorem flatMap_replicate {β} (f : α → List β) : (replicate n a).flatMap f = (replicate n (f a)).flatten := by
|
||||
induction n with
|
||||
| zero => simp
|
||||
| succ n ih => simp only [replicate_succ, bind_cons, ih, flatten_cons]
|
||||
| succ n ih => simp only [replicate_succ, flatMap_cons, ih, flatten_cons]
|
||||
|
||||
@[simp] theorem isEmpty_replicate : (replicate n a).isEmpty = decide (n = 0) := by
|
||||
cases n <;> simp [replicate_succ]
|
||||
@@ -2672,10 +2684,10 @@ theorem flatten_reverse (L : List (List α)) :
|
||||
L.reverse.flatten = (L.map reverse).flatten.reverse := by
|
||||
induction L <;> simp_all
|
||||
|
||||
theorem reverse_bind {β} (l : List α) (f : α → List β) : (l.bind f).reverse = l.reverse.bind (reverse ∘ f) := by
|
||||
theorem reverse_flatMap {β} (l : List α) (f : α → List β) : (l.flatMap f).reverse = l.reverse.flatMap (reverse ∘ f) := by
|
||||
induction l <;> simp_all
|
||||
|
||||
theorem bind_reverse {β} (l : List α) (f : α → List β) : (l.reverse.bind f) = (l.bind (reverse ∘ f)).reverse := by
|
||||
theorem flatMap_reverse {β} (l : List α) (f : α → List β) : (l.reverse.flatMap f) = (l.flatMap (reverse ∘ f)).reverse := by
|
||||
induction l <;> simp_all
|
||||
|
||||
@[simp] theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
|
||||
@@ -2783,15 +2795,15 @@ theorem getLast_filterMap_of_eq_some {f : α → Option β} {l : List α} {w : l
|
||||
rw [head_filterMap_of_eq_some (by simp_all)]
|
||||
simp_all
|
||||
|
||||
theorem getLast?_bind {L : List α} {f : α → List β} :
|
||||
(L.bind f).getLast? = L.reverse.findSome? fun a => (f a).getLast? := by
|
||||
simp only [← head?_reverse, reverse_bind]
|
||||
rw [head?_bind]
|
||||
theorem getLast?_flatMap {L : List α} {f : α → List β} :
|
||||
(L.flatMap f).getLast? = L.reverse.findSome? fun a => (f a).getLast? := by
|
||||
simp only [← head?_reverse, reverse_flatMap]
|
||||
rw [head?_flatMap]
|
||||
rfl
|
||||
|
||||
theorem getLast?_flatten {L : List (List α)} :
|
||||
(flatten L).getLast? = L.reverse.findSome? fun l => l.getLast? := by
|
||||
simp [← bind_id, getLast?_bind]
|
||||
simp [← flatMap_id, getLast?_flatMap]
|
||||
|
||||
theorem getLast?_replicate (a : α) (n : Nat) : (replicate n a).getLast? = if n = 0 then none else some a := by
|
||||
simp only [← head?_reverse, reverse_replicate, head?_replicate]
|
||||
@@ -3300,12 +3312,12 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (!
|
||||
|
||||
@[deprecated all_flatten (since := "2024-10-14")] abbrev all_join := @all_flatten
|
||||
|
||||
@[simp] theorem any_bind {l : List α} {f : α → List β} :
|
||||
(l.bind f).any p = l.any fun a => (f a).any p := by
|
||||
@[simp] theorem any_flatMap {l : List α} {f : α → List β} :
|
||||
(l.flatMap f).any p = l.any fun a => (f a).any p := by
|
||||
induction l <;> simp_all
|
||||
|
||||
@[simp] theorem all_bind {l : List α} {f : α → List β} :
|
||||
(l.bind f).all p = l.all fun a => (f a).all p := by
|
||||
@[simp] theorem all_flatMap {l : List α} {f : α → List β} :
|
||||
(l.flatMap f).all p = l.all fun a => (f a).all p := by
|
||||
induction l <;> simp_all
|
||||
|
||||
@[simp] theorem any_reverse {l : List α} : l.reverse.any f = l.any f := by
|
||||
@@ -3345,7 +3357,7 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (!
|
||||
@[deprecated exists_of_mem_flatten (since := "2024-10-14")] abbrev exists_of_mem_join := @exists_of_mem_flatten
|
||||
@[deprecated mem_flatten_of_mem (since := "2024-10-14")] abbrev mem_join_of_mem := @mem_flatten_of_mem
|
||||
@[deprecated forall_mem_flatten (since := "2024-10-14")] abbrev forall_mem_join := @forall_mem_flatten
|
||||
@[deprecated flatten_eq_bind (since := "2024-10-14")] abbrev join_eq_bind := @flatten_eq_bind
|
||||
@[deprecated flatten_eq_flatMap (since := "2024-10-14")] abbrev join_eq_bind := @flatten_eq_flatMap
|
||||
@[deprecated head?_flatten (since := "2024-10-14")] abbrev head?_join := @head?_flatten
|
||||
@[deprecated foldl_flatten (since := "2024-10-14")] abbrev foldl_join := @foldl_flatten
|
||||
@[deprecated foldr_flatten (since := "2024-10-14")] abbrev foldr_join := @foldr_flatten
|
||||
@@ -3372,5 +3384,30 @@ theorem join_map_filter (p : α → Bool) (l : List (List α)) :
|
||||
@[deprecated reverse_flatten (since := "2024-10-14")] abbrev reverse_join := @reverse_flatten
|
||||
@[deprecated flatten_reverse (since := "2024-10-14")] abbrev join_reverse := @flatten_reverse
|
||||
@[deprecated getLast?_flatten (since := "2024-10-14")] abbrev getLast?_join := @getLast?_flatten
|
||||
@[deprecated flatten_eq_flatMap (since := "2024-10-16")] abbrev flatten_eq_bind := @flatten_eq_flatMap
|
||||
@[deprecated flatMap_def (since := "2024-10-16")] abbrev bind_def := @flatMap_def
|
||||
@[deprecated flatMap_id (since := "2024-10-16")] abbrev bind_id := @flatMap_id
|
||||
@[deprecated mem_flatMap (since := "2024-10-16")] abbrev mem_bind := @mem_flatMap
|
||||
@[deprecated exists_of_mem_flatMap (since := "2024-10-16")] abbrev exists_of_mem_bind := @exists_of_mem_flatMap
|
||||
@[deprecated mem_flatMap_of_mem (since := "2024-10-16")] abbrev mem_bind_of_mem := @mem_flatMap_of_mem
|
||||
@[deprecated flatMap_eq_nil_iff (since := "2024-10-16")] abbrev bind_eq_nil_iff := @flatMap_eq_nil_iff
|
||||
@[deprecated forall_mem_flatMap (since := "2024-10-16")] abbrev forall_mem_bind := @forall_mem_flatMap
|
||||
@[deprecated flatMap_singleton (since := "2024-10-16")] abbrev bind_singleton := @flatMap_singleton
|
||||
@[deprecated flatMap_singleton' (since := "2024-10-16")] abbrev bind_singleton' := @flatMap_singleton'
|
||||
@[deprecated head?_flatMap (since := "2024-10-16")] abbrev head_bind := @head?_flatMap
|
||||
@[deprecated flatMap_append (since := "2024-10-16")] abbrev bind_append := @flatMap_append
|
||||
@[deprecated flatMap_assoc (since := "2024-10-16")] abbrev bind_assoc := @flatMap_assoc
|
||||
@[deprecated map_flatMap (since := "2024-10-16")] abbrev map_bind := @map_flatMap
|
||||
@[deprecated flatMap_map (since := "2024-10-16")] abbrev bind_map := @flatMap_map
|
||||
@[deprecated map_eq_flatMap (since := "2024-10-16")] abbrev map_eq_bind := @map_eq_flatMap
|
||||
@[deprecated filterMap_flatMap (since := "2024-10-16")] abbrev filterMap_bind := @filterMap_flatMap
|
||||
@[deprecated filter_flatMap (since := "2024-10-16")] abbrev filter_bind := @filter_flatMap
|
||||
@[deprecated flatMap_eq_foldl (since := "2024-10-16")] abbrev bind_eq_foldl := @flatMap_eq_foldl
|
||||
@[deprecated flatMap_replicate (since := "2024-10-16")] abbrev bind_replicate := @flatMap_replicate
|
||||
@[deprecated reverse_flatMap (since := "2024-10-16")] abbrev reverse_bind := @reverse_flatMap
|
||||
@[deprecated flatMap_reverse (since := "2024-10-16")] abbrev bind_reverse := @flatMap_reverse
|
||||
@[deprecated getLast?_flatMap (since := "2024-10-16")] abbrev getLast?_bind := @getLast?_flatMap
|
||||
@[deprecated any_flatMap (since := "2024-10-16")] abbrev any_bind := @any_flatMap
|
||||
@[deprecated all_flatMap (since := "2024-10-16")] abbrev all_bind := @all_flatMap
|
||||
|
||||
end List
|
||||
|
||||
@@ -75,7 +75,7 @@ theorem le_min?_iff [Min α] [LE α]
|
||||
|
||||
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `min_eq_or`,
|
||||
-- and `le_min_iff`.
|
||||
theorem min?_eq_some_iff [Min α] [LE α] [anti : Antisymm ((· : α) ≤ ·)]
|
||||
theorem min?_eq_some_iff [Min α] [LE α] [anti : Std.Antisymm ((· : α) ≤ ·)]
|
||||
(le_refl : ∀ a : α, a ≤ a)
|
||||
(min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b)
|
||||
(le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) {xs : List α} :
|
||||
@@ -146,7 +146,7 @@ theorem max?_le_iff [Max α] [LE α]
|
||||
|
||||
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `max_eq_or`,
|
||||
-- and `le_min_iff`.
|
||||
theorem max?_eq_some_iff [Max α] [LE α] [anti : Antisymm ((· : α) ≤ ·)]
|
||||
theorem max?_eq_some_iff [Max α] [LE α] [anti : Std.Antisymm ((· : α) ≤ ·)]
|
||||
(le_refl : ∀ a : α, a ≤ a)
|
||||
(max_eq_or : ∀ a b : α, max a b = a ∨ max a b = b)
|
||||
(max_le_iff : ∀ a b c : α, max b c ≤ a ↔ b ≤ a ∧ c ≤ a) {xs : List α} :
|
||||
|
||||
@@ -99,4 +99,14 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as :
|
||||
funext b
|
||||
split <;> simp_all
|
||||
|
||||
/-! ### foldlM and foldrM -/
|
||||
|
||||
theorem foldlM_map [Monad m] (f : β₁ → β₂) (g : α → β₂ → m α) (l : List β₁) (init : α) :
|
||||
(l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
|
||||
induction l generalizing g init <;> simp [*]
|
||||
|
||||
theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ → β₂) (g : β₂ → α → m α) (l : List β₁)
|
||||
(init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
|
||||
induction l generalizing g init <;> simp [*]
|
||||
|
||||
end List
|
||||
|
||||
@@ -12,3 +12,5 @@ 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
|
||||
|
||||
47
src/Init/Data/List/Nat/BEq.lean
Normal file
47
src/Init/Data/List/Nat/BEq.lean
Normal file
@@ -0,0 +1,47 @@
|
||||
/-
|
||||
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
|
||||
102
src/Init/Data/List/Nat/Modify.lean
Normal file
102
src/Init/Data/List/Nat/Modify.lean
Normal file
@@ -0,0 +1,102 @@
|
||||
/-
|
||||
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
|
||||
@@ -173,10 +173,12 @@ theorem pairwise_flatten {L : List (List α)} :
|
||||
|
||||
@[deprecated pairwise_flatten (since := "2024-10-14")] abbrev pairwise_join := @pairwise_flatten
|
||||
|
||||
theorem pairwise_bind {R : β → β → Prop} {l : List α} {f : α → List β} :
|
||||
List.Pairwise R (l.bind f) ↔
|
||||
theorem pairwise_flatMap {R : β → β → Prop} {l : List α} {f : α → List β} :
|
||||
List.Pairwise R (l.flatMap f) ↔
|
||||
(∀ a ∈ l, Pairwise R (f a)) ∧ Pairwise (fun a₁ a₂ => ∀ x ∈ f a₁, ∀ y ∈ f a₂, R x y) l := by
|
||||
simp [List.bind, pairwise_flatten, pairwise_map]
|
||||
simp [List.flatMap, pairwise_flatten, pairwise_map]
|
||||
|
||||
@[deprecated pairwise_flatMap (since := "2024-10-14")] abbrev pairwise_bind := @pairwise_flatMap
|
||||
|
||||
theorem pairwise_reverse {l : List α} :
|
||||
l.reverse.Pairwise R ↔ l.Pairwise (fun a b => R b a) := by
|
||||
|
||||
@@ -470,9 +470,11 @@ theorem Perm.flatten {l₁ l₂ : List (List α)} (h : l₁ ~ l₂) : l₁.flatt
|
||||
|
||||
@[deprecated Perm.flatten (since := "2024-10-14")] abbrev Perm.join := @Perm.flatten
|
||||
|
||||
theorem Perm.bind_right {l₁ l₂ : List α} (f : α → List β) (p : l₁ ~ l₂) : l₁.bind f ~ l₂.bind f :=
|
||||
theorem Perm.flatMap_right {l₁ l₂ : List α} (f : α → List β) (p : l₁ ~ l₂) : l₁.flatMap f ~ l₂.flatMap f :=
|
||||
(p.map _).flatten
|
||||
|
||||
@[deprecated Perm.flatMap_right (since := "2024-10-16")] abbrev Perm.bind_right := @Perm.flatMap_right
|
||||
|
||||
theorem Perm.eraseP (f : α → Bool) {l₁ l₂ : List α}
|
||||
(H : Pairwise (fun a b => f a → f b → False) l₁) (p : l₁ ~ l₂) : eraseP f l₁ ~ eraseP f l₂ := by
|
||||
induction p with
|
||||
|
||||
@@ -131,7 +131,7 @@ theorem or_exists_add_one : p 0 ∨ (Exists fun n => p (n + 1)) ↔ Exists p :=
|
||||
@[simp] theorem blt_eq : (Nat.blt x y = true) = (x < y) := propext <| Iff.intro Nat.le_of_ble_eq_true Nat.ble_eq_true_of_le
|
||||
|
||||
instance : LawfulBEq Nat where
|
||||
eq_of_beq h := Nat.eq_of_beq_eq_true h
|
||||
eq_of_beq h := by simpa using h
|
||||
rfl := by simp [BEq.beq]
|
||||
|
||||
theorem beq_eq_true_eq (a b : Nat) : ((a == b) = true) = (a = b) := by simp
|
||||
@@ -490,10 +490,10 @@ protected theorem le_antisymm_iff {a b : Nat} : a = b ↔ a ≤ b ∧ b ≤ a :=
|
||||
(fun ⟨hle, hge⟩ => Nat.le_antisymm hle hge)
|
||||
protected theorem eq_iff_le_and_ge : ∀{a b : Nat}, a = b ↔ a ≤ b ∧ b ≤ a := @Nat.le_antisymm_iff
|
||||
|
||||
instance : Antisymm ( . ≤ . : Nat → Nat → Prop) where
|
||||
instance : Std.Antisymm ( . ≤ . : Nat → Nat → Prop) where
|
||||
antisymm h₁ h₂ := Nat.le_antisymm h₁ h₂
|
||||
|
||||
instance : Antisymm (¬ . < . : Nat → Nat → Prop) where
|
||||
instance : Std.Antisymm (¬ . < . : Nat → Nat → Prop) where
|
||||
antisymm h₁ h₂ := Nat.le_antisymm (Nat.ge_of_not_lt h₂) (Nat.ge_of_not_lt h₁)
|
||||
|
||||
protected theorem add_le_add_left {n m : Nat} (h : n ≤ m) (k : Nat) : k + n ≤ k + m :=
|
||||
@@ -796,6 +796,8 @@ theorem pos_pow_of_pos {n : Nat} (m : Nat) (h : 0 < n) : 0 < n^m :=
|
||||
| zero => cases h
|
||||
| succ n => simp [Nat.pow_succ]
|
||||
|
||||
protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide)
|
||||
|
||||
instance {n m : Nat} [NeZero n] : NeZero (n^m) :=
|
||||
⟨Nat.ne_zero_iff_zero_lt.mpr (Nat.pos_pow_of_pos m (pos_of_neZero _))⟩
|
||||
|
||||
|
||||
@@ -32,6 +32,77 @@ 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
|
||||
|
||||
@@ -8,8 +8,6 @@ import Init.Data.Nat.Linear
|
||||
|
||||
namespace Nat
|
||||
|
||||
protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide)
|
||||
|
||||
theorem nextPowerOfTwo_dec {n power : Nat} (h₁ : power > 0) (h₂ : power < n) : n - power * 2 < n - power := by
|
||||
have : power * 2 = power + power := by simp_arith
|
||||
rw [this, Nat.sub_add_eq]
|
||||
|
||||
@@ -10,8 +10,10 @@ import Init.Data.Nat.Log2
|
||||
|
||||
/-- For decimal and scientific numbers (e.g., `1.23`, `3.12e10`).
|
||||
Examples:
|
||||
- `OfScientific.ofScientific 123 true 2` represents `1.23`
|
||||
- `OfScientific.ofScientific 121 false 100` represents `121e100`
|
||||
- `1.23` is syntax for `OfScientific.ofScientific (nat_lit 123) true (nat_lit 2)`
|
||||
- `121e100` is syntax for `OfScientific.ofScientific (nat_lit 121) false (nat_lit 100)`
|
||||
|
||||
Note the use of `nat_lit`; there is no wrapping `OfNat.ofNat` in the resulting term.
|
||||
-/
|
||||
class OfScientific (α : Type u) where
|
||||
ofScientific (mantissa : Nat) (exponentSign : Bool) (decimalExponent : Nat) : α
|
||||
|
||||
@@ -44,7 +44,7 @@ theorem attach_congr {o₁ o₂ : Option α} (h : o₁ = o₂) :
|
||||
simp
|
||||
|
||||
theorem attachWith_congr {o₁ o₂ : Option α} (w : o₁ = o₂) {P : α → Prop} {H : ∀ x ∈ o₁, P x} :
|
||||
o₁.attachWith P H = o₂.attachWith P fun x h => H _ (w ▸ h) := by
|
||||
o₁.attachWith P H = o₂.attachWith P fun _ h => H _ (w ▸ h) := by
|
||||
subst w
|
||||
simp
|
||||
|
||||
@@ -128,12 +128,12 @@ theorem attach_map {o : Option α} (f : α → β) :
|
||||
cases o <;> simp
|
||||
|
||||
theorem attachWith_map {o : Option α} (f : α → β) {P : β → Prop} {H : ∀ (b : β), b ∈ o.map f → P b} :
|
||||
(o.map f).attachWith P H = (o.attachWith (P ∘ f) (fun a h => H _ (mem_map_of_mem f h))).map
|
||||
(o.map f).attachWith P H = (o.attachWith (P ∘ f) (fun _ h => H _ (mem_map_of_mem f h))).map
|
||||
fun ⟨x, h⟩ => ⟨f x, h⟩ := by
|
||||
cases o <;> simp
|
||||
|
||||
theorem map_attach {o : Option α} (f : { x // x ∈ o } → β) :
|
||||
o.attach.map f = o.pmap (fun a (h : a ∈ o) => f ⟨a, h⟩) (fun a h => h) := by
|
||||
o.attach.map f = o.pmap (fun a (h : a ∈ o) => f ⟨a, h⟩) (fun _ h => h) := by
|
||||
cases o <;> simp
|
||||
|
||||
theorem map_attachWith {o : Option α} {P : α → Prop} {H : ∀ (a : α), a ∈ o → P a}
|
||||
|
||||
@@ -7,6 +7,8 @@ prelude
|
||||
import Init.SimpLemmas
|
||||
import Init.NotationExtra
|
||||
|
||||
namespace Prod
|
||||
|
||||
instance [BEq α] [BEq β] [LawfulBEq α] [LawfulBEq β] : LawfulBEq (α × β) where
|
||||
eq_of_beq {a b} (h : a.1 == b.1 && a.2 == b.2) := by
|
||||
cases a; cases b
|
||||
@@ -14,9 +16,65 @@ instance [BEq α] [BEq β] [LawfulBEq α] [LawfulBEq β] : LawfulBEq (α × β)
|
||||
rfl {a} := by cases a; simp [BEq.beq, LawfulBEq.rfl]
|
||||
|
||||
@[simp]
|
||||
protected theorem Prod.forall {p : α × β → Prop} : (∀ x, p x) ↔ ∀ a b, p (a, b) :=
|
||||
protected theorem «forall» {p : α × β → Prop} : (∀ x, p x) ↔ ∀ a b, p (a, b) :=
|
||||
⟨fun h a b ↦ h (a, b), fun h ⟨a, b⟩ ↦ h a b⟩
|
||||
|
||||
@[simp]
|
||||
protected theorem Prod.exists {p : α × β → Prop} : (∃ x, p x) ↔ ∃ a b, p (a, b) :=
|
||||
protected theorem «exists» {p : α × β → Prop} : (∃ x, p x) ↔ ∃ a b, p (a, b) :=
|
||||
⟨fun ⟨⟨a, b⟩, h⟩ ↦ ⟨a, b, h⟩, fun ⟨a, b, h⟩ ↦ ⟨⟨a, b⟩, h⟩⟩
|
||||
|
||||
@[simp] theorem map_id : Prod.map (@id α) (@id β) = id := rfl
|
||||
|
||||
@[simp] theorem map_id' : Prod.map (fun a : α => a) (fun b : β => b) = fun x ↦ x := rfl
|
||||
|
||||
/--
|
||||
Composing a `Prod.map` with another `Prod.map` is equal to
|
||||
a single `Prod.map` of composed functions.
|
||||
-/
|
||||
theorem map_comp_map (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) :
|
||||
Prod.map g g' ∘ Prod.map f f' = Prod.map (g ∘ f) (g' ∘ f') :=
|
||||
rfl
|
||||
|
||||
/--
|
||||
Composing a `Prod.map` with another `Prod.map` is equal to
|
||||
a single `Prod.map` of composed functions, fully applied.
|
||||
-/
|
||||
theorem map_map (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) :
|
||||
Prod.map g g' (Prod.map f f' x) = Prod.map (g ∘ f) (g' ∘ f') x :=
|
||||
rfl
|
||||
|
||||
/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/
|
||||
def swap : α × β → β × α := fun p => (p.2, p.1)
|
||||
|
||||
@[simp]
|
||||
theorem swap_swap : ∀ x : α × β, swap (swap x) = x
|
||||
| ⟨_, _⟩ => rfl
|
||||
|
||||
@[simp]
|
||||
theorem fst_swap {p : α × β} : (swap p).1 = p.2 :=
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem snd_swap {p : α × β} : (swap p).2 = p.1 :=
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem swap_prod_mk {a : α} {b : β} : swap (a, b) = (b, a) :=
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem swap_swap_eq : swap ∘ swap = @id (α × β) :=
|
||||
funext swap_swap
|
||||
|
||||
@[simp]
|
||||
theorem swap_inj {p q : α × β} : swap p = swap q ↔ p = q := by
|
||||
cases p; cases q; simp [and_comm]
|
||||
|
||||
/--
|
||||
For two functions `f` and `g`, the composition of `Prod.map f g` with `Prod.swap`
|
||||
is equal to the composition of `Prod.swap` with `Prod.map g f`.
|
||||
-/
|
||||
theorem map_comp_swap (f : α → β) (g : γ → δ) :
|
||||
Prod.map f g ∘ Prod.swap = Prod.swap ∘ Prod.map g f := rfl
|
||||
|
||||
end Prod
|
||||
|
||||
@@ -7,7 +7,7 @@ prelude
|
||||
import Init.Data.Format.Basic
|
||||
import Init.Data.Int.Basic
|
||||
import Init.Data.Nat.Div
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Control.Id
|
||||
open Sum Subtype Nat
|
||||
|
||||
|
||||
@@ -1148,23 +1148,23 @@ namespace String
|
||||
/--
|
||||
If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`.
|
||||
-/
|
||||
def dropPrefix? (s : String) (pre : Substring) : Option Substring :=
|
||||
s.toSubstring.dropPrefix? pre
|
||||
def dropPrefix? (s : String) (pre : String) : Option Substring :=
|
||||
s.toSubstring.dropPrefix? pre.toSubstring
|
||||
|
||||
/--
|
||||
If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`.
|
||||
-/
|
||||
def dropSuffix? (s : String) (suff : Substring) : Option Substring :=
|
||||
s.toSubstring.dropSuffix? suff
|
||||
def dropSuffix? (s : String) (suff : String) : Option Substring :=
|
||||
s.toSubstring.dropSuffix? suff.toSubstring
|
||||
|
||||
/-- `s.stripPrefix pre` will remove `pre` from the beginning of `s` if it occurs there,
|
||||
or otherwise return `s`. -/
|
||||
def stripPrefix (s : String) (pre : Substring) : String :=
|
||||
def stripPrefix (s : String) (pre : String) : String :=
|
||||
s.dropPrefix? pre |>.map Substring.toString |>.getD s
|
||||
|
||||
/-- `s.stripSuffix suff` will remove `suff` from the end of `s` if it occurs there,
|
||||
or otherwise return `s`. -/
|
||||
def stripSuffix (s : String) (suff : Substring) : String :=
|
||||
def stripSuffix (s : String) (suff : String) : String :=
|
||||
s.dropSuffix? suff |>.map Substring.toString |>.getD s
|
||||
|
||||
end String
|
||||
|
||||
@@ -5,6 +5,7 @@ Author: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.ByteArray
|
||||
import Init.Data.UInt.Lemmas
|
||||
|
||||
namespace String
|
||||
|
||||
@@ -20,14 +21,14 @@ def toNat! (s : String) : Nat :=
|
||||
def utf8DecodeChar? (a : ByteArray) (i : Nat) : Option Char := do
|
||||
let c ← a[i]?
|
||||
if c &&& 0x80 == 0 then
|
||||
some ⟨c.toUInt32, .inl (Nat.lt_trans c.1.2 (by decide))⟩
|
||||
some ⟨c.toUInt32, .inl (Nat.lt_trans c.toBitVec.isLt (by decide))⟩
|
||||
else if c &&& 0xe0 == 0xc0 then
|
||||
let c1 ← a[i+1]?
|
||||
guard (c1 &&& 0xc0 == 0x80)
|
||||
let r := ((c &&& 0x1f).toUInt32 <<< 6) ||| (c1 &&& 0x3f).toUInt32
|
||||
guard (0x80 ≤ r)
|
||||
-- TODO: Prove h from the definition of r once we have the necessary lemmas
|
||||
if h : r < 0xd800 then some ⟨r, .inl h⟩ else none
|
||||
if h : r < 0xd800 then some ⟨r, .inl (UInt32.toNat_lt_of_lt (by decide) h)⟩ else none
|
||||
else if c &&& 0xf0 == 0xe0 then
|
||||
let c1 ← a[i+1]?
|
||||
let c2 ← a[i+2]?
|
||||
@@ -38,7 +39,14 @@ def utf8DecodeChar? (a : ByteArray) (i : Nat) : Option Char := do
|
||||
(c2 &&& 0x3f).toUInt32
|
||||
guard (0x800 ≤ r)
|
||||
-- TODO: Prove `r < 0x110000` from the definition of r once we have the necessary lemmas
|
||||
if h : r < 0xd800 ∨ 0xdfff < r ∧ r < 0x110000 then some ⟨r, h⟩ else none
|
||||
if h : r < 0xd800 ∨ 0xdfff < r ∧ r < 0x110000 then
|
||||
have :=
|
||||
match h with
|
||||
| .inl h => Or.inl (UInt32.toNat_lt_of_lt (by decide) h)
|
||||
| .inr h => Or.inr ⟨UInt32.lt_toNat_of_lt (by decide) h.left, UInt32.toNat_lt_of_lt (by decide) h.right⟩
|
||||
some ⟨r, this⟩
|
||||
else
|
||||
none
|
||||
else if c &&& 0xf8 == 0xf0 then
|
||||
let c1 ← a[i+1]?
|
||||
let c2 ← a[i+2]?
|
||||
@@ -50,7 +58,7 @@ def utf8DecodeChar? (a : ByteArray) (i : Nat) : Option Char := do
|
||||
((c2 &&& 0x3f).toUInt32 <<< 6) |||
|
||||
(c3 &&& 0x3f).toUInt32
|
||||
if h : 0x10000 ≤ r ∧ r < 0x110000 then
|
||||
some ⟨r, .inr ⟨Nat.lt_of_lt_of_le (by decide) h.1, h.2⟩⟩
|
||||
some ⟨r, .inr ⟨Nat.lt_of_lt_of_le (by decide) (UInt32.le_toNat_of_le (by decide) h.left), UInt32.toNat_lt_of_lt (by decide) h.right⟩⟩
|
||||
else none
|
||||
else
|
||||
none
|
||||
@@ -117,10 +125,10 @@ def utf8EncodeChar (c : Char) : List UInt8 :=
|
||||
/-- Converts the given `String` to a [UTF-8](https://en.wikipedia.org/wiki/UTF-8) encoded byte array. -/
|
||||
@[extern "lean_string_to_utf8"]
|
||||
def toUTF8 (a : @& String) : ByteArray :=
|
||||
⟨⟨a.data.bind utf8EncodeChar⟩⟩
|
||||
⟨⟨a.data.flatMap utf8EncodeChar⟩⟩
|
||||
|
||||
@[simp] theorem size_toUTF8 (s : String) : s.toUTF8.size = s.utf8ByteSize := by
|
||||
simp [toUTF8, ByteArray.size, Array.size, utf8ByteSize, List.bind]
|
||||
simp [toUTF8, ByteArray.size, Array.size, utf8ByteSize, List.flatMap]
|
||||
induction s.data <;> simp [List.map, List.flatten, utf8ByteSize.go, Nat.add_comm, *]
|
||||
|
||||
/-- Accesses a byte in the UTF-8 encoding of the `String`. O(1) -/
|
||||
|
||||
@@ -4,21 +4,5 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro, Yury G. Kudryashov
|
||||
-/
|
||||
prelude
|
||||
import Init.Core
|
||||
|
||||
namespace Sum
|
||||
|
||||
deriving instance DecidableEq for Sum
|
||||
deriving instance BEq for Sum
|
||||
|
||||
/-- Check if a sum is `inl` and if so, retrieve its contents. -/
|
||||
def getLeft? : α ⊕ β → Option α
|
||||
| inl a => some a
|
||||
| inr _ => none
|
||||
|
||||
/-- Check if a sum is `inr` and if so, retrieve its contents. -/
|
||||
def getRight? : α ⊕ β → Option β
|
||||
| inr b => some b
|
||||
| inl _ => none
|
||||
|
||||
end Sum
|
||||
import Init.Data.Sum.Basic
|
||||
import Init.Data.Sum.Lemmas
|
||||
|
||||
178
src/Init/Data/Sum/Basic.lean
Normal file
178
src/Init/Data/Sum/Basic.lean
Normal file
@@ -0,0 +1,178 @@
|
||||
/-
|
||||
Copyright (c) 2017 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro, Yury G. Kudryashov
|
||||
-/
|
||||
prelude
|
||||
import Init.PropLemmas
|
||||
|
||||
/-!
|
||||
# Disjoint union of types
|
||||
|
||||
This file defines basic operations on the the sum type `α ⊕ β`.
|
||||
|
||||
`α ⊕ β` is the type made of a copy of `α` and a copy of `β`. It is also called *disjoint union*.
|
||||
|
||||
## Main declarations
|
||||
|
||||
* `Sum.isLeft`: Returns whether `x : α ⊕ β` comes from the left component or not.
|
||||
* `Sum.isRight`: Returns whether `x : α ⊕ β` comes from the right component or not.
|
||||
* `Sum.getLeft`: Retrieves the left content of a `x : α ⊕ β` that is known to come from the left.
|
||||
* `Sum.getRight`: Retrieves the right content of `x : α ⊕ β` that is known to come from the right.
|
||||
* `Sum.getLeft?`: Retrieves the left content of `x : α ⊕ β` as an option type or returns `none`
|
||||
if it's coming from the right.
|
||||
* `Sum.getRight?`: Retrieves the right content of `x : α ⊕ β` as an option type or returns `none`
|
||||
if it's coming from the left.
|
||||
* `Sum.map`: Maps `α ⊕ β` to `γ ⊕ δ` component-wise.
|
||||
* `Sum.elim`: Nondependent eliminator/induction principle for `α ⊕ β`.
|
||||
* `Sum.swap`: Maps `α ⊕ β` to `β ⊕ α` by swapping components.
|
||||
* `Sum.LiftRel`: The disjoint union of two relations.
|
||||
* `Sum.Lex`: Lexicographic order on `α ⊕ β` induced by a relation on `α` and a relation on `β`.
|
||||
|
||||
## Further material
|
||||
|
||||
See `Batteries.Data.Sum.Lemmas` for theorems about these definitions.
|
||||
|
||||
## Notes
|
||||
|
||||
The definition of `Sum` takes values in `Type _`. This effectively forbids `Prop`- valued sum types.
|
||||
To this effect, we have `PSum`, which takes value in `Sort _` and carries a more complicated
|
||||
universe signature in consequence. The `Prop` version is `Or`.
|
||||
-/
|
||||
|
||||
namespace Sum
|
||||
|
||||
deriving instance DecidableEq for Sum
|
||||
deriving instance BEq for Sum
|
||||
|
||||
section get
|
||||
|
||||
/-- Check if a sum is `inl`. -/
|
||||
def isLeft : α ⊕ β → Bool
|
||||
| inl _ => true
|
||||
| inr _ => false
|
||||
|
||||
/-- Check if a sum is `inr`. -/
|
||||
def isRight : α ⊕ β → Bool
|
||||
| inl _ => false
|
||||
| inr _ => true
|
||||
|
||||
/-- Retrieve the contents from a sum known to be `inl`.-/
|
||||
def getLeft : (ab : α ⊕ β) → ab.isLeft → α
|
||||
| inl a, _ => a
|
||||
|
||||
/-- Retrieve the contents from a sum known to be `inr`.-/
|
||||
def getRight : (ab : α ⊕ β) → ab.isRight → β
|
||||
| inr b, _ => b
|
||||
|
||||
/-- Check if a sum is `inl` and if so, retrieve its contents. -/
|
||||
def getLeft? : α ⊕ β → Option α
|
||||
| inl a => some a
|
||||
| inr _ => none
|
||||
|
||||
/-- Check if a sum is `inr` and if so, retrieve its contents. -/
|
||||
def getRight? : α ⊕ β → Option β
|
||||
| inr b => some b
|
||||
| inl _ => none
|
||||
|
||||
@[simp] theorem isLeft_inl : (inl x : α ⊕ β).isLeft = true := rfl
|
||||
@[simp] theorem isLeft_inr : (inr x : α ⊕ β).isLeft = false := rfl
|
||||
@[simp] theorem isRight_inl : (inl x : α ⊕ β).isRight = false := rfl
|
||||
@[simp] theorem isRight_inr : (inr x : α ⊕ β).isRight = true := rfl
|
||||
|
||||
@[simp] theorem getLeft_inl (h : (inl x : α ⊕ β).isLeft) : (inl x).getLeft h = x := rfl
|
||||
@[simp] theorem getRight_inr (h : (inr x : α ⊕ β).isRight) : (inr x).getRight h = x := rfl
|
||||
|
||||
@[simp] theorem getLeft?_inl : (inl x : α ⊕ β).getLeft? = some x := rfl
|
||||
@[simp] theorem getLeft?_inr : (inr x : α ⊕ β).getLeft? = none := rfl
|
||||
@[simp] theorem getRight?_inl : (inl x : α ⊕ β).getRight? = none := rfl
|
||||
@[simp] theorem getRight?_inr : (inr x : α ⊕ β).getRight? = some x := rfl
|
||||
|
||||
end get
|
||||
|
||||
/-- Define a function on `α ⊕ β` by giving separate definitions on `α` and `β`. -/
|
||||
protected def elim {α β γ} (f : α → γ) (g : β → γ) : α ⊕ β → γ :=
|
||||
fun x => Sum.casesOn x f g
|
||||
|
||||
@[simp] theorem elim_inl (f : α → γ) (g : β → γ) (x : α) :
|
||||
Sum.elim f g (inl x) = f x := rfl
|
||||
|
||||
@[simp] theorem elim_inr (f : α → γ) (g : β → γ) (x : β) :
|
||||
Sum.elim f g (inr x) = g x := rfl
|
||||
|
||||
/-- Map `α ⊕ β` to `α' ⊕ β'` sending `α` to `α'` and `β` to `β'`. -/
|
||||
protected def map (f : α → α') (g : β → β') : α ⊕ β → α' ⊕ β' :=
|
||||
Sum.elim (inl ∘ f) (inr ∘ g)
|
||||
|
||||
@[simp] theorem map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl
|
||||
|
||||
@[simp] theorem map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl
|
||||
|
||||
/-- Swap the factors of a sum type -/
|
||||
def swap : α ⊕ β → β ⊕ α := Sum.elim inr inl
|
||||
|
||||
@[simp] theorem swap_inl : swap (inl x : α ⊕ β) = inr x := rfl
|
||||
|
||||
@[simp] theorem swap_inr : swap (inr x : α ⊕ β) = inl x := rfl
|
||||
|
||||
section LiftRel
|
||||
|
||||
/-- Lifts pointwise two relations between `α` and `γ` and between `β` and `δ` to a relation between
|
||||
`α ⊕ β` and `γ ⊕ δ`. -/
|
||||
inductive LiftRel (r : α → γ → Prop) (s : β → δ → Prop) : α ⊕ β → γ ⊕ δ → Prop
|
||||
/-- `inl a` and `inl c` are related via `LiftRel r s` if `a` and `c` are related via `r`. -/
|
||||
| protected inl {a c} : r a c → LiftRel r s (inl a) (inl c)
|
||||
/-- `inr b` and `inr d` are related via `LiftRel r s` if `b` and `d` are related via `s`. -/
|
||||
| protected inr {b d} : s b d → LiftRel r s (inr b) (inr d)
|
||||
|
||||
@[simp] theorem liftRel_inl_inl : LiftRel r s (inl a) (inl c) ↔ r a c :=
|
||||
⟨fun h => by cases h; assumption, LiftRel.inl⟩
|
||||
|
||||
@[simp] theorem not_liftRel_inl_inr : ¬LiftRel r s (inl a) (inr d) := nofun
|
||||
|
||||
@[simp] theorem not_liftRel_inr_inl : ¬LiftRel r s (inr b) (inl c) := nofun
|
||||
|
||||
@[simp] theorem liftRel_inr_inr : LiftRel r s (inr b) (inr d) ↔ s b d :=
|
||||
⟨fun h => by cases h; assumption, LiftRel.inr⟩
|
||||
|
||||
instance {r : α → γ → Prop} {s : β → δ → Prop}
|
||||
[∀ a c, Decidable (r a c)] [∀ b d, Decidable (s b d)] :
|
||||
∀ (ab : α ⊕ β) (cd : γ ⊕ δ), Decidable (LiftRel r s ab cd)
|
||||
| inl _, inl _ => decidable_of_iff' _ liftRel_inl_inl
|
||||
| inl _, inr _ => Decidable.isFalse not_liftRel_inl_inr
|
||||
| inr _, inl _ => Decidable.isFalse not_liftRel_inr_inl
|
||||
| inr _, inr _ => decidable_of_iff' _ liftRel_inr_inr
|
||||
|
||||
end LiftRel
|
||||
|
||||
section Lex
|
||||
|
||||
/-- Lexicographic order for sum. Sort all the `inl a` before the `inr b`, otherwise use the
|
||||
respective order on `α` or `β`. -/
|
||||
inductive Lex (r : α → α → Prop) (s : β → β → Prop) : α ⊕ β → α ⊕ β → Prop
|
||||
/-- `inl a₁` and `inl a₂` are related via `Lex r s` if `a₁` and `a₂` are related via `r`. -/
|
||||
| protected inl {a₁ a₂} (h : r a₁ a₂) : Lex r s (inl a₁) (inl a₂)
|
||||
/-- `inr b₁` and `inr b₂` are related via `Lex r s` if `b₁` and `b₂` are related via `s`. -/
|
||||
| protected inr {b₁ b₂} (h : s b₁ b₂) : Lex r s (inr b₁) (inr b₂)
|
||||
/-- `inl a` and `inr b` are always related via `Lex r s`. -/
|
||||
| sep (a b) : Lex r s (inl a) (inr b)
|
||||
|
||||
attribute [simp] Lex.sep
|
||||
|
||||
@[simp] theorem lex_inl_inl : Lex r s (inl a₁) (inl a₂) ↔ r a₁ a₂ :=
|
||||
⟨fun h => by cases h; assumption, Lex.inl⟩
|
||||
|
||||
@[simp] theorem lex_inr_inr : Lex r s (inr b₁) (inr b₂) ↔ s b₁ b₂ :=
|
||||
⟨fun h => by cases h; assumption, Lex.inr⟩
|
||||
|
||||
@[simp] theorem lex_inr_inl : ¬Lex r s (inr b) (inl a) := nofun
|
||||
|
||||
instance instDecidableRelSumLex [DecidableRel r] [DecidableRel s] : DecidableRel (Lex r s)
|
||||
| inl _, inl _ => decidable_of_iff' _ lex_inl_inl
|
||||
| inl _, inr _ => Decidable.isTrue (Lex.sep _ _)
|
||||
| inr _, inl _ => Decidable.isFalse lex_inr_inl
|
||||
| inr _, inr _ => decidable_of_iff' _ lex_inr_inr
|
||||
|
||||
end Lex
|
||||
|
||||
end Sum
|
||||
251
src/Init/Data/Sum/Lemmas.lean
Normal file
251
src/Init/Data/Sum/Lemmas.lean
Normal file
@@ -0,0 +1,251 @@
|
||||
/-
|
||||
Copyright (c) 2017 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro, Yury G. Kudryashov
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Sum.Basic
|
||||
import Init.Ext
|
||||
|
||||
/-!
|
||||
# Disjoint union of types
|
||||
|
||||
Theorems about the definitions introduced in `Init.Data.Sum.Basic`.
|
||||
-/
|
||||
|
||||
open Function
|
||||
|
||||
namespace Sum
|
||||
|
||||
@[simp] protected theorem «forall» {p : α ⊕ β → Prop} :
|
||||
(∀ x, p x) ↔ (∀ a, p (inl a)) ∧ ∀ b, p (inr b) :=
|
||||
⟨fun h => ⟨fun _ => h _, fun _ => h _⟩, fun ⟨h₁, h₂⟩ => Sum.rec h₁ h₂⟩
|
||||
|
||||
@[simp] protected theorem «exists» {p : α ⊕ β → Prop} :
|
||||
(∃ x, p x) ↔ (∃ a, p (inl a)) ∨ ∃ b, p (inr b) :=
|
||||
⟨ fun
|
||||
| ⟨inl a, h⟩ => Or.inl ⟨a, h⟩
|
||||
| ⟨inr b, h⟩ => Or.inr ⟨b, h⟩,
|
||||
fun
|
||||
| Or.inl ⟨a, h⟩ => ⟨inl a, h⟩
|
||||
| Or.inr ⟨b, h⟩ => ⟨inr b, h⟩⟩
|
||||
|
||||
theorem forall_sum {γ : α ⊕ β → Sort _} (p : (∀ ab, γ ab) → Prop) :
|
||||
(∀ fab, p fab) ↔ (∀ fa fb, p (Sum.rec fa fb)) := by
|
||||
refine ⟨fun h fa fb => h _, fun h fab => ?_⟩
|
||||
have h1 : fab = Sum.rec (fun a => fab (Sum.inl a)) (fun b => fab (Sum.inr b)) := by
|
||||
apply funext
|
||||
rintro (_ | _) <;> rfl
|
||||
rw [h1]; exact h _ _
|
||||
|
||||
section get
|
||||
|
||||
@[simp] theorem inl_getLeft : ∀ (x : α ⊕ β) (h : x.isLeft), inl (x.getLeft h) = x
|
||||
| inl _, _ => rfl
|
||||
@[simp] theorem inr_getRight : ∀ (x : α ⊕ β) (h : x.isRight), inr (x.getRight h) = x
|
||||
| inr _, _ => rfl
|
||||
|
||||
@[simp] theorem getLeft?_eq_none_iff {x : α ⊕ β} : x.getLeft? = none ↔ x.isRight := by
|
||||
cases x <;> simp only [getLeft?, isRight, eq_self_iff_true, reduceCtorEq]
|
||||
|
||||
@[simp] theorem getRight?_eq_none_iff {x : α ⊕ β} : x.getRight? = none ↔ x.isLeft := by
|
||||
cases x <;> simp only [getRight?, isLeft, eq_self_iff_true, reduceCtorEq]
|
||||
|
||||
theorem eq_left_getLeft_of_isLeft : ∀ {x : α ⊕ β} (h : x.isLeft), x = inl (x.getLeft h)
|
||||
| inl _, _ => rfl
|
||||
|
||||
@[simp] theorem getLeft_eq_iff (h : x.isLeft) : x.getLeft h = a ↔ x = inl a := by
|
||||
cases x <;> simp at h ⊢
|
||||
|
||||
theorem eq_right_getRight_of_isRight : ∀ {x : α ⊕ β} (h : x.isRight), x = inr (x.getRight h)
|
||||
| inr _, _ => rfl
|
||||
|
||||
@[simp] theorem getRight_eq_iff (h : x.isRight) : x.getRight h = b ↔ x = inr b := by
|
||||
cases x <;> simp at h ⊢
|
||||
|
||||
@[simp] theorem getLeft?_eq_some_iff : x.getLeft? = some a ↔ x = inl a := by
|
||||
cases x <;> simp only [getLeft?, Option.some.injEq, inl.injEq, reduceCtorEq]
|
||||
|
||||
@[simp] theorem getRight?_eq_some_iff : x.getRight? = some b ↔ x = inr b := by
|
||||
cases x <;> simp only [getRight?, Option.some.injEq, inr.injEq, reduceCtorEq]
|
||||
|
||||
@[simp] theorem bnot_isLeft (x : α ⊕ β) : !x.isLeft = x.isRight := by cases x <;> rfl
|
||||
|
||||
@[simp] theorem isLeft_eq_false {x : α ⊕ β} : x.isLeft = false ↔ x.isRight := by cases x <;> simp
|
||||
|
||||
theorem not_isLeft {x : α ⊕ β} : ¬x.isLeft ↔ x.isRight := by simp
|
||||
|
||||
@[simp] theorem bnot_isRight (x : α ⊕ β) : !x.isRight = x.isLeft := by cases x <;> rfl
|
||||
|
||||
@[simp] theorem isRight_eq_false {x : α ⊕ β} : x.isRight = false ↔ x.isLeft := by cases x <;> simp
|
||||
|
||||
theorem not_isRight {x : α ⊕ β} : ¬x.isRight ↔ x.isLeft := by simp
|
||||
|
||||
theorem isLeft_iff : x.isLeft ↔ ∃ y, x = Sum.inl y := by cases x <;> simp
|
||||
|
||||
theorem isRight_iff : x.isRight ↔ ∃ y, x = Sum.inr y := by cases x <;> simp
|
||||
|
||||
end get
|
||||
|
||||
theorem inl.inj_iff : (inl a : α ⊕ β) = inl b ↔ a = b := ⟨inl.inj, congrArg _⟩
|
||||
|
||||
theorem inr.inj_iff : (inr a : α ⊕ β) = inr b ↔ a = b := ⟨inr.inj, congrArg _⟩
|
||||
|
||||
theorem inl_ne_inr : inl a ≠ inr b := nofun
|
||||
|
||||
theorem inr_ne_inl : inr b ≠ inl a := nofun
|
||||
|
||||
/-! ### `Sum.elim` -/
|
||||
|
||||
@[simp] theorem elim_comp_inl (f : α → γ) (g : β → γ) : Sum.elim f g ∘ inl = f :=
|
||||
rfl
|
||||
|
||||
@[simp] theorem elim_comp_inr (f : α → γ) (g : β → γ) : Sum.elim f g ∘ inr = g :=
|
||||
rfl
|
||||
|
||||
@[simp] theorem elim_inl_inr : @Sum.elim α β _ inl inr = id :=
|
||||
funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl
|
||||
|
||||
theorem comp_elim (f : γ → δ) (g : α → γ) (h : β → γ) :
|
||||
f ∘ Sum.elim g h = Sum.elim (f ∘ g) (f ∘ h) :=
|
||||
funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl
|
||||
|
||||
@[simp] theorem elim_comp_inl_inr (f : α ⊕ β → γ) :
|
||||
Sum.elim (f ∘ inl) (f ∘ inr) = f :=
|
||||
funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl
|
||||
|
||||
theorem elim_eq_iff {u u' : α → γ} {v v' : β → γ} :
|
||||
Sum.elim u v = Sum.elim u' v' ↔ u = u' ∧ v = v' := by
|
||||
simp [funext_iff]
|
||||
|
||||
/-! ### `Sum.map` -/
|
||||
|
||||
@[simp] theorem map_map (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
|
||||
∀ x : Sum α β, (x.map f g).map f' g' = x.map (f' ∘ f) (g' ∘ g)
|
||||
| inl _ => rfl
|
||||
| inr _ => rfl
|
||||
|
||||
@[simp] theorem map_comp_map (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
|
||||
Sum.map f' g' ∘ Sum.map f g = Sum.map (f' ∘ f) (g' ∘ g) :=
|
||||
funext <| map_map f' g' f g
|
||||
|
||||
@[simp] theorem map_id_id : Sum.map (@id α) (@id β) = id :=
|
||||
funext fun x => Sum.recOn x (fun _ => rfl) fun _ => rfl
|
||||
|
||||
theorem elim_map {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} {x} :
|
||||
Sum.elim f₂ g₂ (Sum.map f₁ g₁ x) = Sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) x := by
|
||||
cases x <;> rfl
|
||||
|
||||
theorem elim_comp_map {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} :
|
||||
Sum.elim f₂ g₂ ∘ Sum.map f₁ g₁ = Sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) :=
|
||||
funext fun _ => elim_map
|
||||
|
||||
@[simp] theorem isLeft_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
|
||||
isLeft (x.map f g) = isLeft x := by
|
||||
cases x <;> rfl
|
||||
|
||||
@[simp] theorem isRight_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
|
||||
isRight (x.map f g) = isRight x := by
|
||||
cases x <;> rfl
|
||||
|
||||
@[simp] theorem getLeft?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
|
||||
(x.map f g).getLeft? = x.getLeft?.map f := by
|
||||
cases x <;> rfl
|
||||
|
||||
@[simp] theorem getRight?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
|
||||
(x.map f g).getRight? = x.getRight?.map g := by cases x <;> rfl
|
||||
|
||||
/-! ### `Sum.swap` -/
|
||||
|
||||
@[simp] theorem swap_swap (x : α ⊕ β) : swap (swap x) = x := by cases x <;> rfl
|
||||
|
||||
@[simp] theorem swap_swap_eq : swap ∘ swap = @id (α ⊕ β) := funext <| swap_swap
|
||||
|
||||
@[simp] theorem isLeft_swap (x : α ⊕ β) : x.swap.isLeft = x.isRight := by cases x <;> rfl
|
||||
|
||||
@[simp] theorem isRight_swap (x : α ⊕ β) : x.swap.isRight = x.isLeft := by cases x <;> rfl
|
||||
|
||||
@[simp] theorem getLeft?_swap (x : α ⊕ β) : x.swap.getLeft? = x.getRight? := by cases x <;> rfl
|
||||
|
||||
@[simp] theorem getRight?_swap (x : α ⊕ β) : x.swap.getRight? = x.getLeft? := by cases x <;> rfl
|
||||
|
||||
section LiftRel
|
||||
|
||||
theorem LiftRel.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b)
|
||||
(h : LiftRel r₁ s₁ x y) : LiftRel r₂ s₂ x y := by
|
||||
cases h
|
||||
· exact LiftRel.inl (hr _ _ ‹_›)
|
||||
· exact LiftRel.inr (hs _ _ ‹_›)
|
||||
|
||||
theorem LiftRel.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : LiftRel r₁ s x y) :
|
||||
LiftRel r₂ s x y :=
|
||||
(h.mono hr) fun _ _ => id
|
||||
|
||||
theorem LiftRel.mono_right (hs : ∀ a b, s₁ a b → s₂ a b) (h : LiftRel r s₁ x y) :
|
||||
LiftRel r s₂ x y :=
|
||||
h.mono (fun _ _ => id) hs
|
||||
|
||||
protected theorem LiftRel.swap (h : LiftRel r s x y) : LiftRel s r x.swap y.swap := by
|
||||
cases h
|
||||
· exact LiftRel.inr ‹_›
|
||||
· exact LiftRel.inl ‹_›
|
||||
|
||||
@[simp] theorem liftRel_swap_iff : LiftRel s r x.swap y.swap ↔ LiftRel r s x y :=
|
||||
⟨fun h => by rw [← swap_swap x, ← swap_swap y]; exact h.swap, LiftRel.swap⟩
|
||||
|
||||
end LiftRel
|
||||
|
||||
section Lex
|
||||
|
||||
protected theorem LiftRel.lex {a b : α ⊕ β} (h : LiftRel r s a b) : Lex r s a b := by
|
||||
cases h
|
||||
· exact Lex.inl ‹_›
|
||||
· exact Lex.inr ‹_›
|
||||
|
||||
theorem liftRel_subrelation_lex : Subrelation (LiftRel r s) (Lex r s) := LiftRel.lex
|
||||
|
||||
theorem Lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b) (h : Lex r₁ s₁ x y) :
|
||||
Lex r₂ s₂ x y := by
|
||||
cases h
|
||||
· exact Lex.inl (hr _ _ ‹_›)
|
||||
· exact Lex.inr (hs _ _ ‹_›)
|
||||
· exact Lex.sep _ _
|
||||
|
||||
theorem Lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : Lex r₁ s x y) : Lex r₂ s x y :=
|
||||
(h.mono hr) fun _ _ => id
|
||||
|
||||
theorem Lex.mono_right (hs : ∀ a b, s₁ a b → s₂ a b) (h : Lex r s₁ x y) : Lex r s₂ x y :=
|
||||
h.mono (fun _ _ => id) hs
|
||||
|
||||
theorem lex_acc_inl (aca : Acc r a) : Acc (Lex r s) (inl a) := by
|
||||
induction aca with
|
||||
| intro _ _ IH =>
|
||||
constructor
|
||||
intro y h
|
||||
cases h with
|
||||
| inl h' => exact IH _ h'
|
||||
|
||||
theorem lex_acc_inr (aca : ∀ a, Acc (Lex r s) (inl a)) {b} (acb : Acc s b) :
|
||||
Acc (Lex r s) (inr b) := by
|
||||
induction acb with
|
||||
| intro _ _ IH =>
|
||||
constructor
|
||||
intro y h
|
||||
cases h with
|
||||
| inr h' => exact IH _ h'
|
||||
| sep => exact aca _
|
||||
|
||||
theorem lex_wf (ha : WellFounded r) (hb : WellFounded s) : WellFounded (Lex r s) :=
|
||||
have aca : ∀ a, Acc (Lex r s) (inl a) := fun a => lex_acc_inl (ha.apply a)
|
||||
⟨fun x => Sum.recOn x aca fun b => lex_acc_inr aca (hb.apply b)⟩
|
||||
|
||||
end Lex
|
||||
|
||||
theorem elim_const_const (c : γ) :
|
||||
Sum.elim (const _ c : α → γ) (const _ c : β → γ) = const _ c := by
|
||||
apply funext
|
||||
rintro (_ | _) <;> rfl
|
||||
|
||||
@[simp] theorem elim_lam_const_lam_const (c : γ) :
|
||||
Sum.elim (fun _ : α => c) (fun _ : β => c) = fun _ => c :=
|
||||
Sum.elim_const_const c
|
||||
@@ -5,7 +5,7 @@ Author: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.String.Basic
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Data.Nat.Div
|
||||
import Init.Data.Repr
|
||||
import Init.Data.Int.Basic
|
||||
|
||||
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Henrik Böving
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.Log2
|
||||
import Init.Data.UInt.Lemmas
|
||||
|
||||
@@ -4,52 +4,50 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Fin.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Data.BitVec.Basic
|
||||
|
||||
open Nat
|
||||
|
||||
@[extern "lean_uint8_of_nat"]
|
||||
def UInt8.ofNat (n : @& Nat) : UInt8 := ⟨Fin.ofNat n⟩
|
||||
abbrev Nat.toUInt8 := UInt8.ofNat
|
||||
@[extern "lean_uint8_to_nat"]
|
||||
def UInt8.toNat (n : UInt8) : Nat := n.val.val
|
||||
@[extern "lean_uint8_add"]
|
||||
def UInt8.add (a b : UInt8) : UInt8 := ⟨a.val + b.val⟩
|
||||
def UInt8.add (a b : UInt8) : UInt8 := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_uint8_sub"]
|
||||
def UInt8.sub (a b : UInt8) : UInt8 := ⟨a.val - b.val⟩
|
||||
def UInt8.sub (a b : UInt8) : UInt8 := ⟨a.toBitVec - b.toBitVec⟩
|
||||
@[extern "lean_uint8_mul"]
|
||||
def UInt8.mul (a b : UInt8) : UInt8 := ⟨a.val * b.val⟩
|
||||
def UInt8.mul (a b : UInt8) : UInt8 := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_uint8_div"]
|
||||
def UInt8.div (a b : UInt8) : UInt8 := ⟨a.val / b.val⟩
|
||||
def UInt8.div (a b : UInt8) : UInt8 := ⟨BitVec.udiv a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint8_mod"]
|
||||
def UInt8.mod (a b : UInt8) : UInt8 := ⟨a.val % b.val⟩
|
||||
@[extern "lean_uint8_modn"]
|
||||
def UInt8.mod (a b : UInt8) : UInt8 := ⟨BitVec.umod a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint8_modn", deprecated UInt8.mod (since := "2024-09-23")]
|
||||
def UInt8.modn (a : UInt8) (n : @& Nat) : UInt8 := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_uint8_land"]
|
||||
def UInt8.land (a b : UInt8) : UInt8 := ⟨Fin.land a.val b.val⟩
|
||||
def UInt8.land (a b : UInt8) : UInt8 := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_uint8_lor"]
|
||||
def UInt8.lor (a b : UInt8) : UInt8 := ⟨Fin.lor a.val b.val⟩
|
||||
def UInt8.lor (a b : UInt8) : UInt8 := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_uint8_xor"]
|
||||
def UInt8.xor (a b : UInt8) : UInt8 := ⟨Fin.xor a.val b.val⟩
|
||||
def UInt8.xor (a b : UInt8) : UInt8 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_uint8_shift_left"]
|
||||
def UInt8.shiftLeft (a b : UInt8) : UInt8 := ⟨a.val <<< (modn b 8).val⟩
|
||||
def UInt8.shiftLeft (a b : UInt8) : UInt8 := ⟨a.toBitVec <<< (mod b 8).toBitVec⟩
|
||||
@[extern "lean_uint8_shift_right"]
|
||||
def UInt8.shiftRight (a b : UInt8) : UInt8 := ⟨a.val >>> (modn b 8).val⟩
|
||||
def UInt8.lt (a b : UInt8) : Prop := a.val < b.val
|
||||
def UInt8.le (a b : UInt8) : Prop := a.val ≤ b.val
|
||||
def UInt8.shiftRight (a b : UInt8) : UInt8 := ⟨a.toBitVec >>> (mod b 8).toBitVec⟩
|
||||
def UInt8.lt (a b : UInt8) : Prop := a.toBitVec < b.toBitVec
|
||||
def UInt8.le (a b : UInt8) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance UInt8.instOfNat : OfNat UInt8 n := ⟨UInt8.ofNat n⟩
|
||||
instance : Add UInt8 := ⟨UInt8.add⟩
|
||||
instance : Sub UInt8 := ⟨UInt8.sub⟩
|
||||
instance : Mul UInt8 := ⟨UInt8.mul⟩
|
||||
instance : Mod UInt8 := ⟨UInt8.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod UInt8 Nat UInt8 := ⟨UInt8.modn⟩
|
||||
|
||||
instance : Div UInt8 := ⟨UInt8.div⟩
|
||||
instance : LT UInt8 := ⟨UInt8.lt⟩
|
||||
instance : LE UInt8 := ⟨UInt8.le⟩
|
||||
|
||||
@[extern "lean_uint8_complement"]
|
||||
def UInt8.complement (a:UInt8) : UInt8 := 0-(a+1)
|
||||
def UInt8.complement (a : UInt8) : UInt8 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement UInt8 := ⟨UInt8.complement⟩
|
||||
instance : AndOp UInt8 := ⟨UInt8.land⟩
|
||||
@@ -58,69 +56,58 @@ instance : Xor UInt8 := ⟨UInt8.xor⟩
|
||||
instance : ShiftLeft UInt8 := ⟨UInt8.shiftLeft⟩
|
||||
instance : ShiftRight UInt8 := ⟨UInt8.shiftRight⟩
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint8_dec_lt"]
|
||||
def UInt8.decLt (a b : UInt8) : Decidable (a < b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))
|
||||
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint8_dec_le"]
|
||||
def UInt8.decLe (a b : UInt8) : Decidable (a ≤ b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))
|
||||
inferInstanceAs (Decidable (a.toBitVec ≤ b.toBitVec))
|
||||
|
||||
instance (a b : UInt8) : Decidable (a < b) := UInt8.decLt a b
|
||||
instance (a b : UInt8) : Decidable (a ≤ b) := UInt8.decLe a b
|
||||
instance : Max UInt8 := maxOfLe
|
||||
instance : Min UInt8 := minOfLe
|
||||
|
||||
@[extern "lean_uint16_of_nat"]
|
||||
def UInt16.ofNat (n : @& Nat) : UInt16 := ⟨Fin.ofNat n⟩
|
||||
abbrev Nat.toUInt16 := UInt16.ofNat
|
||||
@[extern "lean_uint16_to_nat"]
|
||||
def UInt16.toNat (n : UInt16) : Nat := n.val.val
|
||||
@[extern "lean_uint16_add"]
|
||||
def UInt16.add (a b : UInt16) : UInt16 := ⟨a.val + b.val⟩
|
||||
def UInt16.add (a b : UInt16) : UInt16 := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_uint16_sub"]
|
||||
def UInt16.sub (a b : UInt16) : UInt16 := ⟨a.val - b.val⟩
|
||||
def UInt16.sub (a b : UInt16) : UInt16 := ⟨a.toBitVec - b.toBitVec⟩
|
||||
@[extern "lean_uint16_mul"]
|
||||
def UInt16.mul (a b : UInt16) : UInt16 := ⟨a.val * b.val⟩
|
||||
def UInt16.mul (a b : UInt16) : UInt16 := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_uint16_div"]
|
||||
def UInt16.div (a b : UInt16) : UInt16 := ⟨a.val / b.val⟩
|
||||
def UInt16.div (a b : UInt16) : UInt16 := ⟨BitVec.udiv a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint16_mod"]
|
||||
def UInt16.mod (a b : UInt16) : UInt16 := ⟨a.val % b.val⟩
|
||||
@[extern "lean_uint16_modn"]
|
||||
def UInt16.mod (a b : UInt16) : UInt16 := ⟨BitVec.umod a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint16_modn", deprecated UInt16.mod (since := "2024-09-23")]
|
||||
def UInt16.modn (a : UInt16) (n : @& Nat) : UInt16 := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_uint16_land"]
|
||||
def UInt16.land (a b : UInt16) : UInt16 := ⟨Fin.land a.val b.val⟩
|
||||
def UInt16.land (a b : UInt16) : UInt16 := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_uint16_lor"]
|
||||
def UInt16.lor (a b : UInt16) : UInt16 := ⟨Fin.lor a.val b.val⟩
|
||||
def UInt16.lor (a b : UInt16) : UInt16 := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_uint16_xor"]
|
||||
def UInt16.xor (a b : UInt16) : UInt16 := ⟨Fin.xor a.val b.val⟩
|
||||
def UInt16.xor (a b : UInt16) : UInt16 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_uint16_shift_left"]
|
||||
def UInt16.shiftLeft (a b : UInt16) : UInt16 := ⟨a.val <<< (modn b 16).val⟩
|
||||
@[extern "lean_uint16_to_uint8"]
|
||||
def UInt16.toUInt8 (a : UInt16) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint8_to_uint16"]
|
||||
def UInt8.toUInt16 (a : UInt8) : UInt16 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
def UInt16.shiftLeft (a b : UInt16) : UInt16 := ⟨a.toBitVec <<< (mod b 16).toBitVec⟩
|
||||
@[extern "lean_uint16_shift_right"]
|
||||
def UInt16.shiftRight (a b : UInt16) : UInt16 := ⟨a.val >>> (modn b 16).val⟩
|
||||
def UInt16.lt (a b : UInt16) : Prop := a.val < b.val
|
||||
def UInt16.le (a b : UInt16) : Prop := a.val ≤ b.val
|
||||
def UInt16.shiftRight (a b : UInt16) : UInt16 := ⟨a.toBitVec >>> (mod b 16).toBitVec⟩
|
||||
def UInt16.lt (a b : UInt16) : Prop := a.toBitVec < b.toBitVec
|
||||
def UInt16.le (a b : UInt16) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance UInt16.instOfNat : OfNat UInt16 n := ⟨UInt16.ofNat n⟩
|
||||
instance : Add UInt16 := ⟨UInt16.add⟩
|
||||
instance : Sub UInt16 := ⟨UInt16.sub⟩
|
||||
instance : Mul UInt16 := ⟨UInt16.mul⟩
|
||||
instance : Mod UInt16 := ⟨UInt16.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod UInt16 Nat UInt16 := ⟨UInt16.modn⟩
|
||||
|
||||
instance : Div UInt16 := ⟨UInt16.div⟩
|
||||
instance : LT UInt16 := ⟨UInt16.lt⟩
|
||||
instance : LE UInt16 := ⟨UInt16.le⟩
|
||||
|
||||
@[extern "lean_uint16_complement"]
|
||||
def UInt16.complement (a:UInt16) : UInt16 := 0-(a+1)
|
||||
def UInt16.complement (a : UInt16) : UInt16 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement UInt16 := ⟨UInt16.complement⟩
|
||||
instance : AndOp UInt16 := ⟨UInt16.land⟩
|
||||
@@ -132,74 +119,53 @@ instance : ShiftRight UInt16 := ⟨UInt16.shiftRight⟩
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint16_dec_lt"]
|
||||
def UInt16.decLt (a b : UInt16) : Decidable (a < b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))
|
||||
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint16_dec_le"]
|
||||
def UInt16.decLe (a b : UInt16) : Decidable (a ≤ b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))
|
||||
inferInstanceAs (Decidable (a.toBitVec ≤ b.toBitVec))
|
||||
|
||||
instance (a b : UInt16) : Decidable (a < b) := UInt16.decLt a b
|
||||
instance (a b : UInt16) : Decidable (a ≤ b) := UInt16.decLe a b
|
||||
instance : Max UInt16 := maxOfLe
|
||||
instance : Min UInt16 := minOfLe
|
||||
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNat (n : @& Nat) : UInt32 := ⟨Fin.ofNat n⟩
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNat' (n : Nat) (h : n < UInt32.size) : UInt32 := ⟨⟨n, h⟩⟩
|
||||
/--
|
||||
Converts the given natural number to `UInt32`, but returns `2^32 - 1` for natural numbers `>= 2^32`.
|
||||
-/
|
||||
def UInt32.ofNatTruncate (n : Nat) : UInt32 :=
|
||||
if h : n < UInt32.size then
|
||||
UInt32.ofNat' n h
|
||||
else
|
||||
UInt32.ofNat' (UInt32.size - 1) (by decide)
|
||||
abbrev Nat.toUInt32 := UInt32.ofNat
|
||||
@[extern "lean_uint32_add"]
|
||||
def UInt32.add (a b : UInt32) : UInt32 := ⟨a.val + b.val⟩
|
||||
def UInt32.add (a b : UInt32) : UInt32 := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_uint32_sub"]
|
||||
def UInt32.sub (a b : UInt32) : UInt32 := ⟨a.val - b.val⟩
|
||||
def UInt32.sub (a b : UInt32) : UInt32 := ⟨a.toBitVec - b.toBitVec⟩
|
||||
@[extern "lean_uint32_mul"]
|
||||
def UInt32.mul (a b : UInt32) : UInt32 := ⟨a.val * b.val⟩
|
||||
def UInt32.mul (a b : UInt32) : UInt32 := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_uint32_div"]
|
||||
def UInt32.div (a b : UInt32) : UInt32 := ⟨a.val / b.val⟩
|
||||
def UInt32.div (a b : UInt32) : UInt32 := ⟨BitVec.udiv a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint32_mod"]
|
||||
def UInt32.mod (a b : UInt32) : UInt32 := ⟨a.val % b.val⟩
|
||||
@[extern "lean_uint32_modn"]
|
||||
def UInt32.mod (a b : UInt32) : UInt32 := ⟨BitVec.umod a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint32_modn", deprecated UInt32.mod (since := "2024-09-23")]
|
||||
def UInt32.modn (a : UInt32) (n : @& Nat) : UInt32 := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_uint32_land"]
|
||||
def UInt32.land (a b : UInt32) : UInt32 := ⟨Fin.land a.val b.val⟩
|
||||
def UInt32.land (a b : UInt32) : UInt32 := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_uint32_lor"]
|
||||
def UInt32.lor (a b : UInt32) : UInt32 := ⟨Fin.lor a.val b.val⟩
|
||||
def UInt32.lor (a b : UInt32) : UInt32 := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_uint32_xor"]
|
||||
def UInt32.xor (a b : UInt32) : UInt32 := ⟨Fin.xor a.val b.val⟩
|
||||
def UInt32.xor (a b : UInt32) : UInt32 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_uint32_shift_left"]
|
||||
def UInt32.shiftLeft (a b : UInt32) : UInt32 := ⟨a.val <<< (modn b 32).val⟩
|
||||
def UInt32.shiftLeft (a b : UInt32) : UInt32 := ⟨a.toBitVec <<< (mod b 32).toBitVec⟩
|
||||
@[extern "lean_uint32_shift_right"]
|
||||
def UInt32.shiftRight (a b : UInt32) : UInt32 := ⟨a.val >>> (modn b 32).val⟩
|
||||
@[extern "lean_uint32_to_uint8"]
|
||||
def UInt32.toUInt8 (a : UInt32) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint32_to_uint16"]
|
||||
def UInt32.toUInt16 (a : UInt32) : UInt16 := a.toNat.toUInt16
|
||||
@[extern "lean_uint8_to_uint32"]
|
||||
def UInt8.toUInt32 (a : UInt8) : UInt32 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
@[extern "lean_uint16_to_uint32"]
|
||||
def UInt16.toUInt32 (a : UInt16) : UInt32 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
def UInt32.shiftRight (a b : UInt32) : UInt32 := ⟨a.toBitVec >>> (mod b 32).toBitVec⟩
|
||||
|
||||
instance UInt32.instOfNat : OfNat UInt32 n := ⟨UInt32.ofNat n⟩
|
||||
instance : Add UInt32 := ⟨UInt32.add⟩
|
||||
instance : Sub UInt32 := ⟨UInt32.sub⟩
|
||||
instance : Mul UInt32 := ⟨UInt32.mul⟩
|
||||
instance : Mod UInt32 := ⟨UInt32.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod UInt32 Nat UInt32 := ⟨UInt32.modn⟩
|
||||
|
||||
instance : Div UInt32 := ⟨UInt32.div⟩
|
||||
|
||||
@[extern "lean_uint32_complement"]
|
||||
def UInt32.complement (a:UInt32) : UInt32 := 0-(a+1)
|
||||
def UInt32.complement (a : UInt32) : UInt32 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement UInt32 := ⟨UInt32.complement⟩
|
||||
instance : AndOp UInt32 := ⟨UInt32.land⟩
|
||||
@@ -208,60 +174,45 @@ instance : Xor UInt32 := ⟨UInt32.xor⟩
|
||||
instance : ShiftLeft UInt32 := ⟨UInt32.shiftLeft⟩
|
||||
instance : ShiftRight UInt32 := ⟨UInt32.shiftRight⟩
|
||||
|
||||
@[extern "lean_uint64_of_nat"]
|
||||
def UInt64.ofNat (n : @& Nat) : UInt64 := ⟨Fin.ofNat n⟩
|
||||
abbrev Nat.toUInt64 := UInt64.ofNat
|
||||
@[extern "lean_uint64_to_nat"]
|
||||
def UInt64.toNat (n : UInt64) : Nat := n.val.val
|
||||
@[extern "lean_uint64_add"]
|
||||
def UInt64.add (a b : UInt64) : UInt64 := ⟨a.val + b.val⟩
|
||||
def UInt64.add (a b : UInt64) : UInt64 := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_uint64_sub"]
|
||||
def UInt64.sub (a b : UInt64) : UInt64 := ⟨a.val - b.val⟩
|
||||
def UInt64.sub (a b : UInt64) : UInt64 := ⟨a.toBitVec - b.toBitVec⟩
|
||||
@[extern "lean_uint64_mul"]
|
||||
def UInt64.mul (a b : UInt64) : UInt64 := ⟨a.val * b.val⟩
|
||||
def UInt64.mul (a b : UInt64) : UInt64 := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_uint64_div"]
|
||||
def UInt64.div (a b : UInt64) : UInt64 := ⟨a.val / b.val⟩
|
||||
def UInt64.div (a b : UInt64) : UInt64 := ⟨BitVec.udiv a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint64_mod"]
|
||||
def UInt64.mod (a b : UInt64) : UInt64 := ⟨a.val % b.val⟩
|
||||
@[extern "lean_uint64_modn"]
|
||||
def UInt64.mod (a b : UInt64) : UInt64 := ⟨BitVec.umod a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint64_modn", deprecated UInt64.mod (since := "2024-09-23")]
|
||||
def UInt64.modn (a : UInt64) (n : @& Nat) : UInt64 := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_uint64_land"]
|
||||
def UInt64.land (a b : UInt64) : UInt64 := ⟨Fin.land a.val b.val⟩
|
||||
def UInt64.land (a b : UInt64) : UInt64 := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_uint64_lor"]
|
||||
def UInt64.lor (a b : UInt64) : UInt64 := ⟨Fin.lor a.val b.val⟩
|
||||
def UInt64.lor (a b : UInt64) : UInt64 := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_uint64_xor"]
|
||||
def UInt64.xor (a b : UInt64) : UInt64 := ⟨Fin.xor a.val b.val⟩
|
||||
def UInt64.xor (a b : UInt64) : UInt64 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_uint64_shift_left"]
|
||||
def UInt64.shiftLeft (a b : UInt64) : UInt64 := ⟨a.val <<< (modn b 64).val⟩
|
||||
def UInt64.shiftLeft (a b : UInt64) : UInt64 := ⟨a.toBitVec <<< (mod b 64).toBitVec⟩
|
||||
@[extern "lean_uint64_shift_right"]
|
||||
def UInt64.shiftRight (a b : UInt64) : UInt64 := ⟨a.val >>> (modn b 64).val⟩
|
||||
def UInt64.lt (a b : UInt64) : Prop := a.val < b.val
|
||||
def UInt64.le (a b : UInt64) : Prop := a.val ≤ b.val
|
||||
@[extern "lean_uint64_to_uint8"]
|
||||
def UInt64.toUInt8 (a : UInt64) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint64_to_uint16"]
|
||||
def UInt64.toUInt16 (a : UInt64) : UInt16 := a.toNat.toUInt16
|
||||
@[extern "lean_uint64_to_uint32"]
|
||||
def UInt64.toUInt32 (a : UInt64) : UInt32 := a.toNat.toUInt32
|
||||
@[extern "lean_uint8_to_uint64"]
|
||||
def UInt8.toUInt64 (a : UInt8) : UInt64 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
@[extern "lean_uint16_to_uint64"]
|
||||
def UInt16.toUInt64 (a : UInt16) : UInt64 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
@[extern "lean_uint32_to_uint64"]
|
||||
def UInt32.toUInt64 (a : UInt32) : UInt64 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
def UInt64.shiftRight (a b : UInt64) : UInt64 := ⟨a.toBitVec >>> (mod b 64).toBitVec⟩
|
||||
def UInt64.lt (a b : UInt64) : Prop := a.toBitVec < b.toBitVec
|
||||
def UInt64.le (a b : UInt64) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance UInt64.instOfNat : OfNat UInt64 n := ⟨UInt64.ofNat n⟩
|
||||
instance : Add UInt64 := ⟨UInt64.add⟩
|
||||
instance : Sub UInt64 := ⟨UInt64.sub⟩
|
||||
instance : Mul UInt64 := ⟨UInt64.mul⟩
|
||||
instance : Mod UInt64 := ⟨UInt64.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod UInt64 Nat UInt64 := ⟨UInt64.modn⟩
|
||||
|
||||
instance : Div UInt64 := ⟨UInt64.div⟩
|
||||
instance : LT UInt64 := ⟨UInt64.lt⟩
|
||||
instance : LE UInt64 := ⟨UInt64.le⟩
|
||||
|
||||
@[extern "lean_uint64_complement"]
|
||||
def UInt64.complement (a:UInt64) : UInt64 := 0-(a+1)
|
||||
def UInt64.complement (a : UInt64) : UInt64 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement UInt64 := ⟨UInt64.complement⟩
|
||||
instance : AndOp UInt64 := ⟨UInt64.land⟩
|
||||
@@ -273,79 +224,52 @@ instance : ShiftRight UInt64 := ⟨UInt64.shiftRight⟩
|
||||
@[extern "lean_bool_to_uint64"]
|
||||
def Bool.toUInt64 (b : Bool) : UInt64 := if b then 1 else 0
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint64_dec_lt"]
|
||||
def UInt64.decLt (a b : UInt64) : Decidable (a < b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))
|
||||
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint64_dec_le"]
|
||||
def UInt64.decLe (a b : UInt64) : Decidable (a ≤ b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))
|
||||
inferInstanceAs (Decidable (a.toBitVec ≤ b.toBitVec))
|
||||
|
||||
instance (a b : UInt64) : Decidable (a < b) := UInt64.decLt a b
|
||||
instance (a b : UInt64) : Decidable (a ≤ b) := UInt64.decLe a b
|
||||
instance : Max UInt64 := maxOfLe
|
||||
instance : Min UInt64 := minOfLe
|
||||
|
||||
-- This instance would interfere with the global instance `NeZero (n + 1)`,
|
||||
-- so we only enable it locally.
|
||||
@[local instance]
|
||||
private def instNeZeroUSizeSize : NeZero USize.size := ⟨add_one_ne_zero _⟩
|
||||
|
||||
@[deprecated (since := "2024-09-16")]
|
||||
theorem usize_size_gt_zero : USize.size > 0 :=
|
||||
Nat.zero_lt_succ ..
|
||||
|
||||
@[extern "lean_usize_of_nat"]
|
||||
def USize.ofNat (n : @& Nat) : USize := ⟨Fin.ofNat' _ n⟩
|
||||
abbrev Nat.toUSize := USize.ofNat
|
||||
@[extern "lean_usize_to_nat"]
|
||||
def USize.toNat (n : USize) : Nat := n.val.val
|
||||
@[extern "lean_usize_add"]
|
||||
def USize.add (a b : USize) : USize := ⟨a.val + b.val⟩
|
||||
@[extern "lean_usize_sub"]
|
||||
def USize.sub (a b : USize) : USize := ⟨a.val - b.val⟩
|
||||
@[extern "lean_usize_mul"]
|
||||
def USize.mul (a b : USize) : USize := ⟨a.val * b.val⟩
|
||||
def USize.mul (a b : USize) : USize := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_usize_div"]
|
||||
def USize.div (a b : USize) : USize := ⟨a.val / b.val⟩
|
||||
def USize.div (a b : USize) : USize := ⟨a.toBitVec / b.toBitVec⟩
|
||||
@[extern "lean_usize_mod"]
|
||||
def USize.mod (a b : USize) : USize := ⟨a.val % b.val⟩
|
||||
@[extern "lean_usize_modn"]
|
||||
def USize.mod (a b : USize) : USize := ⟨a.toBitVec % b.toBitVec⟩
|
||||
@[extern "lean_usize_modn", deprecated USize.mod (since := "2024-09-23")]
|
||||
def USize.modn (a : USize) (n : @& Nat) : USize := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_usize_land"]
|
||||
def USize.land (a b : USize) : USize := ⟨Fin.land a.val b.val⟩
|
||||
def USize.land (a b : USize) : USize := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_usize_lor"]
|
||||
def USize.lor (a b : USize) : USize := ⟨Fin.lor a.val b.val⟩
|
||||
def USize.lor (a b : USize) : USize := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_usize_xor"]
|
||||
def USize.xor (a b : USize) : USize := ⟨Fin.xor a.val b.val⟩
|
||||
def USize.xor (a b : USize) : USize := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_usize_shift_left"]
|
||||
def USize.shiftLeft (a b : USize) : USize := ⟨a.val <<< (modn b System.Platform.numBits).val⟩
|
||||
def USize.shiftLeft (a b : USize) : USize := ⟨a.toBitVec <<< (mod b (USize.ofNat System.Platform.numBits)).toBitVec⟩
|
||||
@[extern "lean_usize_shift_right"]
|
||||
def USize.shiftRight (a b : USize) : USize := ⟨a.val >>> (modn b System.Platform.numBits).val⟩
|
||||
def USize.shiftRight (a b : USize) : USize := ⟨a.toBitVec >>> (mod b (USize.ofNat System.Platform.numBits)).toBitVec⟩
|
||||
@[extern "lean_uint32_to_usize"]
|
||||
def UInt32.toUSize (a : UInt32) : USize := USize.ofNat32 a.val a.1.2
|
||||
def UInt32.toUSize (a : UInt32) : USize := USize.ofNat32 a.toBitVec.toNat a.toBitVec.isLt
|
||||
@[extern "lean_usize_to_uint32"]
|
||||
def USize.toUInt32 (a : USize) : UInt32 := a.toNat.toUInt32
|
||||
|
||||
def USize.lt (a b : USize) : Prop := a.val < b.val
|
||||
def USize.le (a b : USize) : Prop := a.val ≤ b.val
|
||||
|
||||
instance USize.instOfNat : OfNat USize n := ⟨USize.ofNat n⟩
|
||||
instance : Add USize := ⟨USize.add⟩
|
||||
instance : Sub USize := ⟨USize.sub⟩
|
||||
instance : Mul USize := ⟨USize.mul⟩
|
||||
instance : Mod USize := ⟨USize.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod USize Nat USize := ⟨USize.modn⟩
|
||||
|
||||
instance : Div USize := ⟨USize.div⟩
|
||||
instance : LT USize := ⟨USize.lt⟩
|
||||
instance : LE USize := ⟨USize.le⟩
|
||||
|
||||
@[extern "lean_usize_complement"]
|
||||
def USize.complement (a:USize) : USize := 0-(a+1)
|
||||
def USize.complement (a : USize) : USize := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement USize := ⟨USize.complement⟩
|
||||
instance : AndOp USize := ⟨USize.land⟩
|
||||
@@ -354,19 +278,5 @@ instance : Xor USize := ⟨USize.xor⟩
|
||||
instance : ShiftLeft USize := ⟨USize.shiftLeft⟩
|
||||
instance : ShiftRight USize := ⟨USize.shiftRight⟩
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_usize_dec_lt"]
|
||||
def USize.decLt (a b : USize) : Decidable (a < b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_usize_dec_le"]
|
||||
def USize.decLe (a b : USize) : Decidable (a ≤ b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))
|
||||
|
||||
instance (a b : USize) : Decidable (a < b) := USize.decLt a b
|
||||
instance (a b : USize) : Decidable (a ≤ b) := USize.decLe a b
|
||||
instance : Max USize := maxOfLe
|
||||
instance : Min USize := minOfLe
|
||||
|
||||
132
src/Init/Data/UInt/BasicAux.lean
Normal file
132
src/Init/Data/UInt/BasicAux.lean
Normal file
@@ -0,0 +1,132 @@
|
||||
/-
|
||||
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Fin.Basic
|
||||
import Init.Data.BitVec.BasicAux
|
||||
|
||||
/-!
|
||||
This module exists to provide the very basic `UInt8` etc. definitions required for
|
||||
`Init.Data.Char.Basic` and `Init.Data.Array.Basic`. These are very important as they are used in
|
||||
meta code that is then (transitively) used in `Init.Data.UInt.Basic` and `Init.Data.BitVec.Basic`.
|
||||
This file thus breaks the import cycle that would be created by this dependency.
|
||||
-/
|
||||
|
||||
open Nat
|
||||
|
||||
def UInt8.val (x : UInt8) : Fin UInt8.size := x.toBitVec.toFin
|
||||
@[extern "lean_uint8_of_nat"]
|
||||
def UInt8.ofNat (n : @& Nat) : UInt8 := ⟨BitVec.ofNat 8 n⟩
|
||||
abbrev Nat.toUInt8 := UInt8.ofNat
|
||||
@[extern "lean_uint8_to_nat"]
|
||||
def UInt8.toNat (n : UInt8) : Nat := n.toBitVec.toNat
|
||||
|
||||
instance UInt8.instOfNat : OfNat UInt8 n := ⟨UInt8.ofNat n⟩
|
||||
|
||||
def UInt16.val (x : UInt16) : Fin UInt16.size := x.toBitVec.toFin
|
||||
@[extern "lean_uint16_of_nat"]
|
||||
def UInt16.ofNat (n : @& Nat) : UInt16 := ⟨BitVec.ofNat 16 n⟩
|
||||
abbrev Nat.toUInt16 := UInt16.ofNat
|
||||
@[extern "lean_uint16_to_nat"]
|
||||
def UInt16.toNat (n : UInt16) : Nat := n.toBitVec.toNat
|
||||
@[extern "lean_uint16_to_uint8"]
|
||||
def UInt16.toUInt8 (a : UInt16) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint8_to_uint16"]
|
||||
def UInt8.toUInt16 (a : UInt8) : UInt16 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
|
||||
instance UInt16.instOfNat : OfNat UInt16 n := ⟨UInt16.ofNat n⟩
|
||||
|
||||
def UInt32.val (x : UInt32) : Fin UInt32.size := x.toBitVec.toFin
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNat (n : @& Nat) : UInt32 := ⟨BitVec.ofNat 32 n⟩
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNat' (n : Nat) (h : n < UInt32.size) : UInt32 := ⟨BitVec.ofNatLt n h⟩
|
||||
/--
|
||||
Converts the given natural number to `UInt32`, but returns `2^32 - 1` for natural numbers `>= 2^32`.
|
||||
-/
|
||||
def UInt32.ofNatTruncate (n : Nat) : UInt32 :=
|
||||
if h : n < UInt32.size then
|
||||
UInt32.ofNat' n h
|
||||
else
|
||||
UInt32.ofNat' (UInt32.size - 1) (by decide)
|
||||
abbrev Nat.toUInt32 := UInt32.ofNat
|
||||
@[extern "lean_uint32_to_uint8"]
|
||||
def UInt32.toUInt8 (a : UInt32) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint32_to_uint16"]
|
||||
def UInt32.toUInt16 (a : UInt32) : UInt16 := a.toNat.toUInt16
|
||||
@[extern "lean_uint8_to_uint32"]
|
||||
def UInt8.toUInt32 (a : UInt8) : UInt32 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
@[extern "lean_uint16_to_uint32"]
|
||||
def UInt16.toUInt32 (a : UInt16) : UInt32 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
|
||||
instance UInt32.instOfNat : OfNat UInt32 n := ⟨UInt32.ofNat n⟩
|
||||
|
||||
theorem UInt32.ofNat'_lt_of_lt {n m : Nat} (h1 : n < UInt32.size) (h2 : m < UInt32.size) :
|
||||
n < m → UInt32.ofNat' n h1 < UInt32.ofNat m := by
|
||||
simp only [(· < ·), BitVec.toNat, ofNat', BitVec.ofNatLt, ofNat, BitVec.ofNat, Fin.ofNat',
|
||||
Nat.mod_eq_of_lt h2, imp_self]
|
||||
|
||||
theorem UInt32.lt_ofNat'_of_lt {n m : Nat} (h1 : n < UInt32.size) (h2 : m < UInt32.size) :
|
||||
m < n → UInt32.ofNat m < UInt32.ofNat' n h1 := by
|
||||
simp only [(· < ·), BitVec.toNat, ofNat', BitVec.ofNatLt, ofNat, BitVec.ofNat, Fin.ofNat',
|
||||
Nat.mod_eq_of_lt h2, imp_self]
|
||||
|
||||
def UInt64.val (x : UInt64) : Fin UInt64.size := x.toBitVec.toFin
|
||||
@[extern "lean_uint64_of_nat"]
|
||||
def UInt64.ofNat (n : @& Nat) : UInt64 := ⟨BitVec.ofNat 64 n⟩
|
||||
abbrev Nat.toUInt64 := UInt64.ofNat
|
||||
@[extern "lean_uint64_to_nat"]
|
||||
def UInt64.toNat (n : UInt64) : Nat := n.toBitVec.toNat
|
||||
@[extern "lean_uint64_to_uint8"]
|
||||
def UInt64.toUInt8 (a : UInt64) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint64_to_uint16"]
|
||||
def UInt64.toUInt16 (a : UInt64) : UInt16 := a.toNat.toUInt16
|
||||
@[extern "lean_uint64_to_uint32"]
|
||||
def UInt64.toUInt32 (a : UInt64) : UInt32 := a.toNat.toUInt32
|
||||
@[extern "lean_uint8_to_uint64"]
|
||||
def UInt8.toUInt64 (a : UInt8) : UInt64 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
@[extern "lean_uint16_to_uint64"]
|
||||
def UInt16.toUInt64 (a : UInt16) : UInt64 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
@[extern "lean_uint32_to_uint64"]
|
||||
def UInt32.toUInt64 (a : UInt32) : UInt64 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
|
||||
instance UInt64.instOfNat : OfNat UInt64 n := ⟨UInt64.ofNat n⟩
|
||||
|
||||
theorem usize_size_gt_zero : USize.size > 0 := by
|
||||
cases usize_size_eq with
|
||||
| inl h => rw [h]; decide
|
||||
| inr h => rw [h]; decide
|
||||
|
||||
def USize.val (x : USize) : Fin USize.size := x.toBitVec.toFin
|
||||
@[extern "lean_usize_of_nat"]
|
||||
def USize.ofNat (n : @& Nat) : USize := ⟨BitVec.ofNat _ n⟩
|
||||
abbrev Nat.toUSize := USize.ofNat
|
||||
@[extern "lean_usize_to_nat"]
|
||||
def USize.toNat (n : USize) : Nat := n.toBitVec.toNat
|
||||
@[extern "lean_usize_add"]
|
||||
def USize.add (a b : USize) : USize := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_usize_sub"]
|
||||
def USize.sub (a b : USize) : USize := ⟨a.toBitVec - b.toBitVec⟩
|
||||
|
||||
def USize.lt (a b : USize) : Prop := a.toBitVec < b.toBitVec
|
||||
def USize.le (a b : USize) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance USize.instOfNat : OfNat USize n := ⟨USize.ofNat n⟩
|
||||
|
||||
instance : Add USize := ⟨USize.add⟩
|
||||
instance : Sub USize := ⟨USize.sub⟩
|
||||
instance : LT USize := ⟨USize.lt⟩
|
||||
instance : LE USize := ⟨USize.le⟩
|
||||
|
||||
@[extern "lean_usize_dec_lt"]
|
||||
def USize.decLt (a b : USize) : Decidable (a < b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
|
||||
|
||||
@[extern "lean_usize_dec_le"]
|
||||
def USize.decLe (a b : USize) : Decidable (a ≤ b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec ≤ b.toBitVec))
|
||||
|
||||
instance (a b : USize) : Decidable (a < b) := USize.decLt a b
|
||||
instance (a b : USize) : Decidable (a ≤ b) := USize.decLe a b
|
||||
@@ -6,13 +6,14 @@ Authors: Markus Himmel
|
||||
prelude
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.Fin.Bitwise
|
||||
import Init.Data.BitVec.Lemmas
|
||||
|
||||
set_option hygiene false in
|
||||
macro "declare_bitwise_uint_theorems" typeName:ident : command =>
|
||||
`(
|
||||
namespace $typeName
|
||||
|
||||
@[simp] protected theorem and_toNat (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := Fin.and_val ..
|
||||
@[simp] protected theorem and_toNat (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := BitVec.toNat_and ..
|
||||
|
||||
end $typeName
|
||||
)
|
||||
|
||||
@@ -6,6 +6,8 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.Fin.Lemmas
|
||||
import Init.Data.BitVec.Lemmas
|
||||
import Init.Data.BitVec.Bitblast
|
||||
|
||||
set_option hygiene false in
|
||||
macro "declare_uint_theorems" typeName:ident : command =>
|
||||
@@ -17,50 +19,111 @@ instance : Inhabited $typeName where
|
||||
|
||||
theorem zero_def : (0 : $typeName) = ⟨0⟩ := rfl
|
||||
theorem one_def : (1 : $typeName) = ⟨1⟩ := rfl
|
||||
theorem sub_def (a b : $typeName) : a - b = ⟨a.val - b.val⟩ := rfl
|
||||
theorem mul_def (a b : $typeName) : a * b = ⟨a.val * b.val⟩ := rfl
|
||||
theorem mod_def (a b : $typeName) : a % b = ⟨a.val % b.val⟩ := rfl
|
||||
theorem add_def (a b : $typeName) : a + b = ⟨a.val + b.val⟩ := rfl
|
||||
theorem sub_def (a b : $typeName) : a - b = ⟨a.toBitVec - b.toBitVec⟩ := rfl
|
||||
theorem mul_def (a b : $typeName) : a * b = ⟨a.toBitVec * b.toBitVec⟩ := rfl
|
||||
theorem mod_def (a b : $typeName) : a % b = ⟨a.toBitVec % b.toBitVec⟩ := rfl
|
||||
theorem add_def (a b : $typeName) : a + b = ⟨a.toBitVec + b.toBitVec⟩ := rfl
|
||||
|
||||
@[simp] theorem mk_val_eq : ∀ (a : $typeName), mk a.val = a
|
||||
@[simp] theorem mk_toBitVec_eq : ∀ (a : $typeName), mk a.toBitVec = a
|
||||
| ⟨_, _⟩ => rfl
|
||||
theorem val_eq_of_lt {a : Nat} : a < size → ((ofNat a).val : Nat) = a :=
|
||||
Nat.mod_eq_of_lt
|
||||
theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
|
||||
rw [toNat, val_eq_of_lt h]
|
||||
|
||||
theorem le_def {a b : $typeName} : a ≤ b ↔ a.1 ≤ b.1 := .rfl
|
||||
theorem lt_def {a b : $typeName} : a < b ↔ a.1 < b.1 := .rfl
|
||||
theorem lt_iff_val_lt_val {a b : $typeName} : a < b ↔ a.val < b.val := .rfl
|
||||
@[simp] protected theorem not_le {a b : $typeName} : ¬ a ≤ b ↔ b < a := Fin.not_le
|
||||
@[simp] protected theorem not_lt {a b : $typeName} : ¬ a < b ↔ b ≤ a := Fin.not_lt
|
||||
theorem toBitVec_eq_of_lt {a : Nat} : a < size → (ofNat a).toBitVec.toNat = a :=
|
||||
Nat.mod_eq_of_lt
|
||||
|
||||
theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
|
||||
rw [toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
theorem le_def {a b : $typeName} : a ≤ b ↔ a.toBitVec ≤ b.toBitVec := .rfl
|
||||
|
||||
theorem lt_def {a b : $typeName} : a < b ↔ a.toBitVec < b.toBitVec := .rfl
|
||||
|
||||
@[simp] protected theorem not_le {a b : $typeName} : ¬ a ≤ b ↔ b < a := by simp [le_def, lt_def]
|
||||
|
||||
@[simp] protected theorem not_lt {a b : $typeName} : ¬ a < b ↔ b ≤ a := by simp [le_def, lt_def]
|
||||
|
||||
@[simp] protected theorem le_refl (a : $typeName) : a ≤ a := by simp [le_def]
|
||||
|
||||
@[simp] protected theorem lt_irrefl (a : $typeName) : ¬ a < a := by simp
|
||||
protected theorem le_trans {a b c : $typeName} : a ≤ b → b ≤ c → a ≤ c := Fin.le_trans
|
||||
protected theorem lt_trans {a b c : $typeName} : a < b → b < c → a < c := Fin.lt_trans
|
||||
protected theorem le_total (a b : $typeName) : a ≤ b ∨ b ≤ a := Fin.le_total a.1 b.1
|
||||
protected theorem lt_asymm {a b : $typeName} (h : a < b) : ¬ b < a := Fin.lt_asymm h
|
||||
protected theorem val_eq_of_eq {a b : $typeName} (h : a = b) : a.val = b.val := h ▸ rfl
|
||||
protected theorem eq_of_val_eq {a b : $typeName} (h : a.val = b.val) : a = b := by cases a; cases b; simp at h; simp [h]
|
||||
open $typeName (val_eq_of_eq) in
|
||||
protected theorem ne_of_val_ne {a b : $typeName} (h : a.val ≠ b.val) : a ≠ b := fun h' => absurd (val_eq_of_eq h') h
|
||||
open $typeName (ne_of_val_ne) in
|
||||
protected theorem ne_of_lt {a b : $typeName} (h : a < b) : a ≠ b := ne_of_val_ne (Fin.ne_of_lt h)
|
||||
|
||||
protected theorem le_trans {a b c : $typeName} : a ≤ b → b ≤ c → a ≤ c := BitVec.le_trans
|
||||
|
||||
protected theorem lt_trans {a b c : $typeName} : a < b → b < c → a < c := BitVec.lt_trans
|
||||
|
||||
protected theorem le_total (a b : $typeName) : a ≤ b ∨ b ≤ a := BitVec.le_total ..
|
||||
|
||||
protected theorem lt_asymm {a b : $typeName} : a < b → ¬ b < a := BitVec.lt_asymm
|
||||
|
||||
protected theorem toBitVec_eq_of_eq {a b : $typeName} (h : a = b) : a.toBitVec = b.toBitVec := h ▸ rfl
|
||||
|
||||
protected theorem eq_of_toBitVec_eq {a b : $typeName} (h : a.toBitVec = b.toBitVec) : a = b := by
|
||||
cases a; cases b; simp_all
|
||||
|
||||
open $typeName (eq_of_toBitVec_eq) in
|
||||
protected theorem eq_of_val_eq {a b : $typeName} (h : a.val = b.val) : a = b := by
|
||||
rcases a with ⟨⟨_⟩⟩; rcases b with ⟨⟨_⟩⟩; simp_all [val]
|
||||
|
||||
open $typeName (toBitVec_eq_of_eq) in
|
||||
protected theorem ne_of_toBitVec_ne {a b : $typeName} (h : a.toBitVec ≠ b.toBitVec) : a ≠ b :=
|
||||
fun h' => absurd (toBitVec_eq_of_eq h') h
|
||||
|
||||
open $typeName (ne_of_toBitVec_ne) in
|
||||
protected theorem ne_of_lt {a b : $typeName} (h : a < b) : a ≠ b := by
|
||||
apply ne_of_toBitVec_ne
|
||||
apply BitVec.ne_of_lt
|
||||
simpa [lt_def] using h
|
||||
|
||||
@[simp] protected theorem toNat_zero : (0 : $typeName).toNat = 0 := Nat.zero_mod _
|
||||
@[simp] protected theorem toNat_mod (a b : $typeName) : (a % b).toNat = a.toNat % b.toNat := Fin.mod_val ..
|
||||
@[simp] protected theorem toNat_div (a b : $typeName) : (a / b).toNat = a.toNat / b.toNat := Fin.div_val ..
|
||||
@[simp] protected theorem toNat_sub_of_le (a b : $typeName) : b ≤ a → (a - b).toNat = a.toNat - b.toNat := Fin.sub_val_of_le
|
||||
@[simp] protected theorem toNat_modn (a : $typeName) (b : Nat) : (a.modn b).toNat = a.toNat % b := Fin.modn_val ..
|
||||
protected theorem modn_lt {m : Nat} : ∀ (u : $typeName), m > 0 → toNat (u % m) < m
|
||||
| ⟨u⟩, h => Fin.modn_lt u h
|
||||
open $typeName (modn_lt) in
|
||||
protected theorem mod_lt (a b : $typeName) (h : 0 < b) : a % b < b := modn_lt _ (by simp [lt_def] at h; exact h)
|
||||
|
||||
@[simp] protected theorem toNat_mod (a b : $typeName) : (a % b).toNat = a.toNat % b.toNat := BitVec.toNat_umod ..
|
||||
|
||||
@[simp] protected theorem toNat_div (a b : $typeName) : (a / b).toNat = a.toNat / b.toNat := BitVec.toNat_udiv ..
|
||||
|
||||
@[simp] protected theorem toNat_sub_of_le (a b : $typeName) : b ≤ a → (a - b).toNat = a.toNat - b.toNat := BitVec.toNat_sub_of_le
|
||||
|
||||
protected theorem toNat_lt_size (a : $typeName) : a.toNat < size := a.toBitVec.isLt
|
||||
|
||||
open $typeName (toNat_mod toNat_lt_size) in
|
||||
protected theorem toNat_mod_lt {m : Nat} : ∀ (u : $typeName), m > 0 → toNat (u % ofNat m) < m := by
|
||||
intro u h1
|
||||
by_cases h2 : m < size
|
||||
· rw [toNat_mod, toNat_ofNat_of_lt h2]
|
||||
apply Nat.mod_lt _ h1
|
||||
· apply Nat.lt_of_lt_of_le
|
||||
· apply toNat_lt_size
|
||||
· simpa using h2
|
||||
|
||||
open $typeName (toNat_mod_lt) in
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated toNat_mod_lt (since := "2024-09-24")]
|
||||
protected theorem modn_lt {m : Nat} : ∀ (u : $typeName), m > 0 → toNat (u % m) < m := by
|
||||
intro u
|
||||
simp only [(· % ·)]
|
||||
simp only [gt_iff_lt, toNat, modn, Fin.modn_val, BitVec.natCast_eq_ofNat, BitVec.toNat_ofNat,
|
||||
Nat.reducePow]
|
||||
rw [Nat.mod_eq_of_lt]
|
||||
· apply Nat.mod_lt
|
||||
· apply Nat.lt_of_le_of_lt
|
||||
· apply Nat.mod_le
|
||||
· apply Fin.is_lt
|
||||
|
||||
protected theorem mod_lt (a : $typeName) {b : $typeName} : 0 < b → a % b < b := by
|
||||
simp only [lt_def, mod_def]
|
||||
apply BitVec.umod_lt
|
||||
|
||||
protected theorem toNat.inj : ∀ {a b : $typeName}, a.toNat = b.toNat → a = b
|
||||
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
|
||||
protected theorem toNat_lt_size (a : $typeName) : a.toNat < size := a.1.2
|
||||
|
||||
@[simp] protected theorem ofNat_one : ofNat 1 = 1 := rfl
|
||||
|
||||
@[simp]
|
||||
theorem val_ofNat (n : Nat) : val (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
|
||||
|
||||
@[simp]
|
||||
theorem toBitVec_ofNat (n : Nat) : toBitVec (no_index (OfNat.ofNat n)) = BitVec.ofNat _ n := rfl
|
||||
|
||||
@[simp]
|
||||
theorem mk_ofNat (n : Nat) : mk (BitVec.ofNat _ n) = OfNat.ofNat n := rfl
|
||||
|
||||
end $typeName
|
||||
)
|
||||
|
||||
@@ -70,27 +133,34 @@ declare_uint_theorems UInt32
|
||||
declare_uint_theorems UInt64
|
||||
declare_uint_theorems USize
|
||||
|
||||
theorem UInt32.toNat_lt_of_lt {n : UInt32} {m : Nat} (h : m < size) : n < ofNat m → n.toNat < m := by
|
||||
simp [lt_def, BitVec.lt_def, UInt32.toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
theorem UInt32.lt_toNat_of_lt {n : UInt32} {m : Nat} (h : m < size) : ofNat m < n → m < n.toNat := by
|
||||
simp [lt_def, BitVec.lt_def, UInt32.toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
theorem UInt32.toNat_le_of_le {n : UInt32} {m : Nat} (h : m < size) : n ≤ ofNat m → n.toNat ≤ m := by
|
||||
simp [le_def, BitVec.le_def, UInt32.toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
theorem UInt32.le_toNat_of_le {n : UInt32} {m : Nat} (h : m < size) : ofNat m ≤ n → m ≤ n.toNat := by
|
||||
simp [le_def, BitVec.le_def, UInt32.toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt8.zero_toNat := @UInt8.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt8.div_toNat := @UInt8.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt8.mod_toNat := @UInt8.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt8.modn_toNat := @UInt8.toNat_modn
|
||||
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.zero_toNat := @UInt16.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.div_toNat := @UInt16.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.mod_toNat := @UInt16.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.modn_toNat := @UInt16.toNat_modn
|
||||
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.zero_toNat := @UInt32.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.div_toNat := @UInt32.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.mod_toNat := @UInt32.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.modn_toNat := @UInt32.toNat_modn
|
||||
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.zero_toNat := @UInt64.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.div_toNat := @UInt64.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.mod_toNat := @UInt64.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.modn_toNat := @UInt64.toNat_modn
|
||||
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev USize.zero_toNat := @USize.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev USize.div_toNat := @USize.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev USize.mod_toNat := @USize.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev USize.modn_toNat := @USize.toNat_modn
|
||||
|
||||
@@ -7,16 +7,16 @@ prelude
|
||||
import Init.Data.Fin.Log2
|
||||
|
||||
@[extern "lean_uint8_log2"]
|
||||
def UInt8.log2 (a : UInt8) : UInt8 := ⟨Fin.log2 a.val⟩
|
||||
def UInt8.log2 (a : UInt8) : UInt8 := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@[extern "lean_uint16_log2"]
|
||||
def UInt16.log2 (a : UInt16) : UInt16 := ⟨Fin.log2 a.val⟩
|
||||
def UInt16.log2 (a : UInt16) : UInt16 := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@[extern "lean_uint32_log2"]
|
||||
def UInt32.log2 (a : UInt32) : UInt32 := ⟨Fin.log2 a.val⟩
|
||||
def UInt32.log2 (a : UInt32) : UInt32 := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@[extern "lean_uint64_log2"]
|
||||
def UInt64.log2 (a : UInt64) : UInt64 := ⟨Fin.log2 a.val⟩
|
||||
def UInt64.log2 (a : UInt64) : UInt64 := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@[extern "lean_usize_log2"]
|
||||
def USize.log2 (a : USize) : USize := ⟨Fin.log2 a.val⟩
|
||||
def USize.log2 (a : USize) : USize := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@@ -224,11 +224,7 @@ structure Config where
|
||||
-/
|
||||
index : Bool := true
|
||||
/--
|
||||
When `true` (default: `true`), `simp` will **not** create a proof for a rewriting rule associated
|
||||
with an `rfl`-theorem.
|
||||
Rewriting rules are provided by users by annotating theorems with the attribute `@[simp]`.
|
||||
If the proof of the theorem is just `rfl` (reflexivity), and `implicitDefEqProofs := true`, `simp`
|
||||
will **not** create a proof term which is an application of the annotated theorem.
|
||||
This option does not have any effect (yet).
|
||||
-/
|
||||
implicitDefEqProofs : Bool := true
|
||||
deriving Inhabited, BEq
|
||||
|
||||
@@ -10,6 +10,7 @@ import Init.Data.ToString.Basic
|
||||
import Init.Data.Array.Subarray
|
||||
import Init.Conv
|
||||
import Init.Meta
|
||||
import Init.While
|
||||
|
||||
namespace Lean
|
||||
|
||||
@@ -168,9 +169,9 @@ end Lean
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander sorryAx] def unexpandSorryAx : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) _) => `(sorry)
|
||||
| `($(_) _ _) => `(sorry)
|
||||
| _ => throw ()
|
||||
| `($(_) $_) => `(sorry)
|
||||
| `($(_) $_ $_) => `(sorry)
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Eq.ndrec] def unexpandEqNDRec : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) $m $h) => `($h ▸ $m)
|
||||
@@ -344,42 +345,6 @@ 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))
|
||||
|
||||
|
||||
@@ -1592,9 +1592,6 @@ def Nat.beq : (@& Nat) → (@& Nat) → Bool
|
||||
| succ _, zero => false
|
||||
| succ n, succ m => beq n m
|
||||
|
||||
instance : BEq Nat where
|
||||
beq := Nat.beq
|
||||
|
||||
theorem Nat.eq_of_beq_eq_true : {n m : Nat} → Eq (beq n m) true → Eq n m
|
||||
| zero, zero, _ => rfl
|
||||
| zero, succ _, h => Bool.noConfusion h
|
||||
@@ -1869,6 +1866,52 @@ instance {n} : LE (Fin n) where
|
||||
instance Fin.decLt {n} (a b : Fin n) : Decidable (LT.lt a b) := Nat.decLt ..
|
||||
instance Fin.decLe {n} (a b : Fin n) : Decidable (LE.le a b) := Nat.decLe ..
|
||||
|
||||
/--
|
||||
A bitvector of the specified width.
|
||||
|
||||
This is represented as the underlying `Nat` number in both the runtime
|
||||
and the kernel, inheriting all the special support for `Nat`.
|
||||
-/
|
||||
structure BitVec (w : Nat) where
|
||||
/-- Construct a `BitVec w` from a number less than `2^w`.
|
||||
O(1), because we use `Fin` as the internal representation of a bitvector. -/
|
||||
ofFin ::
|
||||
/-- Interpret a bitvector as a number less than `2^w`.
|
||||
O(1), because we use `Fin` as the internal representation of a bitvector. -/
|
||||
toFin : Fin (hPow 2 w)
|
||||
|
||||
/--
|
||||
Bitvectors have decidable equality. This should be used via the instance `DecidableEq (BitVec n)`.
|
||||
-/
|
||||
-- We manually derive the `DecidableEq` instances for `BitVec` because
|
||||
-- we want to have builtin support for bit-vector literals, and we
|
||||
-- need a name for this function to implement `canUnfoldAtMatcher` at `WHNF.lean`.
|
||||
def BitVec.decEq (x y : BitVec n) : Decidable (Eq x y) :=
|
||||
match x, y with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => BitVec.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq (BitVec n) := BitVec.decEq
|
||||
|
||||
/-- The `BitVec` with value `i`, given a proof that `i < 2^n`. -/
|
||||
@[match_pattern]
|
||||
protected def BitVec.ofNatLt {n : Nat} (i : Nat) (p : LT.lt i (hPow 2 n)) : BitVec n where
|
||||
toFin := ⟨i, p⟩
|
||||
|
||||
/-- Given a bitvector `x`, return the underlying `Nat`. This is O(1) because `BitVec` is a
|
||||
(zero-cost) wrapper around a `Nat`. -/
|
||||
protected def BitVec.toNat (x : BitVec n) : Nat := x.toFin.val
|
||||
|
||||
instance : LT (BitVec n) where lt := (LT.lt ·.toNat ·.toNat)
|
||||
instance (x y : BitVec n) : Decidable (LT.lt x y) :=
|
||||
inferInstanceAs (Decidable (LT.lt x.toNat y.toNat))
|
||||
|
||||
instance : LE (BitVec n) where le := (LE.le ·.toNat ·.toNat)
|
||||
instance (x y : BitVec n) : Decidable (LE.le x y) :=
|
||||
inferInstanceAs (Decidable (LE.le x.toNat y.toNat))
|
||||
|
||||
/-- The size of type `UInt8`, that is, `2^8 = 256`. -/
|
||||
abbrev UInt8.size : Nat := 256
|
||||
|
||||
@@ -1877,12 +1920,12 @@ The type of unsigned 8-bit integers. This type has special support in the
|
||||
compiler to make it actually 8 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure UInt8 where
|
||||
/-- Unpack a `UInt8` as a `Nat` less than `2^8`.
|
||||
/-- Unpack a `UInt8` as a `BitVec 8`.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin UInt8.size
|
||||
toBitVec : BitVec 8
|
||||
|
||||
attribute [extern "lean_uint8_of_nat_mk"] UInt8.mk
|
||||
attribute [extern "lean_uint8_to_nat"] UInt8.val
|
||||
attribute [extern "lean_uint8_to_nat"] UInt8.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `2^8` into a `UInt8`.
|
||||
@@ -1890,7 +1933,7 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint8_of_nat"]
|
||||
def UInt8.ofNatCore (n : @& Nat) (h : LT.lt n UInt8.size) : UInt8 where
|
||||
val := { val := n, isLt := h }
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -1901,7 +1944,9 @@ This function is overridden with a native implementation.
|
||||
def UInt8.decEq (a b : UInt8) : Decidable (Eq a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m) (fun h => isTrue (h ▸ rfl)) (fun h => isFalse (fun h' => UInt8.noConfusion h' (fun h' => absurd h' h)))
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => UInt8.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq UInt8 := UInt8.decEq
|
||||
|
||||
@@ -1916,12 +1961,12 @@ The type of unsigned 16-bit integers. This type has special support in the
|
||||
compiler to make it actually 16 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure UInt16 where
|
||||
/-- Unpack a `UInt16` as a `Nat` less than `2^16`.
|
||||
/-- Unpack a `UInt16` as a `BitVec 16`.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin UInt16.size
|
||||
toBitVec : BitVec 16
|
||||
|
||||
attribute [extern "lean_uint16_of_nat_mk"] UInt16.mk
|
||||
attribute [extern "lean_uint16_to_nat"] UInt16.val
|
||||
attribute [extern "lean_uint16_to_nat"] UInt16.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `2^16` into a `UInt16`.
|
||||
@@ -1929,7 +1974,7 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint16_of_nat"]
|
||||
def UInt16.ofNatCore (n : @& Nat) (h : LT.lt n UInt16.size) : UInt16 where
|
||||
val := { val := n, isLt := h }
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -1940,7 +1985,9 @@ This function is overridden with a native implementation.
|
||||
def UInt16.decEq (a b : UInt16) : Decidable (Eq a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m) (fun h => isTrue (h ▸ rfl)) (fun h => isFalse (fun h' => UInt16.noConfusion h' (fun h' => absurd h' h)))
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => UInt16.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq UInt16 := UInt16.decEq
|
||||
|
||||
@@ -1955,12 +2002,12 @@ The type of unsigned 32-bit integers. This type has special support in the
|
||||
compiler to make it actually 32 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure UInt32 where
|
||||
/-- Unpack a `UInt32` as a `Nat` less than `2^32`.
|
||||
/-- Unpack a `UInt32` as a `BitVec 32.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin UInt32.size
|
||||
toBitVec : BitVec 32
|
||||
|
||||
attribute [extern "lean_uint32_of_nat_mk"] UInt32.mk
|
||||
attribute [extern "lean_uint32_to_nat"] UInt32.val
|
||||
attribute [extern "lean_uint32_to_nat"] UInt32.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `2^32` into a `UInt32`.
|
||||
@@ -1968,14 +2015,14 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNatCore (n : @& Nat) (h : LT.lt n UInt32.size) : UInt32 where
|
||||
val := { val := n, isLt := h }
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
/--
|
||||
Unpack a `UInt32` as a `Nat`.
|
||||
This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_to_nat"]
|
||||
def UInt32.toNat (n : UInt32) : Nat := n.val.val
|
||||
def UInt32.toNat (n : UInt32) : Nat := n.toBitVec.toNat
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -1994,30 +2041,26 @@ instance : Inhabited UInt32 where
|
||||
default := UInt32.ofNatCore 0 (by decide)
|
||||
|
||||
instance : LT UInt32 where
|
||||
lt a b := LT.lt a.val b.val
|
||||
lt a b := LT.lt a.toBitVec b.toBitVec
|
||||
|
||||
instance : LE UInt32 where
|
||||
le a b := LE.le a.val b.val
|
||||
le a b := LE.le a.toBitVec b.toBitVec
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
Decides less-equal on `UInt32`.
|
||||
This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_dec_lt"]
|
||||
def UInt32.decLt (a b : UInt32) : Decidable (LT.lt a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (LT.lt n m))
|
||||
inferInstanceAs (Decidable (LT.lt a.toBitVec b.toBitVec))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
Decides less-than on `UInt32`.
|
||||
This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_dec_le"]
|
||||
def UInt32.decLe (a b : UInt32) : Decidable (LE.le a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (LE.le n m))
|
||||
inferInstanceAs (Decidable (LE.le a.toBitVec b.toBitVec))
|
||||
|
||||
instance (a b : UInt32) : Decidable (LT.lt a b) := UInt32.decLt a b
|
||||
instance (a b : UInt32) : Decidable (LE.le a b) := UInt32.decLe a b
|
||||
@@ -2031,12 +2074,12 @@ The type of unsigned 64-bit integers. This type has special support in the
|
||||
compiler to make it actually 64 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure UInt64 where
|
||||
/-- Unpack a `UInt64` as a `Nat` less than `2^64`.
|
||||
/-- Unpack a `UInt64` as a `BitVec 64`.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin UInt64.size
|
||||
toBitVec: BitVec 64
|
||||
|
||||
attribute [extern "lean_uint64_of_nat_mk"] UInt64.mk
|
||||
attribute [extern "lean_uint64_to_nat"] UInt64.val
|
||||
attribute [extern "lean_uint64_to_nat"] UInt64.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `2^64` into a `UInt64`.
|
||||
@@ -2044,7 +2087,7 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint64_of_nat"]
|
||||
def UInt64.ofNatCore (n : @& Nat) (h : LT.lt n UInt64.size) : UInt64 where
|
||||
val := { val := n, isLt := h }
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -2055,36 +2098,20 @@ This function is overridden with a native implementation.
|
||||
def UInt64.decEq (a b : UInt64) : Decidable (Eq a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m) (fun h => isTrue (h ▸ rfl)) (fun h => isFalse (fun h' => UInt64.noConfusion h' (fun h' => absurd h' h)))
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => UInt64.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq UInt64 := UInt64.decEq
|
||||
|
||||
instance : Inhabited UInt64 where
|
||||
default := UInt64.ofNatCore 0 (by decide)
|
||||
|
||||
/--
|
||||
The size of type `USize`, that is, `2^System.Platform.numBits`, which may
|
||||
be either `2^32` or `2^64` depending on the platform's architecture.
|
||||
|
||||
Remark: we define `USize.size` using `(2^numBits - 1) + 1` to ensure the
|
||||
Lean unifier can solve constraints such as `?m + 1 = USize.size`. Recall that
|
||||
`numBits` does not reduce to a numeral in the Lean kernel since it is platform
|
||||
specific. Without this trick, the following definition would be rejected by the
|
||||
Lean type checker.
|
||||
```
|
||||
def one: Fin USize.size := 1
|
||||
```
|
||||
Because Lean would fail to synthesize instance `OfNat (Fin USize.size) 1`.
|
||||
Recall that the `OfNat` instance for `Fin` is
|
||||
```
|
||||
instance : OfNat (Fin (n+1)) i where
|
||||
ofNat := Fin.ofNat i
|
||||
```
|
||||
-/
|
||||
abbrev USize.size : Nat := hAdd (hSub (hPow 2 System.Platform.numBits) 1) 1
|
||||
/-- The size of type `USize`, that is, `2^System.Platform.numBits`. -/
|
||||
abbrev USize.size : Nat := (hPow 2 System.Platform.numBits)
|
||||
|
||||
theorem usize_size_eq : Or (Eq USize.size 4294967296) (Eq USize.size 18446744073709551616) :=
|
||||
show Or (Eq (Nat.succ (Nat.sub (hPow 2 System.Platform.numBits) 1)) 4294967296) (Eq (Nat.succ (Nat.sub (hPow 2 System.Platform.numBits) 1)) 18446744073709551616) from
|
||||
show Or (Eq (hPow 2 System.Platform.numBits) 4294967296) (Eq (hPow 2 System.Platform.numBits) 18446744073709551616) from
|
||||
match System.Platform.numBits, System.Platform.numBits_eq with
|
||||
| _, Or.inl rfl => Or.inl (by decide)
|
||||
| _, Or.inr rfl => Or.inr (by decide)
|
||||
@@ -2097,21 +2124,20 @@ For example, if running on a 32-bit machine, USize is equivalent to UInt32.
|
||||
Or on a 64-bit machine, UInt64.
|
||||
-/
|
||||
structure USize where
|
||||
/-- Unpack a `USize` as a `Nat` less than `USize.size`.
|
||||
/-- Unpack a `USize` as a `BitVec System.Platform.numBits`.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin USize.size
|
||||
toBitVec : BitVec System.Platform.numBits
|
||||
|
||||
attribute [extern "lean_usize_of_nat_mk"] USize.mk
|
||||
attribute [extern "lean_usize_to_nat"] USize.val
|
||||
attribute [extern "lean_usize_to_nat"] USize.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `USize.size` into a `USize`.
|
||||
This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_usize_of_nat"]
|
||||
def USize.ofNatCore (n : @& Nat) (h : LT.lt n USize.size) : USize := {
|
||||
val := { val := n, isLt := h }
|
||||
}
|
||||
def USize.ofNatCore (n : @& Nat) (h : LT.lt n USize.size) : USize where
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -2122,7 +2148,9 @@ This function is overridden with a native implementation.
|
||||
def USize.decEq (a b : USize) : Decidable (Eq a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m) (fun h =>isTrue (h ▸ rfl)) (fun h => isFalse (fun h' => USize.noConfusion h' (fun h' => absurd h' h)))
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => USize.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq USize := USize.decEq
|
||||
|
||||
@@ -2138,12 +2166,12 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_usize_of_nat"]
|
||||
def USize.ofNat32 (n : @& Nat) (h : LT.lt n 4294967296) : USize where
|
||||
val := {
|
||||
val := n
|
||||
isLt := match USize.size, usize_size_eq with
|
||||
toBitVec :=
|
||||
BitVec.ofNatLt n (
|
||||
match System.Platform.numBits, System.Platform.numBits_eq with
|
||||
| _, Or.inl rfl => h
|
||||
| _, Or.inr rfl => Nat.lt_trans h (by decide)
|
||||
}
|
||||
)
|
||||
|
||||
/--
|
||||
A `Nat` denotes a valid unicode codepoint if it is less than `0x110000`, and
|
||||
@@ -2178,7 +2206,7 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def Char.ofNatAux (n : @& Nat) (h : n.isValidChar) : Char :=
|
||||
{ val := ⟨{ val := n, isLt := isValidChar_UInt32 h }⟩, valid := h }
|
||||
{ val := ⟨BitVec.ofNatLt n (isValidChar_UInt32 h)⟩, valid := h }
|
||||
|
||||
/--
|
||||
Convert a `Nat` into a `Char`. If the `Nat` does not encode a valid unicode scalar value,
|
||||
@@ -2188,7 +2216,7 @@ Convert a `Nat` into a `Char`. If the `Nat` does not encode a valid unicode scal
|
||||
def Char.ofNat (n : Nat) : Char :=
|
||||
dite (n.isValidChar)
|
||||
(fun h => Char.ofNatAux n h)
|
||||
(fun _ => { val := ⟨{ val := 0, isLt := by decide }⟩, valid := Or.inl (by decide) })
|
||||
(fun _ => { val := ⟨BitVec.ofNatLt 0 (by decide)⟩, valid := Or.inl (by decide) })
|
||||
|
||||
theorem Char.eq_of_val_eq : ∀ {c d : Char}, Eq c.val d.val → Eq c d
|
||||
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
|
||||
@@ -3448,15 +3476,13 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_usize_to_uint64"]
|
||||
def USize.toUInt64 (u : USize) : UInt64 where
|
||||
val := {
|
||||
val := u.val.val
|
||||
isLt :=
|
||||
let ⟨n, h⟩ := u
|
||||
show LT.lt n _ from
|
||||
match USize.size, usize_size_eq, h with
|
||||
| _, Or.inl rfl, h => Nat.lt_trans h (by decide)
|
||||
| _, Or.inr rfl, h => h
|
||||
}
|
||||
toBitVec := BitVec.ofNatLt u.toBitVec.toNat (
|
||||
let ⟨⟨n, h⟩⟩ := u
|
||||
show LT.lt n _ from
|
||||
match System.Platform.numBits, System.Platform.numBits_eq, h with
|
||||
| _, Or.inl rfl, h => Nat.lt_trans h (by decide)
|
||||
| _, Or.inr rfl, h => h
|
||||
)
|
||||
|
||||
/-- An opaque hash mixing operation, used to implement hashing for tuples. -/
|
||||
@[extern "lean_uint64_mix_hash"]
|
||||
|
||||
@@ -135,6 +135,10 @@ Both reduce to `b = false ∧ c = false` via `not_or`.
|
||||
|
||||
theorem not_and_of_not_or_not (h : ¬a ∨ ¬b) : ¬(a ∧ b) := h.elim (mt (·.1)) (mt (·.2))
|
||||
|
||||
/-! ## not equal -/
|
||||
|
||||
theorem ne_of_apply_ne {α β : Sort _} (f : α → β) {x y : α} : f x ≠ f y → x ≠ y :=
|
||||
mt <| congrArg _
|
||||
|
||||
/-! ## Ite -/
|
||||
|
||||
@@ -384,6 +388,17 @@ theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬p) : (∀ h' :
|
||||
|
||||
end quantifiers
|
||||
|
||||
/-! ## membership -/
|
||||
|
||||
section Mem
|
||||
variable [Membership α β] {s t : β} {a b : α}
|
||||
|
||||
theorem ne_of_mem_of_not_mem (h : a ∈ s) : b ∉ s → a ≠ b := mt fun e => e ▸ h
|
||||
|
||||
theorem ne_of_mem_of_not_mem' (h : a ∈ s) : a ∉ t → s ≠ t := mt fun e => e ▸ h
|
||||
|
||||
end Mem
|
||||
|
||||
/-! ## Nonempty -/
|
||||
|
||||
@[simp] theorem nonempty_prop {p : Prop} : Nonempty p ↔ p :=
|
||||
|
||||
@@ -67,6 +67,7 @@ deriving instance SizeOf for PLift
|
||||
deriving instance SizeOf for ULift
|
||||
deriving instance SizeOf for Decidable
|
||||
deriving instance SizeOf for Fin
|
||||
deriving instance SizeOf for BitVec
|
||||
deriving instance SizeOf for UInt8
|
||||
deriving instance SizeOf for UInt16
|
||||
deriving instance SizeOf for UInt32
|
||||
|
||||
@@ -11,22 +11,25 @@ import Init.Data.Nat.Linear
|
||||
@[simp] protected theorem Fin.sizeOf (a : Fin n) : sizeOf a = a.val + 1 := by
|
||||
cases a; simp_arith
|
||||
|
||||
@[simp] protected theorem UInt8.sizeOf (a : UInt8) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt8.toNat]
|
||||
@[simp] protected theorem BitVec.sizeOf (a : BitVec w) : sizeOf a = sizeOf a.toFin + 1 := by
|
||||
cases a; simp_arith
|
||||
|
||||
@[simp] protected theorem UInt16.sizeOf (a : UInt16) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt16.toNat]
|
||||
@[simp] protected theorem UInt8.sizeOf (a : UInt8) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [UInt8.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem UInt32.sizeOf (a : UInt32) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt32.toNat]
|
||||
@[simp] protected theorem UInt16.sizeOf (a : UInt16) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [UInt16.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem UInt64.sizeOf (a : UInt64) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt64.toNat]
|
||||
@[simp] protected theorem UInt32.sizeOf (a : UInt32) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [UInt32.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem USize.sizeOf (a : USize) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [USize.toNat]
|
||||
@[simp] protected theorem UInt64.sizeOf (a : UInt64) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [UInt64.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem Char.sizeOf (a : Char) : sizeOf a = a.toNat + 3 := by
|
||||
@[simp] protected theorem USize.sizeOf (a : USize) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [USize.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem Char.sizeOf (a : Char) : sizeOf a = a.toNat + 4 := by
|
||||
cases a; simp_arith [Char.toNat]
|
||||
|
||||
@[simp] protected theorem Subtype.sizeOf {α : Sort u_1} {p : α → Prop} (s : Subtype p) : sizeOf s = sizeOf s.val + 1 := by
|
||||
|
||||
@@ -268,9 +268,9 @@ syntax (name := case') "case' " sepBy1(caseArg, " | ") " => " tacticSeq : tactic
|
||||
`next x₁ ... xₙ => tac` additionally renames the `n` most recent hypotheses with
|
||||
inaccessible names to the given names.
|
||||
-/
|
||||
macro "next " args:binderIdent* arrowTk:" => " tac:tacticSeq : tactic =>
|
||||
macro nextTk:"next " args:binderIdent* arrowTk:" => " tac:tacticSeq : tactic =>
|
||||
-- Limit ref variability for incrementality; see Note [Incremental Macros]
|
||||
withRef arrowTk `(tactic| case _ $args* =>%$arrowTk $tac)
|
||||
withRef arrowTk `(tactic| case%$nextTk _ $args* =>%$arrowTk $tac)
|
||||
|
||||
/-- `all_goals tac` runs `tac` on each goal, concatenating the resulting goals, if any. -/
|
||||
syntax (name := allGoals) "all_goals " tacticSeq : tactic
|
||||
@@ -910,6 +910,15 @@ macro_rules | `(tactic| trivial) => `(tactic| simp)
|
||||
-/
|
||||
syntax "trivial" : tactic
|
||||
|
||||
/--
|
||||
`classical tacs` runs `tacs` in a scope where `Classical.propDecidable` is a low priority
|
||||
local instance.
|
||||
|
||||
Note that `classical` is a scoping tactic: it adds the instance only within the
|
||||
scope of the tactic.
|
||||
-/
|
||||
syntax (name := classical) "classical" ppDedent(tacticSeq) : tactic
|
||||
|
||||
/--
|
||||
The `split` tactic is useful for breaking nested if-then-else and `match` expressions into separate cases.
|
||||
For a `match` expression with `n` cases, the `split` tactic generates at most `n` subgoals.
|
||||
|
||||
51
src/Init/While.lean
Normal file
51
src/Init/While.lean
Normal file
@@ -0,0 +1,51 @@
|
||||
/-
|
||||
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
|
||||
@@ -29,7 +29,6 @@ import Lean.Server
|
||||
import Lean.ScopedEnvExtension
|
||||
import Lean.DocString
|
||||
import Lean.DeclarationRange
|
||||
import Lean.LazyInitExtension
|
||||
import Lean.LoadDynlib
|
||||
import Lean.Widget
|
||||
import Lean.Log
|
||||
|
||||
@@ -46,7 +46,7 @@ private def mkIdx {sz : Nat} (hash : UInt64) (h : sz.isPowerOfTwo) : { u : USize
|
||||
if h' : u.toNat < sz then
|
||||
⟨u, h'⟩
|
||||
else
|
||||
⟨0, by simp [USize.toNat, OfNat.ofNat, USize.ofNat]; apply Nat.pos_of_isPowerOfTwo h⟩
|
||||
⟨0, by simp; apply Nat.pos_of_isPowerOfTwo h⟩
|
||||
|
||||
@[inline] def reinsertAux (hashFn : α → UInt64) (data : HashMapBucket α β) (a : α) (b : β) : HashMapBucket α β :=
|
||||
let ⟨i, h⟩ := mkIdx (hashFn a) data.property
|
||||
|
||||
@@ -42,7 +42,7 @@ private def mkIdx {sz : Nat} (hash : UInt64) (h : sz.isPowerOfTwo) : { u : USize
|
||||
if h' : u.toNat < sz then
|
||||
⟨u, h'⟩
|
||||
else
|
||||
⟨0, by simp [USize.toNat, OfNat.ofNat, USize.ofNat]; apply Nat.pos_of_isPowerOfTwo h⟩
|
||||
⟨0, by simp; apply Nat.pos_of_isPowerOfTwo h⟩
|
||||
|
||||
@[inline] def reinsertAux (hashFn : α → UInt64) (data : HashSetBucket α) (a : α) : HashSetBucket α :=
|
||||
let ⟨i, h⟩ := mkIdx (hashFn a) data.property
|
||||
|
||||
@@ -54,7 +54,7 @@ structure WorkspaceEditClientCapabilities where
|
||||
deriving ToJson, FromJson
|
||||
|
||||
structure WorkspaceClientCapabilities where
|
||||
applyEdit: Bool
|
||||
applyEdit? : Option Bool := none
|
||||
workspaceEdit? : Option WorkspaceEditClientCapabilities := none
|
||||
deriving ToJson, FromJson
|
||||
|
||||
|
||||
@@ -7,6 +7,7 @@ prelude
|
||||
import Init.Data.Array.Basic
|
||||
import Init.NotationExtra
|
||||
import Init.Data.ToString.Macro
|
||||
import Init.Data.UInt.Basic
|
||||
|
||||
universe u v w
|
||||
|
||||
|
||||
@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Init.Data.Array.BasicAux
|
||||
import Init.Data.ToString.Macro
|
||||
import Init.Data.UInt.Basic
|
||||
|
||||
namespace Lean
|
||||
universe u v w w'
|
||||
|
||||
@@ -459,7 +459,7 @@ mutual
|
||||
|
||||
let z ← optional (Content.Character <$> CharData)
|
||||
pure #[y, z]
|
||||
let xs := #[x] ++ xs.concatMap id |>.filterMap id
|
||||
let xs := #[x] ++ xs.flatMap id |>.filterMap id
|
||||
let mut res := #[]
|
||||
for x in xs do
|
||||
if res.size > 0 then
|
||||
|
||||
@@ -369,8 +369,13 @@ def RecursorVal.getFirstIndexIdx (v : RecursorVal) : Nat :=
|
||||
def RecursorVal.getFirstMinorIdx (v : RecursorVal) : Nat :=
|
||||
v.numParams + v.numMotives
|
||||
|
||||
def RecursorVal.getInduct (v : RecursorVal) : Name :=
|
||||
v.name.getPrefix
|
||||
/-- 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!
|
||||
|
||||
inductive QuotKind where
|
||||
| type -- `Quot`
|
||||
|
||||
@@ -12,16 +12,18 @@ import Lean.Elab.Eval
|
||||
import Lean.Elab.Command
|
||||
import Lean.Elab.Open
|
||||
import Lean.Elab.SetOption
|
||||
import Init.System.Platform
|
||||
|
||||
namespace Lean.Elab.Command
|
||||
|
||||
@[builtin_command_elab moduleDoc] def elabModuleDoc : CommandElab := fun stx => do
|
||||
match stx[1] with
|
||||
| Syntax.atom _ val =>
|
||||
let doc := val.extract 0 (val.endPos - ⟨2⟩)
|
||||
let range ← Elab.getDeclarationRange stx
|
||||
modifyEnv fun env => addMainModuleDoc env ⟨doc, range⟩
|
||||
| _ => throwErrorAt stx "unexpected module doc string{indentD stx[1]}"
|
||||
match stx[1] with
|
||||
| Syntax.atom _ val =>
|
||||
let doc := val.extract 0 (val.endPos - ⟨2⟩)
|
||||
let some range ← Elab.getDeclarationRange? stx
|
||||
| return -- must be from partial syntax, ignore
|
||||
modifyEnv fun env => addMainModuleDoc env ⟨doc, range⟩
|
||||
| _ => throwErrorAt stx "unexpected module doc string{indentD stx[1]}"
|
||||
|
||||
private def addScope (isNewNamespace : Bool) (isNoncomputable : Bool) (header : String) (newNamespace : Name) : CommandElabM Unit := do
|
||||
modify fun s => { s with
|
||||
@@ -229,7 +231,7 @@ private def replaceBinderAnnotation (binder : TSyntax ``Parser.Term.bracketedBin
|
||||
|
||||
@[builtin_command_elab «variable»] def elabVariable : CommandElab
|
||||
| `(variable $binders*) => do
|
||||
let binders ← binders.concatMapM replaceBinderAnnotation
|
||||
let binders ← binders.flatMapM replaceBinderAnnotation
|
||||
-- Try to elaborate `binders` for sanity checking
|
||||
runTermElabM fun _ => Term.withSynthesize <| Term.withAutoBoundImplicit <|
|
||||
Term.elabBinders binders fun _ => pure ()
|
||||
@@ -348,7 +350,7 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
|
||||
@[builtin_command_elab Lean.Parser.Command.include] def elabInclude : CommandElab
|
||||
| `(Lean.Parser.Command.include| include $ids*) => do
|
||||
let sc ← getScope
|
||||
let vars ← sc.varDecls.concatMapM getBracketedBinderIds
|
||||
let vars ← sc.varDecls.flatMapM getBracketedBinderIds
|
||||
let mut uids := #[]
|
||||
for id in ids do
|
||||
if let some idx := vars.findIdx? (· == id.getId) then
|
||||
@@ -403,6 +405,16 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
|
||||
includedVars := sc.includedVars.filter (!omittedVars.contains ·) }
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab version] def elabVersion : CommandElab := fun _ => do
|
||||
let mut target := System.Platform.target
|
||||
if target.isEmpty then target := "unknown"
|
||||
-- Only one should be set, but good to know if multiple are set in error.
|
||||
let platforms :=
|
||||
(if System.Platform.isWindows then [" Windows"] else [])
|
||||
++ (if System.Platform.isOSX then [" macOS"] else [])
|
||||
++ (if System.Platform.isEmscripten then [" Emscripten"] else [])
|
||||
logInfo m!"Lean {Lean.versionString}\nTarget: {target}{String.join platforms}"
|
||||
|
||||
@[builtin_command_elab Parser.Command.exit] def elabExit : CommandElab := fun _ =>
|
||||
logWarning "using 'exit' to interrupt Lean"
|
||||
|
||||
|
||||
@@ -84,7 +84,7 @@ private def addAndCompileExprForEval (declName : Name) (value : Expr) (allowSorr
|
||||
-- An alternative design would be to make `elabTermForEval` into a term elaborator and elaborate the command all at once
|
||||
-- with `unsafe def _eval := term_for_eval% $t`, which we did try, but unwanted error messages
|
||||
-- such as "failed to infer definition type" can surface.
|
||||
let defView := mkDefViewOfDef { isUnsafe := true }
|
||||
let defView := mkDefViewOfDef { isUnsafe := true, stx := ⟨.missing⟩ }
|
||||
(← `(Parser.Command.definition|
|
||||
def $(mkIdent <| `_root_ ++ declName) := $(← Term.exprToSyntax value)))
|
||||
Term.elabMutualDef #[] { header := "" } #[defView]
|
||||
|
||||
@@ -135,13 +135,21 @@ open Meta
|
||||
| _ => Macro.throwUnsupported
|
||||
|
||||
@[builtin_macro Lean.Parser.Term.suffices] def expandSuffices : Macro
|
||||
| `(suffices%$tk $x:ident : $type from $val; $body) => `(have%$tk $x : $type := $body; $val)
|
||||
| `(suffices%$tk _%$x : $type from $val; $body) => `(have%$tk _%$x : $type := $body; $val)
|
||||
| `(suffices%$tk $hy:hygieneInfo $type from $val; $body) => `(have%$tk $hy:hygieneInfo : $type := $body; $val)
|
||||
| `(suffices%$tk $x:ident : $type by%$b $tac:tacticSeq; $body) => `(have%$tk $x : $type := $body; by%$b $tac)
|
||||
| `(suffices%$tk _%$x : $type by%$b $tac:tacticSeq; $body) => `(have%$tk _%$x : $type := $body; by%$b $tac)
|
||||
| `(suffices%$tk $hy:hygieneInfo $type by%$b $tac:tacticSeq; $body) => `(have%$tk $hy:hygieneInfo : $type := $body; by%$b $tac)
|
||||
| _ => Macro.throwUnsupported
|
||||
| `(suffices%$tk $x:ident : $type from $val; $body) => `(have%$tk $x : $type := $body; $val)
|
||||
| `(suffices%$tk _%$x : $type from $val; $body) => `(have%$tk _%$x : $type := $body; $val)
|
||||
| `(suffices%$tk $hy:hygieneInfo $type from $val; $body) => `(have%$tk $hy:hygieneInfo : $type := $body; $val)
|
||||
| `(suffices%$tk $x:ident : $type $b:byTactic'; $body) =>
|
||||
-- Pass on `SourceInfo` of `b` to `have`. This is necessary to display the goal state in the
|
||||
-- trailing whitespace of `by` and sound since `byTactic` and `byTactic'` are identical.
|
||||
let b := ⟨b.raw.setKind `Lean.Parser.Term.byTactic⟩
|
||||
`(have%$tk $x : $type := $body; $b:byTactic)
|
||||
| `(suffices%$tk _%$x : $type $b:byTactic'; $body) =>
|
||||
let b := ⟨b.raw.setKind `Lean.Parser.Term.byTactic⟩
|
||||
`(have%$tk _%$x : $type := $body; $b:byTactic)
|
||||
| `(suffices%$tk $hy:hygieneInfo $type $b:byTactic'; $body) =>
|
||||
let b := ⟨b.raw.setKind `Lean.Parser.Term.byTactic⟩
|
||||
`(have%$tk $hy:hygieneInfo : $type := $body; $b:byTactic)
|
||||
| _ => Macro.throwUnsupported
|
||||
|
||||
open Lean.Parser in
|
||||
private def elabParserMacroAux (prec e : Term) (withAnonymousAntiquot : Bool) : TermElabM Syntax := do
|
||||
|
||||
@@ -532,11 +532,12 @@ def elabCommandTopLevel (stx : Syntax) : CommandElabM Unit := withRef stx do pro
|
||||
let mut msgs := (← get).messages
|
||||
for tree in (← getInfoTrees) do
|
||||
trace[Elab.info] (← tree.format)
|
||||
if let some snap := (← read).snap? then
|
||||
-- We can assume that the root command snapshot is not involved in parallelism yet, so this
|
||||
-- should be true iff the command supports incrementality
|
||||
if (← IO.hasFinished snap.new.result) then
|
||||
liftCoreM <| Language.ToSnapshotTree.toSnapshotTree snap.new.result.get |>.trace
|
||||
if (← isTracingEnabledFor `Elab.snapshotTree) then
|
||||
if let some snap := (← read).snap? then
|
||||
-- We can assume that the root command snapshot is not involved in parallelism yet, so this
|
||||
-- should be true iff the command supports incrementality
|
||||
if (← IO.hasFinished snap.new.result) then
|
||||
liftCoreM <| Language.ToSnapshotTree.toSnapshotTree snap.new.result.get |>.trace
|
||||
modify fun st => { st with
|
||||
messages := initMsgs ++ msgs
|
||||
infoState := { st.infoState with trees := initInfoTrees ++ st.infoState.trees }
|
||||
@@ -571,7 +572,7 @@ def getBracketedBinderIds : Syntax → CommandElabM (Array Name)
|
||||
private def mkTermContext (ctx : Context) (s : State) : CommandElabM Term.Context := do
|
||||
let scope := s.scopes.head!
|
||||
let mut sectionVars := {}
|
||||
for id in (← scope.varDecls.concatMapM getBracketedBinderIds), uid in scope.varUIds do
|
||||
for id in (← scope.varDecls.flatMapM getBracketedBinderIds), uid in scope.varUIds do
|
||||
sectionVars := sectionVars.insert id uid
|
||||
return {
|
||||
macroStack := ctx.macroStack
|
||||
@@ -714,7 +715,7 @@ def expandDeclId (declId : Syntax) (modifiers : Modifiers) : CommandElabM Expand
|
||||
let currNamespace ← getCurrNamespace
|
||||
let currLevelNames ← getLevelNames
|
||||
let r ← Elab.expandDeclId currNamespace currLevelNames declId modifiers
|
||||
for id in (← (← getScope).varDecls.concatMapM getBracketedBinderIds) do
|
||||
for id in (← (← getScope).varDecls.flatMapM getBracketedBinderIds) do
|
||||
if id == r.shortName then
|
||||
throwError "invalid declaration name '{r.shortName}', there is a section variable with the same name"
|
||||
return r
|
||||
|
||||
@@ -57,6 +57,7 @@ inductive RecKind where
|
||||
|
||||
/-- Flags and data added to declarations (eg docstrings, attributes, `private`, `unsafe`, `partial`, ...). -/
|
||||
structure Modifiers where
|
||||
stx : TSyntax ``Parser.Command.declModifiers
|
||||
docString? : Option String := none
|
||||
visibility : Visibility := Visibility.regular
|
||||
isNoncomputable : Bool := false
|
||||
@@ -121,16 +122,16 @@ section Methods
|
||||
variable [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadMacroAdapter m] [MonadRecDepth m] [MonadTrace m] [MonadOptions m] [AddMessageContext m] [MonadLog m] [MonadInfoTree m] [MonadLiftT IO m]
|
||||
|
||||
/-- Elaborate declaration modifiers (i.e., attributes, `partial`, `private`, `protected`, `unsafe`, `noncomputable`, doc string)-/
|
||||
def elabModifiers (stx : Syntax) : m Modifiers := do
|
||||
let docCommentStx := stx[0]
|
||||
let attrsStx := stx[1]
|
||||
let visibilityStx := stx[2]
|
||||
let noncompStx := stx[3]
|
||||
let unsafeStx := stx[4]
|
||||
def elabModifiers (stx : TSyntax ``Parser.Command.declModifiers) : m Modifiers := do
|
||||
let docCommentStx := stx.raw[0]
|
||||
let attrsStx := stx.raw[1]
|
||||
let visibilityStx := stx.raw[2]
|
||||
let noncompStx := stx.raw[3]
|
||||
let unsafeStx := stx.raw[4]
|
||||
let recKind :=
|
||||
if stx[5].isNone then
|
||||
if stx.raw[5].isNone then
|
||||
RecKind.default
|
||||
else if stx[5][0].getKind == ``Parser.Command.partial then
|
||||
else if stx.raw[5][0].getKind == ``Parser.Command.partial then
|
||||
RecKind.partial
|
||||
else
|
||||
RecKind.nonrec
|
||||
@@ -148,7 +149,7 @@ def elabModifiers (stx : Syntax) : m Modifiers := do
|
||||
| none => pure #[]
|
||||
| some attrs => elabDeclAttrs attrs
|
||||
return {
|
||||
docString?, visibility, recKind, attrs,
|
||||
stx, docString?, visibility, recKind, attrs,
|
||||
isUnsafe := !unsafeStx.isNone
|
||||
isNoncomputable := !noncompStx.isNone
|
||||
}
|
||||
|
||||
@@ -104,7 +104,7 @@ def elabAxiom (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit := do
|
||||
let (binders, typeStx) := expandDeclSig stx[2]
|
||||
let scopeLevelNames ← getLevelNames
|
||||
let ⟨_, declName, allUserLevelNames⟩ ← expandDeclId declId modifiers
|
||||
addDeclarationRanges declName stx
|
||||
addDeclarationRanges declName modifiers.stx stx
|
||||
runTermElabM fun vars =>
|
||||
Term.withDeclName declName <| Term.withLevelNames allUserLevelNames <| Term.elabBinders binders.getArgs fun xs => do
|
||||
Term.applyAttributesAt declName modifiers.attrs AttributeApplicationTime.beforeElaboration
|
||||
@@ -144,10 +144,10 @@ private def inductiveSyntaxToView (modifiers : Modifiers) (decl : Syntax) : Comm
|
||||
let (binders, type?) := expandOptDeclSig decl[2]
|
||||
let declId := decl[1]
|
||||
let ⟨name, declName, levelNames⟩ ← expandDeclId declId modifiers
|
||||
addDeclarationRanges declName decl
|
||||
addDeclarationRanges declName modifiers.stx decl
|
||||
let ctors ← decl[4].getArgs.mapM fun ctor => withRef ctor do
|
||||
-- def ctor := leading_parser optional docComment >> "\n| " >> declModifiers >> rawIdent >> optDeclSig
|
||||
let mut ctorModifiers ← elabModifiers ctor[2]
|
||||
let mut ctorModifiers ← elabModifiers ⟨ctor[2]⟩
|
||||
if let some leadingDocComment := ctor[0].getOptional? then
|
||||
if ctorModifiers.docString?.isSome then
|
||||
logErrorAt leadingDocComment "duplicate doc string"
|
||||
@@ -214,17 +214,18 @@ def elabDeclaration : CommandElab := fun stx => do
|
||||
-- only case implementing incrementality currently
|
||||
elabMutualDef #[stx]
|
||||
else withoutCommandIncrementality true do
|
||||
let modifiers : TSyntax ``Parser.Command.declModifiers := ⟨stx[0]⟩
|
||||
if declKind == ``Lean.Parser.Command.«axiom» then
|
||||
let modifiers ← elabModifiers stx[0]
|
||||
let modifiers ← elabModifiers modifiers
|
||||
elabAxiom modifiers decl
|
||||
else if declKind == ``Lean.Parser.Command.«inductive» then
|
||||
let modifiers ← elabModifiers stx[0]
|
||||
let modifiers ← elabModifiers modifiers
|
||||
elabInductive modifiers decl
|
||||
else if declKind == ``Lean.Parser.Command.classInductive then
|
||||
let modifiers ← elabModifiers stx[0]
|
||||
let modifiers ← elabModifiers modifiers
|
||||
elabClassInductive modifiers decl
|
||||
else if declKind == ``Lean.Parser.Command.«structure» then
|
||||
let modifiers ← elabModifiers stx[0]
|
||||
let modifiers ← elabModifiers modifiers
|
||||
elabStructure modifiers decl
|
||||
else
|
||||
throwError "unexpected declaration"
|
||||
@@ -238,7 +239,7 @@ private def isMutualInductive (stx : Syntax) : Bool :=
|
||||
|
||||
private def elabMutualInductive (elems : Array Syntax) : CommandElabM Unit := do
|
||||
let views ← elems.mapM fun stx => do
|
||||
let modifiers ← elabModifiers stx[0]
|
||||
let modifiers ← elabModifiers ⟨stx[0]⟩
|
||||
inductiveSyntaxToView modifiers stx[1]
|
||||
elabInductiveViews views
|
||||
|
||||
@@ -399,7 +400,7 @@ def elabMutual : CommandElab := fun stx => do
|
||||
-- We need to add `id`'s ranges *before* elaborating `initFn` (and then `id` itself) as
|
||||
-- otherwise the info context created by `with_decl_name` will be incomplete and break the
|
||||
-- call hierarchy
|
||||
addDeclarationRanges fullId defStx
|
||||
addDeclarationRanges fullId ⟨defStx.raw[0]⟩ defStx.raw[1]
|
||||
elabCommand (← `(
|
||||
$[unsafe%$unsafe?]? def initFn : IO $type := with_decl_name% $(mkIdent fullId) do $doSeq
|
||||
$defStx:command))
|
||||
|
||||
@@ -11,12 +11,14 @@ import Lean.Data.Lsp.Utf16
|
||||
|
||||
namespace Lean.Elab
|
||||
|
||||
def getDeclarationRange [Monad m] [MonadFileMap m] (stx : Syntax) : m DeclarationRange := do
|
||||
def getDeclarationRange? [Monad m] [MonadFileMap m] (stx : Syntax) : m (Option DeclarationRange) := do
|
||||
let some range := stx.getRange?
|
||||
| return none
|
||||
let fileMap ← getFileMap
|
||||
let pos := stx.getPos?.getD 0
|
||||
let endPos := stx.getTailPos?.getD pos |> fileMap.toPosition
|
||||
let pos := pos |> fileMap.toPosition
|
||||
return {
|
||||
--let range := fileMap.utf8RangeToLspRange
|
||||
let pos := fileMap.toPosition range.start
|
||||
let endPos := fileMap.toPosition range.stop
|
||||
return some {
|
||||
pos := pos
|
||||
charUtf16 := fileMap.leanPosToLspPos pos |>.character
|
||||
endPos := endPos
|
||||
@@ -49,23 +51,27 @@ def getDeclarationSelectionRef (stx : Syntax) : Syntax :=
|
||||
|
||||
|
||||
/--
|
||||
Store the `range` and `selectionRange` for `declName` where `stx` is the whole syntax object describing `declName`.
|
||||
This method is for the builtin declarations only.
|
||||
User-defined commands should use `Lean.addDeclarationRanges` to store this information for their commands. -/
|
||||
def addDeclarationRanges [Monad m] [MonadEnv m] [MonadFileMap m] (declName : Name) (stx : Syntax) : m Unit := do
|
||||
if stx.getKind == ``Parser.Command.«example» then
|
||||
Stores the `range` and `selectionRange` for `declName` where `modsStx` is the modifier part and
|
||||
`cmdStx` the remaining part of the syntax tree for `declName`.
|
||||
|
||||
This method is for the builtin declarations only. User-defined commands should use
|
||||
`Lean.addDeclarationRanges` to store this information for their commands.
|
||||
-/
|
||||
def addDeclarationRanges [Monad m] [MonadEnv m] [MonadFileMap m] (declName : Name)
|
||||
(modsStx : TSyntax ``Parser.Command.declModifiers) (declStx : Syntax) : m Unit := do
|
||||
if declStx.getKind == ``Parser.Command.«example» then
|
||||
return ()
|
||||
else
|
||||
Lean.addDeclarationRanges declName {
|
||||
range := (← getDeclarationRange stx)
|
||||
selectionRange := (← getDeclarationRange (getDeclarationSelectionRef stx))
|
||||
}
|
||||
let stx := mkNullNode #[modsStx, declStx]
|
||||
-- may fail on partial syntax, ignore in that case
|
||||
let some range ← getDeclarationRange? stx | return
|
||||
let some selectionRange ← getDeclarationRange? (getDeclarationSelectionRef declStx) | return
|
||||
Lean.addDeclarationRanges declName { range, selectionRange }
|
||||
|
||||
/-- Auxiliary method for recording ranges for auxiliary declarations (e.g., fields, nested declarations, etc. -/
|
||||
def addAuxDeclarationRanges [Monad m] [MonadEnv m] [MonadFileMap m] (declName : Name) (stx : Syntax) (header : Syntax) : m Unit := do
|
||||
Lean.addDeclarationRanges declName {
|
||||
range := (← getDeclarationRange stx)
|
||||
selectionRange := (← getDeclarationRange header)
|
||||
}
|
||||
-- may fail on partial syntax, ignore in that case
|
||||
let some range ← getDeclarationRange? stx | return
|
||||
let some selectionRange ← getDeclarationRange? header | return
|
||||
Lean.addDeclarationRanges declName { range, selectionRange }
|
||||
|
||||
end Lean.Elab
|
||||
|
||||
@@ -102,7 +102,7 @@ partial def IO.processCommandsIncrementally (inputCtx : Parser.InputContext)
|
||||
where
|
||||
go initialSnap t commands :=
|
||||
let snap := t.get
|
||||
let commands := commands.push snap.data.stx
|
||||
let commands := commands.push snap.data
|
||||
if let some next := snap.nextCmdSnap? then
|
||||
go initialSnap next.task commands
|
||||
else
|
||||
@@ -111,13 +111,15 @@ where
|
||||
let messages := toSnapshotTree initialSnap
|
||||
|>.getAll.map (·.diagnostics.msgLog)
|
||||
|>.foldl (· ++ ·) {}
|
||||
let trees := toSnapshotTree initialSnap
|
||||
|>.getAll.map (·.infoTree?) |>.filterMap id |>.toPArray'
|
||||
-- In contrast to messages, we should collect info trees only from the top-level command
|
||||
-- snapshots as they subsume any info trees reported incrementally by their children.
|
||||
let trees := commands.map (·.finishedSnap.get.infoTree?) |>.filterMap id |>.toPArray'
|
||||
return {
|
||||
commandState := { snap.data.finishedSnap.get.cmdState with messages, infoState.trees := trees }
|
||||
parserState := snap.data.parserState
|
||||
cmdPos := snap.data.parserState.pos
|
||||
inputCtx, initialSnap, commands
|
||||
commands := commands.map (·.stx)
|
||||
inputCtx, initialSnap
|
||||
}
|
||||
|
||||
def IO.processCommands (inputCtx : Parser.InputContext) (parserState : Parser.ModuleParserState)
|
||||
@@ -151,7 +153,7 @@ def runFrontend
|
||||
snaps.runAndReport opts jsonOutput
|
||||
|
||||
if let some ileanFileName := ileanFileName? then
|
||||
let trees := snaps.getAll.concatMap (match ·.infoTree? with | some t => #[t] | _ => #[])
|
||||
let trees := snaps.getAll.flatMap (match ·.infoTree? with | some t => #[t] | _ => #[])
|
||||
let references := Lean.Server.findModuleRefs inputCtx.fileMap trees (localVars := false)
|
||||
let ilean := { module := mainModuleName, references := ← references.toLspModuleRefs : Lean.Server.Ilean }
|
||||
IO.FS.writeFile ileanFileName $ Json.compress $ toJson ilean
|
||||
|
||||
@@ -90,6 +90,7 @@ private def elabLetRecDeclValues (view : LetRecView) : TermElabM (Array Expr) :=
|
||||
for i in [0:view.binderIds.size] do
|
||||
addLocalVarInfo view.binderIds[i]! xs[i]!
|
||||
withDeclName view.declName do
|
||||
withInfoContext' view.valStx (mkInfo := mkTermInfo `MutualDef.body view.valStx) do
|
||||
let value ← elabTermEnsuringType view.valStx type
|
||||
mkLambdaFVars xs value
|
||||
|
||||
|
||||
@@ -410,11 +410,15 @@ private def elabFunValues (headers : Array DefViewElabHeader) (vars : Array Expr
|
||||
-- skip auto-bound prefix in `xs`
|
||||
addLocalVarInfo header.binderIds[i] xs[header.numParams - header.binderIds.size + i]!
|
||||
let val ← withReader ({ · with tacSnap? := header.tacSnap? }) do
|
||||
-- synthesize mvars here to force the top-level tactic block (if any) to run
|
||||
elabTermEnsuringType valStx type <* synthesizeSyntheticMVarsNoPostponing
|
||||
-- NOTE: without this `instantiatedMVars`, `mkLambdaFVars` may leave around a redex that
|
||||
-- leads to more section variables being included than necessary
|
||||
let val ← instantiateMVarsProfiling val
|
||||
-- Store instantiated body in info tree for the benefit of the unused variables linter
|
||||
-- and other metaprograms that may want to inspect it without paying for the instantiation
|
||||
-- again
|
||||
withInfoContext' valStx (mkInfo := mkTermInfo `MutualDef.body valStx) do
|
||||
-- synthesize mvars here to force the top-level tactic block (if any) to run
|
||||
let val ← elabTermEnsuringType valStx type <* synthesizeSyntheticMVarsNoPostponing
|
||||
-- NOTE: without this `instantiatedMVars`, `mkLambdaFVars` may leave around a redex that
|
||||
-- leads to more section variables being included than necessary
|
||||
instantiateMVarsProfiling val
|
||||
let val ← mkLambdaFVars xs val
|
||||
if linter.unusedSectionVars.get (← getOptions) && !header.type.hasSorry && !val.hasSorry then
|
||||
let unusedVars ← vars.filterMapM fun var => do
|
||||
@@ -883,6 +887,7 @@ def getKindForLetRecs (mainHeaders : Array DefViewElabHeader) : DefKind :=
|
||||
else DefKind.«def»
|
||||
|
||||
def getModifiersForLetRecs (mainHeaders : Array DefViewElabHeader) : Modifiers := {
|
||||
stx := ⟨mkNullNode #[]⟩ -- ignore when computing declaration range
|
||||
isNoncomputable := mainHeaders.any fun h => h.modifiers.isNoncomputable
|
||||
recKind := if mainHeaders.any fun h => h.modifiers.isPartial then RecKind.partial else RecKind.default
|
||||
isUnsafe := mainHeaders.any fun h => h.modifiers.isUnsafe
|
||||
@@ -993,7 +998,7 @@ where
|
||||
for view in views, header in headers do
|
||||
-- NOTE: this should be the full `ref`, and thus needs to be done after any snapshotting
|
||||
-- that depends only on a part of the ref
|
||||
addDeclarationRanges header.declName view.ref
|
||||
addDeclarationRanges header.declName view.modifiers.stx view.ref
|
||||
|
||||
|
||||
processDeriving (headers : Array DefViewElabHeader) := do
|
||||
@@ -1017,7 +1022,7 @@ def elabMutualDef (ds : Array Syntax) : CommandElabM Unit := do
|
||||
let mut reusedAllHeaders := true
|
||||
for h : i in [0:ds.size], headerPromise in headerPromises do
|
||||
let d := ds[i]
|
||||
let modifiers ← elabModifiers d[0]
|
||||
let modifiers ← elabModifiers ⟨d[0]⟩
|
||||
if ds.size > 1 && modifiers.isNonrec then
|
||||
throwErrorAt d "invalid use of 'nonrec' modifier in 'mutual' block"
|
||||
let mut view ← mkDefView modifiers d[1]
|
||||
|
||||
@@ -221,7 +221,7 @@ def addAndCompilePartialRec (preDefs : Array PreDefinition) : TermElabM Unit :=
|
||||
else
|
||||
none
|
||||
| _ => none
|
||||
modifiers := {} }
|
||||
modifiers := default }
|
||||
|
||||
private def containsRecFn (recFnNames : Array Name) (e : Expr) : Bool :=
|
||||
(e.find? fun e => e.isConst && recFnNames.contains e.constName!).isSome
|
||||
|
||||
@@ -212,21 +212,21 @@ def mkBRecOnMotive (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
|
||||
/--
|
||||
Calculates the `.brecOn` functional argument corresponding to one structural recursive function.
|
||||
The `value` is the function with (only) the fixed parameters moved into the context,
|
||||
The `type` is the expected type of the argument.
|
||||
The `FType` is the expected type of the argument.
|
||||
The `recArgInfos` is used to transform the body of the function to replace recursive calls with
|
||||
uses of the `below` induction hypothesis.
|
||||
-/
|
||||
def mkBRecOnF (recArgInfos : Array RecArgInfo) (positions : Positions)
|
||||
(recArgInfo : RecArgInfo) (value : Expr) (FType : Expr) : M Expr := do
|
||||
lambdaTelescope value fun xs value => do
|
||||
let (indexMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor xs
|
||||
let FType ← instantiateForall FType indexMajorArgs
|
||||
let (indicesMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor xs
|
||||
let FType ← instantiateForall FType indicesMajorArgs
|
||||
forallBoundedTelescope FType (some 1) fun below _ => do
|
||||
-- TODO: `below` user name is `f`, and it will make a global `f` to be pretty printed as `_root_.f` in error messages.
|
||||
-- We should add an option to `forallBoundedTelescope` to ensure fresh names are used.
|
||||
let below := below[0]!
|
||||
let valueNew ← replaceRecApps recArgInfos positions below value
|
||||
mkLambdaFVars (indexMajorArgs ++ #[below] ++ otherArgs) valueNew
|
||||
let valueNew ← replaceRecApps recArgInfos positions below value
|
||||
mkLambdaFVars (indicesMajorArgs ++ #[below] ++ otherArgs) valueNew
|
||||
|
||||
/--
|
||||
Given the `motives`, figures out whether to use `.brecOn` or `.binductionOn`, pass
|
||||
@@ -264,7 +264,7 @@ def inferBRecOnFTypes (recArgInfos : Array RecArgInfo) (positions : Positions)
|
||||
(brecOnConst : Nat → Expr) : MetaM (Array Expr) := do
|
||||
let numTypeFormers := positions.size
|
||||
let recArgInfo := recArgInfos[0]! -- pick an arbitrary one
|
||||
let brecOn := brecOnConst 0
|
||||
let brecOn := brecOnConst recArgInfo.indIdx
|
||||
check brecOn
|
||||
let brecOnType ← inferType brecOn
|
||||
-- Skip the indices and major argument
|
||||
|
||||
@@ -77,7 +77,7 @@ def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) :
|
||||
if !indIndices.all Expr.isFVar then
|
||||
throwError "its type {indInfo.name} is an inductive family and indices are not variables{indentExpr xType}"
|
||||
else if !indIndices.allDiff then
|
||||
throwError " its type {indInfo.name} is an inductive family and indices are not pairwise distinct{indentExpr xType}"
|
||||
throwError "its type {indInfo.name} is an inductive family and indices are not pairwise distinct{indentExpr xType}"
|
||||
else
|
||||
let indexMinPos := getIndexMinPos xs indIndices
|
||||
let numFixed := if indexMinPos < numFixed then indexMinPos else numFixed
|
||||
@@ -226,7 +226,7 @@ def allCombinations (xss : Array (Array α)) : Option (Array (Array α)) :=
|
||||
else
|
||||
let rec go i acc : Array (Array α):=
|
||||
if h : i < xss.size then
|
||||
xss[i].concatMap fun x => go (i + 1) (acc.push x)
|
||||
xss[i].flatMap fun x => go (i + 1) (acc.push x)
|
||||
else
|
||||
#[acc]
|
||||
some (go 0 #[])
|
||||
|
||||
@@ -107,9 +107,9 @@ private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr
|
||||
check valueNew
|
||||
return #[{ preDef with value := valueNew }]
|
||||
|
||||
-- Sort the (indices of the) definitions by their position in indInfo.all
|
||||
-- Groups the (indices of the) definitions by their position in indInfo.all
|
||||
let positions : Positions := .groupAndSort (·.indIdx) recArgInfos (Array.range indInfo.numTypeFormers)
|
||||
trace[Elab.definition.structural] "positions: {positions}"
|
||||
trace[Elab.definition.structural] "assignments of type formers of {indInfo.name} to functions: {positions}"
|
||||
|
||||
-- Construct the common `.brecOn` arguments
|
||||
let motives ← (Array.zip recArgInfos values).mapM fun (r, v) => mkBRecOnMotive r v
|
||||
@@ -117,7 +117,7 @@ private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr
|
||||
let brecOnConst ← mkBRecOnConst recArgInfos positions motives
|
||||
let FTypes ← inferBRecOnFTypes recArgInfos positions brecOnConst
|
||||
trace[Elab.definition.structural] "FTypes: {FTypes}"
|
||||
let FArgs ← (recArgInfos.zip (values.zip FTypes)).mapM fun (r, (v, t)) =>
|
||||
let FArgs ← (recArgInfos.zip (values.zip FTypes)).mapM fun (r, (v, t)) =>
|
||||
mkBRecOnF recArgInfos positions r v t
|
||||
trace[Elab.definition.structural] "FArgs: {FArgs}"
|
||||
-- Assemble the individual `.brecOn` applications
|
||||
|
||||
@@ -15,7 +15,7 @@ partial def addSmartUnfoldingDefAux (preDef : PreDefinition) (recArgPos : Nat) :
|
||||
return { preDef with
|
||||
declName := mkSmartUnfoldingNameFor preDef.declName
|
||||
value := (← visit preDef.value)
|
||||
modifiers := {}
|
||||
modifiers := default
|
||||
}
|
||||
where
|
||||
/--
|
||||
|
||||
@@ -95,7 +95,7 @@ private def expandCtor (structStx : Syntax) (structModifiers : Modifiers) (struc
|
||||
let declName := structDeclName ++ defaultCtorName
|
||||
let ref := structStx[1].mkSynthetic
|
||||
addAuxDeclarationRanges declName ref ref
|
||||
pure { ref, modifiers := {}, name := defaultCtorName, declName }
|
||||
pure { ref, modifiers := default, name := defaultCtorName, declName }
|
||||
if structStx[5].isNone then
|
||||
useDefault
|
||||
else
|
||||
@@ -912,7 +912,7 @@ def elabStructure (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit :=
|
||||
let scopeLevelNames ← Term.getLevelNames
|
||||
let ⟨name, declName, allUserLevelNames⟩ ← Elab.expandDeclId (← getCurrNamespace) scopeLevelNames declId modifiers
|
||||
Term.withAutoBoundImplicitForbiddenPred (fun n => name == n) do
|
||||
addDeclarationRanges declName stx
|
||||
addDeclarationRanges declName modifiers.stx stx
|
||||
Term.withDeclName declName do
|
||||
let ctor ← expandCtor stx modifiers declName
|
||||
let fields ← expandFields stx modifiers declName
|
||||
|
||||
@@ -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.val == 0 }) do process arg
|
||||
let args ← args.mapIdxM fun i arg => withReader (fun ctx => { ctx with first := ctx.first && i == 0 }) do process arg
|
||||
mkParserSeq args
|
||||
|
||||
ensureNoPrec (stx : Syntax) :=
|
||||
|
||||
@@ -43,3 +43,4 @@ import Lean.Elab.Tactic.Rewrites
|
||||
import Lean.Elab.Tactic.DiscrTreeKey
|
||||
import Lean.Elab.Tactic.BVDecide
|
||||
import Lean.Elab.Tactic.BoolToPropSimps
|
||||
import Lean.Elab.Tactic.Classical
|
||||
|
||||
@@ -65,202 +65,218 @@ def getNatOrBvValue? (ty : Expr) (expr : Expr) : M (Option Nat) := do
|
||||
| _ => return none
|
||||
|
||||
/--
|
||||
Reify an `Expr` that's a `BitVec`.
|
||||
Construct an uninterpreted `BitVec` atom from `x`.
|
||||
-/
|
||||
def bitVecAtom (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
let t ← instantiateMVars (← whnfR (← inferType x))
|
||||
let_expr BitVec widthExpr := t | return none
|
||||
let some width ← getNatValue? widthExpr | return none
|
||||
let atom ← mkAtom x width
|
||||
return some atom
|
||||
|
||||
/--
|
||||
Reify an `Expr` that's a constant-width `BitVec`.
|
||||
Unless this function is called on something that is not a constant-width `BitVec` it is always
|
||||
going to return `some`.
|
||||
-/
|
||||
partial def of (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
match_expr x with
|
||||
| BitVec.ofNat _ _ => goBvLit x
|
||||
| HAnd.hAnd _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .and ``Std.Tactic.BVDecide.Reflect.BitVec.and_congr
|
||||
| HOr.hOr _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .or ``Std.Tactic.BVDecide.Reflect.BitVec.or_congr
|
||||
| HXor.hXor _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .xor ``Std.Tactic.BVDecide.Reflect.BitVec.xor_congr
|
||||
| HAdd.hAdd _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .add ``Std.Tactic.BVDecide.Reflect.BitVec.add_congr
|
||||
| HMul.hMul _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .mul ``Std.Tactic.BVDecide.Reflect.BitVec.mul_congr
|
||||
| HDiv.hDiv _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .udiv ``Std.Tactic.BVDecide.Reflect.BitVec.udiv_congr
|
||||
| HMod.hMod _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .umod ``Std.Tactic.BVDecide.Reflect.BitVec.umod_congr
|
||||
| Complement.complement _ _ innerExpr =>
|
||||
unaryReflection innerExpr .not ``Std.Tactic.BVDecide.Reflect.BitVec.not_congr
|
||||
| HShiftLeft.hShiftLeft _ β _ _ innerExpr distanceExpr =>
|
||||
let distance? ← getNatOrBvValue? β distanceExpr
|
||||
if distance?.isSome then
|
||||
shiftConstReflection
|
||||
β
|
||||
distanceExpr
|
||||
goOrAtom x
|
||||
where
|
||||
/--
|
||||
Reify `x`, returns `none` if the reification procedure failed.
|
||||
-/
|
||||
go (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
match_expr x with
|
||||
| BitVec.ofNat _ _ => goBvLit x
|
||||
| HAnd.hAnd _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .and ``Std.Tactic.BVDecide.Reflect.BitVec.and_congr
|
||||
| HOr.hOr _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .or ``Std.Tactic.BVDecide.Reflect.BitVec.or_congr
|
||||
| HXor.hXor _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .xor ``Std.Tactic.BVDecide.Reflect.BitVec.xor_congr
|
||||
| HAdd.hAdd _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .add ``Std.Tactic.BVDecide.Reflect.BitVec.add_congr
|
||||
| HMul.hMul _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .mul ``Std.Tactic.BVDecide.Reflect.BitVec.mul_congr
|
||||
| HDiv.hDiv _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .udiv ``Std.Tactic.BVDecide.Reflect.BitVec.udiv_congr
|
||||
| HMod.hMod _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .umod ``Std.Tactic.BVDecide.Reflect.BitVec.umod_congr
|
||||
| Complement.complement _ _ innerExpr =>
|
||||
unaryReflection innerExpr .not ``Std.Tactic.BVDecide.Reflect.BitVec.not_congr
|
||||
| HShiftLeft.hShiftLeft _ β _ _ innerExpr distanceExpr =>
|
||||
let distance? ← getNatOrBvValue? β distanceExpr
|
||||
if distance?.isSome then
|
||||
shiftConstReflection
|
||||
β
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.shiftLeftConst
|
||||
``BVUnOp.shiftLeftConst
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.shiftLeftNat_congr
|
||||
else
|
||||
shiftReflection
|
||||
β
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.shiftLeft
|
||||
``BVExpr.shiftLeft
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.shiftLeft_congr
|
||||
| HShiftRight.hShiftRight _ β _ _ innerExpr distanceExpr =>
|
||||
let distance? ← getNatOrBvValue? β distanceExpr
|
||||
if distance?.isSome then
|
||||
shiftConstReflection
|
||||
β
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.shiftRightConst
|
||||
``BVUnOp.shiftRightConst
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.shiftRightNat_congr
|
||||
else
|
||||
shiftReflection
|
||||
β
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.shiftRight
|
||||
``BVExpr.shiftRight
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.shiftRight_congr
|
||||
| BitVec.sshiftRight _ innerExpr distanceExpr =>
|
||||
let some distance ← getNatValue? distanceExpr | return none
|
||||
shiftConstLikeReflection
|
||||
distance
|
||||
innerExpr
|
||||
.shiftLeftConst
|
||||
``BVUnOp.shiftLeftConst
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.shiftLeftNat_congr
|
||||
else
|
||||
shiftReflection
|
||||
β
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.shiftLeft
|
||||
``BVExpr.shiftLeft
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.shiftLeft_congr
|
||||
| HShiftRight.hShiftRight _ β _ _ innerExpr distanceExpr =>
|
||||
let distance? ← getNatOrBvValue? β distanceExpr
|
||||
if distance?.isSome then
|
||||
shiftConstReflection
|
||||
β
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.shiftRightConst
|
||||
``BVUnOp.shiftRightConst
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.shiftRightNat_congr
|
||||
else
|
||||
shiftReflection
|
||||
β
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.shiftRight
|
||||
``BVExpr.shiftRight
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.shiftRight_congr
|
||||
| BitVec.sshiftRight _ innerExpr distanceExpr =>
|
||||
let some distance ← getNatValue? distanceExpr | return ← ofAtom x
|
||||
shiftConstLikeReflection
|
||||
distance
|
||||
innerExpr
|
||||
.arithShiftRightConst
|
||||
``BVUnOp.arithShiftRightConst
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.arithShiftRight_congr
|
||||
| BitVec.zeroExtend _ newWidthExpr innerExpr =>
|
||||
let some newWidth ← getNatValue? newWidthExpr | return ← ofAtom x
|
||||
let some inner ← ofOrAtom innerExpr | return none
|
||||
let bvExpr := .zeroExtend newWidth inner.bvExpr
|
||||
let expr :=
|
||||
mkApp3
|
||||
(mkConst ``BVExpr.zeroExtend)
|
||||
.arithShiftRightConst
|
||||
``BVUnOp.arithShiftRightConst
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.arithShiftRight_congr
|
||||
| BitVec.zeroExtend _ newWidthExpr innerExpr =>
|
||||
let some newWidth ← getNatValue? newWidthExpr | return none
|
||||
let some inner ← goOrAtom innerExpr | return none
|
||||
let bvExpr := .zeroExtend newWidth inner.bvExpr
|
||||
let expr :=
|
||||
mkApp3
|
||||
(mkConst ``BVExpr.zeroExtend)
|
||||
(toExpr inner.width)
|
||||
newWidthExpr
|
||||
inner.expr
|
||||
let proof := do
|
||||
let innerEval ← mkEvalExpr inner.width inner.expr
|
||||
let innerProof ← inner.evalsAtAtoms
|
||||
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.zeroExtend_congr)
|
||||
newWidthExpr
|
||||
(toExpr inner.width)
|
||||
innerExpr
|
||||
innerEval
|
||||
innerProof
|
||||
return some ⟨newWidth, bvExpr, proof, expr⟩
|
||||
| BitVec.signExtend _ newWidthExpr innerExpr =>
|
||||
let some newWidth ← getNatValue? newWidthExpr | return none
|
||||
let some inner ← goOrAtom innerExpr | return none
|
||||
let bvExpr := .signExtend newWidth inner.bvExpr
|
||||
let expr :=
|
||||
mkApp3
|
||||
(mkConst ``BVExpr.signExtend)
|
||||
(toExpr inner.width)
|
||||
newWidthExpr
|
||||
inner.expr
|
||||
let proof := do
|
||||
let innerEval ← mkEvalExpr inner.width inner.expr
|
||||
let innerProof ← inner.evalsAtAtoms
|
||||
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.signExtend_congr)
|
||||
newWidthExpr
|
||||
(toExpr inner.width)
|
||||
innerExpr
|
||||
innerEval
|
||||
innerProof
|
||||
return some ⟨newWidth, bvExpr, proof, expr⟩
|
||||
| HAppend.hAppend _ _ _ _ lhsExpr rhsExpr =>
|
||||
let some lhs ← goOrAtom lhsExpr | return none
|
||||
let some rhs ← goOrAtom rhsExpr | return none
|
||||
let bvExpr := .append lhs.bvExpr rhs.bvExpr
|
||||
let expr := mkApp4 (mkConst ``BVExpr.append)
|
||||
(toExpr lhs.width)
|
||||
(toExpr rhs.width)
|
||||
lhs.expr rhs.expr
|
||||
let proof := do
|
||||
let lhsEval ← mkEvalExpr lhs.width lhs.expr
|
||||
let lhsProof ← lhs.evalsAtAtoms
|
||||
let rhsProof ← rhs.evalsAtAtoms
|
||||
let rhsEval ← mkEvalExpr rhs.width rhs.expr
|
||||
return mkApp8 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.append_congr)
|
||||
(toExpr lhs.width) (toExpr rhs.width)
|
||||
lhsExpr lhsEval
|
||||
rhsExpr rhsEval
|
||||
lhsProof rhsProof
|
||||
return some ⟨lhs.width + rhs.width, bvExpr, proof, expr⟩
|
||||
| BitVec.replicate _ nExpr innerExpr =>
|
||||
let some inner ← goOrAtom innerExpr | return none
|
||||
let some n ← getNatValue? nExpr | return none
|
||||
let bvExpr := .replicate n inner.bvExpr
|
||||
let expr := mkApp3 (mkConst ``BVExpr.replicate)
|
||||
(toExpr inner.width)
|
||||
newWidthExpr
|
||||
inner.expr
|
||||
let proof := do
|
||||
let innerEval ← mkEvalExpr inner.width inner.expr
|
||||
let innerProof ← inner.evalsAtAtoms
|
||||
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.zeroExtend_congr)
|
||||
newWidthExpr
|
||||
(toExpr inner.width)
|
||||
innerExpr
|
||||
innerEval
|
||||
innerProof
|
||||
return some ⟨newWidth, bvExpr, proof, expr⟩
|
||||
| BitVec.signExtend _ newWidthExpr innerExpr =>
|
||||
let some newWidth ← getNatValue? newWidthExpr | return ← ofAtom x
|
||||
let some inner ← ofOrAtom innerExpr | return none
|
||||
let bvExpr := .signExtend newWidth inner.bvExpr
|
||||
let expr :=
|
||||
mkApp3
|
||||
(mkConst ``BVExpr.signExtend)
|
||||
(toExpr inner.width)
|
||||
newWidthExpr
|
||||
inner.expr
|
||||
let proof := do
|
||||
let innerEval ← mkEvalExpr inner.width inner.expr
|
||||
let innerProof ← inner.evalsAtAtoms
|
||||
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.signExtend_congr)
|
||||
newWidthExpr
|
||||
(toExpr inner.width)
|
||||
innerExpr
|
||||
innerEval
|
||||
innerProof
|
||||
return some ⟨newWidth, bvExpr, proof, expr⟩
|
||||
| HAppend.hAppend _ _ _ _ lhsExpr rhsExpr =>
|
||||
let some lhs ← ofOrAtom lhsExpr | return none
|
||||
let some rhs ← ofOrAtom rhsExpr | return none
|
||||
let bvExpr := .append lhs.bvExpr rhs.bvExpr
|
||||
let expr := mkApp4 (mkConst ``BVExpr.append)
|
||||
(toExpr lhs.width)
|
||||
(toExpr rhs.width)
|
||||
lhs.expr rhs.expr
|
||||
let proof := do
|
||||
let lhsEval ← mkEvalExpr lhs.width lhs.expr
|
||||
let lhsProof ← lhs.evalsAtAtoms
|
||||
let rhsProof ← rhs.evalsAtAtoms
|
||||
let rhsEval ← mkEvalExpr rhs.width rhs.expr
|
||||
return mkApp8 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.append_congr)
|
||||
(toExpr lhs.width) (toExpr rhs.width)
|
||||
lhsExpr lhsEval
|
||||
rhsExpr rhsEval
|
||||
lhsProof rhsProof
|
||||
return some ⟨lhs.width + rhs.width, bvExpr, proof, expr⟩
|
||||
| BitVec.replicate _ nExpr innerExpr =>
|
||||
let some inner ← ofOrAtom innerExpr | return none
|
||||
let some n ← getNatValue? nExpr | return ← ofAtom x
|
||||
let bvExpr := .replicate n inner.bvExpr
|
||||
let expr := mkApp3 (mkConst ``BVExpr.replicate)
|
||||
(toExpr inner.width)
|
||||
(toExpr n)
|
||||
inner.expr
|
||||
let proof := do
|
||||
let innerEval ← mkEvalExpr inner.width inner.expr
|
||||
let innerProof ← inner.evalsAtAtoms
|
||||
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.replicate_congr)
|
||||
(toExpr n)
|
||||
inner.expr
|
||||
let proof := do
|
||||
let innerEval ← mkEvalExpr inner.width inner.expr
|
||||
let innerProof ← inner.evalsAtAtoms
|
||||
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.replicate_congr)
|
||||
(toExpr n)
|
||||
(toExpr inner.width)
|
||||
innerExpr
|
||||
innerEval
|
||||
innerProof
|
||||
return some ⟨inner.width * n, bvExpr, proof, expr⟩
|
||||
| BitVec.extractLsb' _ startExpr lenExpr innerExpr =>
|
||||
let some start ← getNatValue? startExpr | return none
|
||||
let some len ← getNatValue? lenExpr | return none
|
||||
let some inner ← goOrAtom innerExpr | return none
|
||||
let bvExpr := .extract start len inner.bvExpr
|
||||
let expr := mkApp4 (mkConst ``BVExpr.extract)
|
||||
(toExpr inner.width)
|
||||
innerExpr
|
||||
innerEval
|
||||
innerProof
|
||||
return some ⟨inner.width * n, bvExpr, proof, expr⟩
|
||||
| BitVec.extractLsb' _ startExpr lenExpr innerExpr =>
|
||||
let some start ← getNatValue? startExpr | return ← ofAtom x
|
||||
let some len ← getNatValue? lenExpr | return ← ofAtom x
|
||||
let some inner ← ofOrAtom innerExpr | return none
|
||||
let bvExpr := .extract start len inner.bvExpr
|
||||
let expr := mkApp4 (mkConst ``BVExpr.extract)
|
||||
(toExpr inner.width)
|
||||
startExpr
|
||||
lenExpr
|
||||
inner.expr
|
||||
let proof := do
|
||||
let innerEval ← mkEvalExpr inner.width inner.expr
|
||||
let innerProof ← inner.evalsAtAtoms
|
||||
return mkApp6 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.extract_congr)
|
||||
startExpr
|
||||
lenExpr
|
||||
(toExpr inner.width)
|
||||
inner.expr
|
||||
let proof := do
|
||||
let innerEval ← mkEvalExpr inner.width inner.expr
|
||||
let innerProof ← inner.evalsAtAtoms
|
||||
return mkApp6 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.extract_congr)
|
||||
startExpr
|
||||
lenExpr
|
||||
(toExpr inner.width)
|
||||
innerExpr
|
||||
innerEval
|
||||
innerProof
|
||||
return some ⟨len, bvExpr, proof, expr⟩
|
||||
| BitVec.rotateLeft _ innerExpr distanceExpr =>
|
||||
rotateReflection
|
||||
distanceExpr
|
||||
innerExpr
|
||||
innerEval
|
||||
innerProof
|
||||
return some ⟨len, bvExpr, proof, expr⟩
|
||||
| BitVec.rotateLeft _ innerExpr distanceExpr =>
|
||||
rotateReflection
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.rotateLeft
|
||||
``BVUnOp.rotateLeft
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.rotateLeft_congr
|
||||
| BitVec.rotateRight _ innerExpr distanceExpr =>
|
||||
rotateReflection
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.rotateRight
|
||||
``BVUnOp.rotateRight
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.rotateRight_congr
|
||||
| _ => ofAtom x
|
||||
where
|
||||
ofAtom (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
let t ← instantiateMVars (← whnfR (← inferType x))
|
||||
let_expr BitVec widthExpr := t | return none
|
||||
let some width ← getNatValue? widthExpr | return none
|
||||
let atom ← mkAtom x width
|
||||
return some atom
|
||||
.rotateLeft
|
||||
``BVUnOp.rotateLeft
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.rotateLeft_congr
|
||||
| BitVec.rotateRight _ innerExpr distanceExpr =>
|
||||
rotateReflection
|
||||
distanceExpr
|
||||
innerExpr
|
||||
.rotateRight
|
||||
``BVUnOp.rotateRight
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.rotateRight_congr
|
||||
| _ => return none
|
||||
|
||||
ofOrAtom (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
let res ← of x
|
||||
/--
|
||||
Reify `x` or abstract it as an atom.
|
||||
Unless this function is called on something that is not a fixed-width `BitVec` it is always going
|
||||
to return `some`.
|
||||
-/
|
||||
goOrAtom (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
let res ← go x
|
||||
match res with
|
||||
| some exp => return some exp
|
||||
| none => ofAtom x
|
||||
| none => bitVecAtom x
|
||||
|
||||
shiftConstLikeReflection (distance : Nat) (innerExpr : Expr) (shiftOp : Nat → BVUnOp)
|
||||
(shiftOpName : Name) (congrThm : Name) :
|
||||
M (Option ReifiedBVExpr) := do
|
||||
let some inner ← ofOrAtom innerExpr | return none
|
||||
let some inner ← goOrAtom innerExpr | return none
|
||||
let bvExpr : BVExpr inner.width := .un (shiftOp distance) inner.bvExpr
|
||||
let expr :=
|
||||
mkApp3
|
||||
@@ -278,24 +294,22 @@ where
|
||||
rotateReflection (distanceExpr : Expr) (innerExpr : Expr) (rotateOp : Nat → BVUnOp)
|
||||
(rotateOpName : Name) (congrThm : Name) :
|
||||
M (Option ReifiedBVExpr) := do
|
||||
-- Either the shift values are constant or we abstract the entire term as atoms
|
||||
let some distance ← getNatValue? distanceExpr | return ← ofAtom x
|
||||
let some distance ← getNatValue? distanceExpr | return none
|
||||
shiftConstLikeReflection distance innerExpr rotateOp rotateOpName congrThm
|
||||
|
||||
shiftConstReflection (β : Expr) (distanceExpr : Expr) (innerExpr : Expr) (shiftOp : Nat → BVUnOp)
|
||||
(shiftOpName : Name) (congrThm : Name) :
|
||||
M (Option ReifiedBVExpr) := do
|
||||
-- Either the shift values are constant or we abstract the entire term as atoms
|
||||
let some distance ← getNatOrBvValue? β distanceExpr | return ← ofAtom x
|
||||
let some distance ← getNatOrBvValue? β distanceExpr | return none
|
||||
shiftConstLikeReflection distance innerExpr shiftOp shiftOpName congrThm
|
||||
|
||||
shiftReflection (β : Expr) (distanceExpr : Expr) (innerExpr : Expr)
|
||||
(shiftOp : {m n : Nat} → BVExpr m → BVExpr n → BVExpr m) (shiftOpName : Name)
|
||||
(congrThm : Name) :
|
||||
M (Option ReifiedBVExpr) := do
|
||||
let_expr BitVec _ ← β | return ← ofAtom x
|
||||
let some inner ← of innerExpr | return none
|
||||
let some distance ← of distanceExpr | return none
|
||||
let_expr BitVec _ ← β | return none
|
||||
let some inner ← goOrAtom innerExpr | return none
|
||||
let some distance ← goOrAtom distanceExpr | return none
|
||||
let bvExpr : BVExpr inner.width := shiftOp inner.bvExpr distance.bvExpr
|
||||
let expr :=
|
||||
mkApp4
|
||||
@@ -314,8 +328,8 @@ where
|
||||
|
||||
binaryReflection (lhsExpr rhsExpr : Expr) (op : BVBinOp) (congrThm : Name) :
|
||||
M (Option ReifiedBVExpr) := do
|
||||
let some lhs ← ofOrAtom lhsExpr | return none
|
||||
let some rhs ← ofOrAtom rhsExpr | return none
|
||||
let some lhs ← goOrAtom lhsExpr | return none
|
||||
let some rhs ← goOrAtom rhsExpr | return none
|
||||
if h : rhs.width = lhs.width then
|
||||
let bvExpr : BVExpr lhs.width := .bin lhs.bvExpr op (h ▸ rhs.bvExpr)
|
||||
let expr := mkApp4 (mkConst ``BVExpr.bin) (toExpr lhs.width) lhs.expr (toExpr op) rhs.expr
|
||||
@@ -335,7 +349,7 @@ where
|
||||
|
||||
unaryReflection (innerExpr : Expr) (op : BVUnOp) (congrThm : Name) :
|
||||
M (Option ReifiedBVExpr) := do
|
||||
let some inner ← ofOrAtom innerExpr | return none
|
||||
let some inner ← goOrAtom innerExpr | return none
|
||||
let bvExpr := .un op inner.bvExpr
|
||||
let expr := mkApp3 (mkConst ``BVExpr.un) (toExpr inner.width) (toExpr op) inner.expr
|
||||
let proof := unaryCongrProof inner innerExpr (mkConst congrThm)
|
||||
@@ -347,7 +361,7 @@ where
|
||||
return mkApp4 congrProof (toExpr inner.width) innerExpr innerEval innerProof
|
||||
|
||||
goBvLit (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
let some ⟨width, bvVal⟩ ← getBitVecValue? x | return ← ofAtom x
|
||||
let some ⟨width, bvVal⟩ ← getBitVecValue? x | return ← bitVecAtom x
|
||||
let bvExpr : BVExpr width := .const bvVal
|
||||
let expr := mkApp2 (mkConst ``BVExpr.const) (toExpr width) (toExpr bvVal)
|
||||
let proof := do
|
||||
|
||||
@@ -44,40 +44,75 @@ def mkTrans (x y z : Expr) (hxy hyz : Expr) : Expr :=
|
||||
def mkEvalExpr (expr : Expr) : M Expr := do
|
||||
return mkApp2 (mkConst ``BVLogicalExpr.eval) (← M.atomsAssignment) expr
|
||||
|
||||
/--
|
||||
Construct a `ReifiedBVLogical` from `ReifiedBVPred` by wrapping it as an atom.
|
||||
-/
|
||||
def ofPred (bvPred : ReifiedBVPred) : M (Option ReifiedBVLogical) := do
|
||||
let boolExpr := .literal bvPred.bvPred
|
||||
let expr := mkApp2 (mkConst ``BoolExpr.literal) (mkConst ``BVPred) bvPred.expr
|
||||
let proof := bvPred.evalsAtAtoms
|
||||
return some ⟨boolExpr, proof, expr⟩
|
||||
|
||||
/--
|
||||
Construct an uninterrpeted `Bool` atom from `t`.
|
||||
-/
|
||||
def boolAtom (t : Expr) : M (Option ReifiedBVLogical) := do
|
||||
let some pred ← ReifiedBVPred.boolAtom t | return none
|
||||
ofPred pred
|
||||
|
||||
/--
|
||||
Reify an `Expr` that is a boolean expression containing predicates about `BitVec` as atoms.
|
||||
Unless this function is called on something that is not a `Bool` it is always going to return `some`.
|
||||
-/
|
||||
partial def of (t : Expr) : M (Option ReifiedBVLogical) := do
|
||||
match_expr t with
|
||||
| Bool.true =>
|
||||
let boolExpr := .const true
|
||||
let expr := mkApp2 (mkConst ``BoolExpr.const) (mkConst ``BVPred) (toExpr Bool.true)
|
||||
let proof := return mkRefl (mkConst ``Bool.true)
|
||||
return some ⟨boolExpr, proof, expr⟩
|
||||
| Bool.false =>
|
||||
let boolExpr := .const false
|
||||
let expr := mkApp2 (mkConst ``BoolExpr.const) (mkConst ``BVPred) (toExpr Bool.false)
|
||||
let proof := return mkRefl (mkConst ``Bool.false)
|
||||
return some ⟨boolExpr, proof, expr⟩
|
||||
| Bool.not subExpr =>
|
||||
let some sub ← of subExpr | return none
|
||||
let boolExpr := .not sub.bvExpr
|
||||
let expr := mkApp2 (mkConst ``BoolExpr.not) (mkConst ``BVPred) sub.expr
|
||||
let proof := do
|
||||
let subEvalExpr ← mkEvalExpr sub.expr
|
||||
let subProof ← sub.evalsAtAtoms
|
||||
return mkApp3 (mkConst ``Std.Tactic.BVDecide.Reflect.Bool.not_congr) subExpr subEvalExpr subProof
|
||||
return some ⟨boolExpr, proof, expr⟩
|
||||
| Bool.and lhsExpr rhsExpr => gateReflection lhsExpr rhsExpr .and ``Std.Tactic.BVDecide.Reflect.Bool.and_congr
|
||||
| Bool.xor lhsExpr rhsExpr => gateReflection lhsExpr rhsExpr .xor ``Std.Tactic.BVDecide.Reflect.Bool.xor_congr
|
||||
| BEq.beq α _ lhsExpr rhsExpr =>
|
||||
match_expr α with
|
||||
| Bool => gateReflection lhsExpr rhsExpr .beq ``Std.Tactic.BVDecide.Reflect.Bool.beq_congr
|
||||
| BitVec _ => goPred t
|
||||
| _ => return none
|
||||
| _ => goPred t
|
||||
goOrAtom t
|
||||
where
|
||||
/--
|
||||
Reify `t`, returns `none` if the reification procedure failed.
|
||||
-/
|
||||
go (t : Expr) : M (Option ReifiedBVLogical) := do
|
||||
match_expr t with
|
||||
| Bool.true =>
|
||||
let boolExpr := .const true
|
||||
let expr := mkApp2 (mkConst ``BoolExpr.const) (mkConst ``BVPred) (toExpr Bool.true)
|
||||
let proof := pure <| mkRefl (mkConst ``Bool.true)
|
||||
return some ⟨boolExpr, proof, expr⟩
|
||||
| Bool.false =>
|
||||
let boolExpr := .const false
|
||||
let expr := mkApp2 (mkConst ``BoolExpr.const) (mkConst ``BVPred) (toExpr Bool.false)
|
||||
let proof := pure <| mkRefl (mkConst ``Bool.false)
|
||||
return some ⟨boolExpr, proof, expr⟩
|
||||
| Bool.not subExpr =>
|
||||
let some sub ← goOrAtom subExpr | return none
|
||||
let boolExpr := .not sub.bvExpr
|
||||
let expr := mkApp2 (mkConst ``BoolExpr.not) (mkConst ``BVPred) sub.expr
|
||||
let proof := do
|
||||
let subEvalExpr ← mkEvalExpr sub.expr
|
||||
let subProof ← sub.evalsAtAtoms
|
||||
return mkApp3 (mkConst ``Std.Tactic.BVDecide.Reflect.Bool.not_congr) subExpr subEvalExpr subProof
|
||||
return some ⟨boolExpr, proof, expr⟩
|
||||
| Bool.and lhsExpr rhsExpr => gateReflection lhsExpr rhsExpr .and ``Std.Tactic.BVDecide.Reflect.Bool.and_congr
|
||||
| Bool.xor lhsExpr rhsExpr => gateReflection lhsExpr rhsExpr .xor ``Std.Tactic.BVDecide.Reflect.Bool.xor_congr
|
||||
| BEq.beq α _ lhsExpr rhsExpr =>
|
||||
match_expr α with
|
||||
| Bool => gateReflection lhsExpr rhsExpr .beq ``Std.Tactic.BVDecide.Reflect.Bool.beq_congr
|
||||
| BitVec _ => goPred t
|
||||
| _ => return none
|
||||
| _ => goPred t
|
||||
|
||||
/--
|
||||
Reify `t` or abstract it as an atom.
|
||||
Unless this function is called on something that is not a `Bool` it is always going to return `some`.
|
||||
-/
|
||||
goOrAtom (t : Expr) : M (Option ReifiedBVLogical) := do
|
||||
match ← go t with
|
||||
| some boolExpr => return some boolExpr
|
||||
| none => boolAtom t
|
||||
|
||||
gateReflection (lhsExpr rhsExpr : Expr) (gate : Gate) (congrThm : Name) :
|
||||
M (Option ReifiedBVLogical) := do
|
||||
let some lhs ← of lhsExpr | return none
|
||||
let some rhs ← of rhsExpr | return none
|
||||
let some lhs ← goOrAtom lhsExpr | return none
|
||||
let some rhs ← goOrAtom rhsExpr | return none
|
||||
let boolExpr := .gate gate lhs.bvExpr rhs.bvExpr
|
||||
let expr :=
|
||||
mkApp4
|
||||
@@ -99,11 +134,8 @@ where
|
||||
return some ⟨boolExpr, proof, expr⟩
|
||||
|
||||
goPred (t : Expr) : M (Option ReifiedBVLogical) := do
|
||||
let some bvPred ← ReifiedBVPred.of t | return none
|
||||
let boolExpr := .literal bvPred.bvPred
|
||||
let expr := mkApp2 (mkConst ``BoolExpr.literal) (mkConst ``BVPred) bvPred.expr
|
||||
let proof := bvPred.evalsAtAtoms
|
||||
return some ⟨boolExpr, proof, expr⟩
|
||||
let some pred ← ReifiedBVPred.of t | return none
|
||||
ofPred pred
|
||||
|
||||
end ReifiedBVLogical
|
||||
|
||||
|
||||
@@ -37,54 +37,68 @@ structure ReifiedBVPred where
|
||||
namespace ReifiedBVPred
|
||||
|
||||
/--
|
||||
Reify an `Expr` that is a proof of a predicate about `BitVec`.
|
||||
Construct an uninterpreted `Bool` atom from `t`.
|
||||
-/
|
||||
def of (t : Expr) : M (Option ReifiedBVPred) := do
|
||||
match_expr t with
|
||||
| BEq.beq α _ lhsExpr rhsExpr =>
|
||||
let_expr BitVec _ := α | return none
|
||||
binaryReflection lhsExpr rhsExpr .eq ``Std.Tactic.BVDecide.Reflect.BitVec.beq_congr
|
||||
| BitVec.ult _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .ult ``Std.Tactic.BVDecide.Reflect.BitVec.ult_congr
|
||||
| BitVec.getLsbD _ subExpr idxExpr =>
|
||||
let some sub ← ReifiedBVExpr.of subExpr | return none
|
||||
let some idx ← getNatValue? idxExpr | return none
|
||||
let bvExpr : BVPred := .getLsbD sub.bvExpr idx
|
||||
let expr := mkApp3 (mkConst ``BVPred.getLsbD) (toExpr sub.width) sub.expr idxExpr
|
||||
let proof := do
|
||||
let subEval ← ReifiedBVExpr.mkEvalExpr sub.width sub.expr
|
||||
let subProof ← sub.evalsAtAtoms
|
||||
return mkApp5
|
||||
(mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.getLsbD_congr)
|
||||
idxExpr
|
||||
(toExpr sub.width)
|
||||
subExpr
|
||||
subEval
|
||||
subProof
|
||||
return some ⟨bvExpr, proof, expr⟩
|
||||
| _ =>
|
||||
/-
|
||||
Idea: we have t : Bool here, let's construct:
|
||||
BitVec.ofBool t : BitVec 1
|
||||
as an atom. Then construct the BVPred corresponding to
|
||||
BitVec.getLsb (BitVec.ofBool t) 0 : Bool
|
||||
We can prove that this is equivalent to `t`. This allows us to have boolean variables in BVPred.
|
||||
-/
|
||||
let ty ← inferType t
|
||||
let_expr Bool := ty | return none
|
||||
let atom ← ReifiedBVExpr.mkAtom (mkApp (mkConst ``BitVec.ofBool) t) 1
|
||||
let bvExpr : BVPred := .getLsbD atom.bvExpr 0
|
||||
let expr := mkApp3 (mkConst ``BVPred.getLsbD) (toExpr 1) atom.expr (toExpr 0)
|
||||
let proof := do
|
||||
let atomEval ← ReifiedBVExpr.mkEvalExpr atom.width atom.expr
|
||||
let atomProof ← atom.evalsAtAtoms
|
||||
return mkApp3
|
||||
(mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.ofBool_congr)
|
||||
t
|
||||
atomEval
|
||||
atomProof
|
||||
return some ⟨bvExpr, proof, expr⟩
|
||||
def boolAtom (t : Expr) : M (Option ReifiedBVPred) := do
|
||||
/-
|
||||
Idea: we have t : Bool here, let's construct:
|
||||
BitVec.ofBool t : BitVec 1
|
||||
as an atom. Then construct the BVPred corresponding to
|
||||
BitVec.getLsb (BitVec.ofBool t) 0 : Bool
|
||||
We can prove that this is equivalent to `t`. This allows us to have boolean variables in BVPred.
|
||||
-/
|
||||
let ty ← inferType t
|
||||
let_expr Bool := ty | return none
|
||||
let atom ← ReifiedBVExpr.mkAtom (mkApp (mkConst ``BitVec.ofBool) t) 1
|
||||
let bvExpr : BVPred := .getLsbD atom.bvExpr 0
|
||||
let expr := mkApp3 (mkConst ``BVPred.getLsbD) (toExpr 1) atom.expr (toExpr 0)
|
||||
let proof := do
|
||||
let atomEval ← ReifiedBVExpr.mkEvalExpr atom.width atom.expr
|
||||
let atomProof ← atom.evalsAtAtoms
|
||||
return mkApp3
|
||||
(mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.ofBool_congr)
|
||||
t
|
||||
atomEval
|
||||
atomProof
|
||||
return some ⟨bvExpr, proof, expr⟩
|
||||
|
||||
/--
|
||||
Reify an `Expr` that is a predicate about `BitVec`.
|
||||
Unless this function is called on something that is not a `Bool` it is always going to return `some`.
|
||||
-/
|
||||
partial def of (t : Expr) : M (Option ReifiedBVPred) := do
|
||||
match ← go t with
|
||||
| some pred => return some pred
|
||||
| none => boolAtom t
|
||||
where
|
||||
/--
|
||||
Reify `t`, returns `none` if the reification procedure failed.
|
||||
-/
|
||||
go (t : Expr) : M (Option ReifiedBVPred) := do
|
||||
match_expr t with
|
||||
| BEq.beq α _ lhsExpr rhsExpr =>
|
||||
let_expr BitVec _ := α | return none
|
||||
binaryReflection lhsExpr rhsExpr .eq ``Std.Tactic.BVDecide.Reflect.BitVec.beq_congr
|
||||
| BitVec.ult _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .ult ``Std.Tactic.BVDecide.Reflect.BitVec.ult_congr
|
||||
| BitVec.getLsbD _ subExpr idxExpr =>
|
||||
let some sub ← ReifiedBVExpr.of subExpr | return none
|
||||
let some idx ← getNatValue? idxExpr | return none
|
||||
let bvExpr : BVPred := .getLsbD sub.bvExpr idx
|
||||
let expr := mkApp3 (mkConst ``BVPred.getLsbD) (toExpr sub.width) sub.expr idxExpr
|
||||
let proof := do
|
||||
let subEval ← ReifiedBVExpr.mkEvalExpr sub.width sub.expr
|
||||
let subProof ← sub.evalsAtAtoms
|
||||
return mkApp5
|
||||
(mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.getLsbD_congr)
|
||||
idxExpr
|
||||
(toExpr sub.width)
|
||||
subExpr
|
||||
subEval
|
||||
subProof
|
||||
return some ⟨bvExpr, proof, expr⟩
|
||||
| _ => return none
|
||||
|
||||
binaryReflection (lhsExpr rhsExpr : Expr) (pred : BVBinPred) (congrThm : Name) :
|
||||
M (Option ReifiedBVPred) := do
|
||||
let some lhs ← ReifiedBVExpr.of lhsExpr | return none
|
||||
|
||||
@@ -52,6 +52,7 @@ instance : Monad TacticM :=
|
||||
instance : Inhabited (TacticM α) where
|
||||
default := fun _ _ => default
|
||||
|
||||
/-- Returns the list of goals. Goals may or may not already be assigned. -/
|
||||
def getGoals : TacticM (List MVarId) :=
|
||||
return (← get).goals
|
||||
|
||||
@@ -300,13 +301,22 @@ instance : MonadBacktrack SavedState TacticM where
|
||||
saveState := Tactic.saveState
|
||||
restoreState b := b.restore
|
||||
|
||||
/--
|
||||
Non-backtracking `try`/`catch`.
|
||||
-/
|
||||
@[inline] protected def tryCatch {α} (x : TacticM α) (h : Exception → TacticM α) : TacticM α := do
|
||||
try x catch ex => h ex
|
||||
|
||||
/--
|
||||
Backtracking `try`/`catch`. This is used for the `MonadExcept` instance for `TacticM`.
|
||||
-/
|
||||
@[inline] protected def tryCatchRestore {α} (x : TacticM α) (h : Exception → TacticM α) : TacticM α := do
|
||||
let b ← saveState
|
||||
try x catch ex => b.restore; h ex
|
||||
|
||||
instance : MonadExcept Exception TacticM where
|
||||
throw := throw
|
||||
tryCatch := Tactic.tryCatch
|
||||
tryCatch := Tactic.tryCatchRestore
|
||||
|
||||
/-- Execute `x` with error recovery disabled -/
|
||||
def withoutRecover (x : TacticM α) : TacticM α :=
|
||||
@@ -342,12 +352,26 @@ def adaptExpander (exp : Syntax → TacticM Syntax) : Tactic := fun stx => do
|
||||
let stx' ← exp stx
|
||||
withMacroExpansion stx stx' $ evalTactic stx'
|
||||
|
||||
/-- Add the given goals at the end of the current goals collection. -/
|
||||
/-- Add the given goal to the front of the current list of goals. -/
|
||||
def pushGoal (mvarId : MVarId) : TacticM Unit :=
|
||||
modify fun s => { s with goals := mvarId :: s.goals }
|
||||
|
||||
/-- Add the given goals to the front of the current list of goals. -/
|
||||
def pushGoals (mvarIds : List MVarId) : TacticM Unit :=
|
||||
modify fun s => { s with goals := mvarIds ++ s.goals }
|
||||
|
||||
/-- Add the given goals at the end of the current list of goals. -/
|
||||
def appendGoals (mvarIds : List MVarId) : TacticM Unit :=
|
||||
modify fun s => { s with goals := s.goals ++ mvarIds }
|
||||
|
||||
/-- Discard the first goal and replace it by the given list of goals,
|
||||
keeping the other goals. -/
|
||||
/--
|
||||
Discard the first goal and replace it by the given list of goals,
|
||||
keeping the other goals. This is used in conjunction with `getMainGoal`.
|
||||
|
||||
Contract: between `getMainGoal` and `replaceMainGoal`, nothing manipulates the goal list.
|
||||
|
||||
See also `Lean.Elab.Tactic.popMainGoal` and `Lean.Elab.Tactic.pushGoal`/`Lean.Elab.Tactic.pushGoal` for another interface.
|
||||
-/
|
||||
def replaceMainGoal (mvarIds : List MVarId) : TacticM Unit := do
|
||||
let (_ :: mvarIds') ← getGoals | throwNoGoalsToBeSolved
|
||||
modify fun _ => { goals := mvarIds ++ mvarIds' }
|
||||
@@ -365,6 +389,16 @@ where
|
||||
setGoals (mvarId :: mvarIds)
|
||||
return mvarId
|
||||
|
||||
/--
|
||||
Return the first goal, and remove it from the goal list.
|
||||
|
||||
See also: `Lean.Elab.Tactic.pushGoal` and `Lean.Elab.Tactic.pushGoals`.
|
||||
-/
|
||||
def popMainGoal : TacticM MVarId := do
|
||||
let mvarId ← getMainGoal
|
||||
replaceMainGoal []
|
||||
return mvarId
|
||||
|
||||
/-- Return the main goal metavariable declaration. -/
|
||||
def getMainDecl : TacticM MetavarDecl := do
|
||||
(← getMainGoal).getDecl
|
||||
|
||||
@@ -520,7 +520,7 @@ where
|
||||
|
||||
@[builtin_tactic «case», builtin_incremental]
|
||||
def evalCase : Tactic
|
||||
| stx@`(tactic| case $[$tag $hs*]|* =>%$arr $tac:tacticSeq1Indented) =>
|
||||
| stx@`(tactic| case%$caseTk $[$tag $hs*]|* =>%$arr $tac:tacticSeq1Indented) =>
|
||||
-- disable incrementality if body is run multiple times
|
||||
Term.withoutTacticIncrementality (tag.size > 1) do
|
||||
for tag in tag, hs in hs do
|
||||
@@ -528,20 +528,20 @@ def evalCase : Tactic
|
||||
let g ← renameInaccessibles g hs
|
||||
setGoals [g]
|
||||
g.setTag Name.anonymous
|
||||
withCaseRef arr tac <| closeUsingOrAdmit <| withTacticInfoContext stx <|
|
||||
withCaseRef arr tac <| closeUsingOrAdmit <| withTacticInfoContext (mkNullNode #[caseTk, arr]) <|
|
||||
Term.withNarrowedArgTacticReuse (argIdx := 3) (evalTactic ·) stx
|
||||
setGoals gs
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_tactic «case'»] def evalCase' : Tactic
|
||||
| `(tactic| case' $[$tag $hs*]|* =>%$arr $tac:tacticSeq) => do
|
||||
| `(tactic| case'%$caseTk $[$tag $hs*]|* =>%$arr $tac:tacticSeq) => do
|
||||
let mut acc := #[]
|
||||
for tag in tag, hs in hs do
|
||||
let (g, gs) ← getCaseGoals tag
|
||||
let g ← renameInaccessibles g hs
|
||||
let mvarTag ← g.getTag
|
||||
setGoals [g]
|
||||
withCaseRef arr tac (evalTactic tac)
|
||||
withCaseRef arr tac <| withTacticInfoContext (mkNullNode #[caseTk, arr]) <| evalTactic tac
|
||||
let gs' ← getUnsolvedGoals
|
||||
if let [g'] := gs' then
|
||||
g'.setTag mvarTag
|
||||
|
||||
@@ -14,9 +14,9 @@ open Meta
|
||||
@[builtin_tactic Lean.calcTactic]
|
||||
def evalCalc : Tactic := fun stx => withMainContext do
|
||||
let steps : TSyntax ``calcSteps := ⟨stx[1]⟩
|
||||
let (val, mvarIds) ← withCollectingNewGoalsFrom (tagSuffix := `calc) do
|
||||
let target := (← getMainTarget).consumeMData
|
||||
let tag ← getMainTag
|
||||
let target := (← getMainTarget).consumeMData
|
||||
let tag ← getMainTag
|
||||
let (val, mvarIds) ← withCollectingNewGoalsFrom (parentTag := tag) (tagSuffix := `calc) do
|
||||
runTermElab do
|
||||
let mut val ← Term.elabCalcSteps steps
|
||||
let mut valType ← instantiateMVars (← inferType val)
|
||||
|
||||
34
src/Lean/Elab/Tactic/Classical.lean
Normal file
34
src/Lean/Elab/Tactic/Classical.lean
Normal file
@@ -0,0 +1,34 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro, Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Lean.Elab.Tactic.Basic
|
||||
|
||||
/-! # `classical` tactic -/
|
||||
|
||||
namespace Lean.Elab.Tactic
|
||||
open Lean Meta Elab.Tactic
|
||||
|
||||
/--
|
||||
`classical t` runs `t` in a scope where `Classical.propDecidable` is a low priority
|
||||
local instance.
|
||||
-/
|
||||
def classical [Monad m] [MonadEnv m] [MonadFinally m] [MonadLiftT MetaM m] (t : m α) :
|
||||
m α := do
|
||||
modifyEnv Meta.instanceExtension.pushScope
|
||||
Meta.addInstance ``Classical.propDecidable .local 10
|
||||
try
|
||||
t
|
||||
finally
|
||||
modifyEnv Meta.instanceExtension.popScope
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.classical]
|
||||
def evalClassical : Tactic := fun stx => do
|
||||
match stx with
|
||||
| `(tactic| classical $tacs:tacticSeq) =>
|
||||
classical <| Elab.Tactic.evalTactic tacs
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Tactic
|
||||
@@ -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.1)
|
||||
| n+1 => pure (n, i)
|
||||
let ids := ids.qsort (·.1 < ·.1)
|
||||
unless @Array.allDiff _ ⟨(·.1 == ·.1)⟩ ids do
|
||||
throwError "occurrence list is not distinct"
|
||||
|
||||
@@ -56,11 +56,6 @@ def elabTermEnsuringType (stx : Syntax) (expectedType? : Option Expr) (mayPostpo
|
||||
Term.throwTypeMismatchError none expectedType eType e
|
||||
return e
|
||||
|
||||
/-- Try to close main goal using `x target`, where `target` is the type of the main goal. -/
|
||||
def closeMainGoalUsing (tacName : Name) (x : Expr → TacticM Expr) (checkUnassigned := true) : TacticM Unit :=
|
||||
withMainContext do
|
||||
closeMainGoal (tacName := tacName) (checkUnassigned := checkUnassigned) (← x (← getMainTarget))
|
||||
|
||||
def logUnassignedAndAbort (mvarIds : Array MVarId) : TacticM Unit := do
|
||||
if (← Term.logUnassignedUsingErrorInfos mvarIds) then
|
||||
throwAbortTactic
|
||||
@@ -69,14 +64,37 @@ def filterOldMVars (mvarIds : Array MVarId) (mvarCounterSaved : Nat) : MetaM (Ar
|
||||
let mctx ← getMCtx
|
||||
return mvarIds.filter fun mvarId => (mctx.getDecl mvarId |>.index) >= mvarCounterSaved
|
||||
|
||||
/--
|
||||
Try to close main goal using `x target tag`, where `target` is the type of the main goal and `tag` is its user name.
|
||||
|
||||
If `checkNewUnassigned` is true, then throws an error if the resulting value has metavariables that were created during the execution of `x`.
|
||||
If it is false, then it is the responsibility of `x` to add such metavariables to the goal list.
|
||||
|
||||
During the execution of `x`:
|
||||
* The local context is that of the main goal.
|
||||
* The goal list has the main goal removed.
|
||||
* It is allowable to modify the goal list, for example with `Lean.Elab.Tactic.pushGoals`.
|
||||
|
||||
On failure, the main goal remains at the front of the goal list.
|
||||
-/
|
||||
def closeMainGoalUsing (tacName : Name) (x : Expr → Name → TacticM Expr) (checkNewUnassigned := true) : TacticM Unit := do
|
||||
let mvarCounterSaved := (← getMCtx).mvarCounter
|
||||
let mvarId ← popMainGoal
|
||||
Tactic.tryCatch
|
||||
(mvarId.withContext do
|
||||
let val ← x (← mvarId.getType) (← mvarId.getTag)
|
||||
if checkNewUnassigned then
|
||||
let mvars ← filterOldMVars (← getMVars val) mvarCounterSaved
|
||||
logUnassignedAndAbort mvars
|
||||
unless (← mvarId.checkedAssign val) do
|
||||
throwTacticEx tacName mvarId m!"attempting to close the goal using{indentExpr val}\nthis is often due occurs-check failure")
|
||||
(fun ex => do
|
||||
pushGoal mvarId
|
||||
throw ex)
|
||||
|
||||
@[builtin_tactic «exact»] def evalExact : Tactic := fun stx => do
|
||||
match stx with
|
||||
| `(tactic| exact $e) =>
|
||||
closeMainGoalUsing `exact (checkUnassigned := false) fun type => do
|
||||
let mvarCounterSaved := (← getMCtx).mvarCounter
|
||||
let r ← elabTermEnsuringType e type
|
||||
logUnassignedAndAbort (← filterOldMVars (← getMVars r) mvarCounterSaved)
|
||||
return r
|
||||
| `(tactic| exact $e) => closeMainGoalUsing `exact fun type _ => elabTermEnsuringType e type
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
def sortMVarIdArrayByIndex [MonadMCtx m] [Monad m] (mvarIds : Array MVarId) : m (Array MVarId) := do
|
||||
@@ -93,9 +111,12 @@ def sortMVarIdsByIndex [MonadMCtx m] [Monad m] (mvarIds : List MVarId) : m (List
|
||||
return (← sortMVarIdArrayByIndex mvarIds.toArray).toList
|
||||
|
||||
/--
|
||||
Execute `k`, and collect new "holes" in the resulting expression.
|
||||
Execute `k`, and collect new "holes" in the resulting expression.
|
||||
|
||||
* `parentTag` and `tagSuffix` are used to tag untagged goals with `Lean.Elab.Tactic.tagUntaggedGoals`.
|
||||
* If `allowNaturalHoles` is true, then `_`'s are allowed and create new goals.
|
||||
-/
|
||||
def withCollectingNewGoalsFrom (k : TacticM Expr) (tagSuffix : Name) (allowNaturalHoles := false) : TacticM (Expr × List MVarId) :=
|
||||
def withCollectingNewGoalsFrom (k : TacticM Expr) (parentTag : Name) (tagSuffix : Name) (allowNaturalHoles := false) : TacticM (Expr × List MVarId) :=
|
||||
/-
|
||||
When `allowNaturalHoles = true`, unassigned holes should become new metavariables, including `_`s.
|
||||
Thus, we set `holesAsSyntheticOpaque` to true if it is not already set to `true`.
|
||||
@@ -144,7 +165,7 @@ where
|
||||
appear in the `.lean` file. We should tell users to prefer tagged goals.
|
||||
-/
|
||||
let newMVarIds ← sortMVarIdsByIndex newMVarIds.toList
|
||||
tagUntaggedGoals (← getMainTag) tagSuffix newMVarIds
|
||||
tagUntaggedGoals parentTag tagSuffix newMVarIds
|
||||
return (val, newMVarIds)
|
||||
|
||||
/-- Elaborates `stx` and collects the `MVarId`s of any holes that were created during elaboration.
|
||||
@@ -153,8 +174,8 @@ With `allowNaturalHoles := false` (the default), any new natural holes (`_`) whi
|
||||
be synthesized during elaboration cause `elabTermWithHoles` to fail. (Natural goals appearing in
|
||||
`stx` which were created prior to elaboration are permitted.)
|
||||
|
||||
Unnamed `MVarId`s are renamed to share the main goal's tag. If multiple unnamed goals are
|
||||
encountered, `tagSuffix` is appended to the main goal's tag along with a numerical index.
|
||||
Unnamed `MVarId`s are renamed to share the tag `parentTag?` (or the main goal's tag if `parentTag?` is `none`).
|
||||
If multiple unnamed goals are encountered, `tagSuffix` is appended to this tag along with a numerical index.
|
||||
|
||||
Note:
|
||||
* Previously-created `MVarId`s which appear in `stx` are not returned.
|
||||
@@ -163,8 +184,8 @@ metavariables.
|
||||
* When `allowNaturalHoles := true`, `stx` is elaborated under `withAssignableSyntheticOpaque`,
|
||||
meaning that `.syntheticOpaque` metavariables might be assigned during elaboration. This is a
|
||||
consequence of the implementation. -/
|
||||
def elabTermWithHoles (stx : Syntax) (expectedType? : Option Expr) (tagSuffix : Name) (allowNaturalHoles := false) : TacticM (Expr × List MVarId) := do
|
||||
withCollectingNewGoalsFrom (elabTermEnsuringType stx expectedType?) tagSuffix allowNaturalHoles
|
||||
def elabTermWithHoles (stx : Syntax) (expectedType? : Option Expr) (tagSuffix : Name) (allowNaturalHoles := false) (parentTag? : Option Name := none) : TacticM (Expr × List MVarId) := do
|
||||
withCollectingNewGoalsFrom (elabTermEnsuringType stx expectedType?) (← parentTag?.getDM getMainTag) tagSuffix allowNaturalHoles
|
||||
|
||||
/-- If `allowNaturalHoles == true`, then we allow the resultant expression to contain unassigned "natural" metavariables.
|
||||
Recall that "natutal" metavariables are created for explicit holes `_` and implicit arguments. They are meant to be
|
||||
@@ -395,7 +416,7 @@ private partial def blameDecideReductionFailure (inst : Expr) : MetaM Expr := wi
|
||||
return inst
|
||||
|
||||
def evalDecideCore (tacticName : Name) (kernelOnly : Bool) : TacticM Unit :=
|
||||
closeMainGoalUsing tacticName fun expectedType => do
|
||||
closeMainGoalUsing tacticName fun expectedType _ => do
|
||||
let expectedType ← preprocessPropToDecide expectedType
|
||||
let pf ← mkDecideProof expectedType
|
||||
-- Get instance from `pf`
|
||||
@@ -501,7 +522,7 @@ private def mkNativeAuxDecl (baseName : Name) (type value : Expr) : TermElabM Na
|
||||
pure auxName
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.nativeDecide] def evalNativeDecide : Tactic := fun _ =>
|
||||
closeMainGoalUsing `nativeDecide fun expectedType => do
|
||||
closeMainGoalUsing `nativeDecide fun expectedType _ => do
|
||||
let expectedType ← preprocessPropToDecide expectedType
|
||||
let d ← mkDecide expectedType
|
||||
let auxDeclName ← mkNativeAuxDecl `_nativeDecide (Lean.mkConst `Bool) d
|
||||
|
||||
@@ -123,9 +123,7 @@ def realizeExtTheorem (structName : Name) (flat : Bool) : Elab.Command.CommandEl
|
||||
levelParams := info.levelParams
|
||||
}
|
||||
modifyEnv fun env => addProtected env extName
|
||||
Lean.addDeclarationRanges extName {
|
||||
range := ← getDeclarationRange (← getRef)
|
||||
selectionRange := ← getDeclarationRange (← getRef) }
|
||||
addAuxDeclarationRanges extName (← getRef) (← getRef)
|
||||
catch e =>
|
||||
throwError m!"\
|
||||
Failed to generate an 'ext' theorem for '{MessageData.ofConstName structName}': {e.toMessageData}"
|
||||
@@ -163,9 +161,7 @@ def realizeExtIffTheorem (extName : Name) : Elab.Command.CommandElabM Name := do
|
||||
-- Only declarations in a namespace can be protected:
|
||||
unless extIffName.isAtomic do
|
||||
modifyEnv fun env => addProtected env extIffName
|
||||
Lean.addDeclarationRanges extIffName {
|
||||
range := ← getDeclarationRange (← getRef)
|
||||
selectionRange := ← getDeclarationRange (← getRef) }
|
||||
addAuxDeclarationRanges extName (← getRef) (← getRef)
|
||||
catch e =>
|
||||
throwError m!"\
|
||||
Failed to generate an 'ext_iff' theorem from '{MessageData.ofConstName extName}': {e.toMessageData}\n\
|
||||
|
||||
@@ -27,8 +27,10 @@ open Meta
|
||||
syntax inductionAlt := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> syntheticHole <|> tacticSeq)
|
||||
```
|
||||
-/
|
||||
private def getAltLhses (alt : Syntax) : Syntax :=
|
||||
alt[0]
|
||||
private def getFirstAltLhs (alt : Syntax) : Syntax :=
|
||||
alt[0][0]
|
||||
(getAltLhses alt)[0]
|
||||
/-- Return `inductionAlt` name. It assumes `alt` does not have multiple `inductionAltLHS` -/
|
||||
private def getAltName (alt : Syntax) : Name :=
|
||||
let lhs := getFirstAltLhs alt
|
||||
@@ -70,7 +72,9 @@ def evalAlt (mvarId : MVarId) (alt : Syntax) (addInfo : TermElabM Unit) : Tactic
|
||||
let goals ← getGoals
|
||||
try
|
||||
setGoals [mvarId]
|
||||
closeUsingOrAdmit (withTacticInfoContext alt (addInfo *> evalTactic rhs))
|
||||
closeUsingOrAdmit <|
|
||||
withTacticInfoContext (mkNullNode #[getAltLhses alt, getAltDArrow alt]) <|
|
||||
(addInfo *> evalTactic rhs)
|
||||
finally
|
||||
setGoals goals
|
||||
|
||||
|
||||
@@ -914,7 +914,9 @@ private def applyAttributesCore
|
||||
Remark: if the declaration has syntax errors, `declName` may be `.anonymous` see issue #4309
|
||||
In this case, we skip attribute application.
|
||||
-/
|
||||
unless declName == .anonymous do
|
||||
if declName == .anonymous then
|
||||
return
|
||||
withDeclName declName do
|
||||
for attr in attrs do
|
||||
withRef attr.stx do withLogging do
|
||||
let env ← getEnv
|
||||
|
||||
@@ -1038,6 +1038,14 @@ def getForallBinderNames : Expr → List Name
|
||||
| forallE n _ b _ => n :: getForallBinderNames b
|
||||
| _ => []
|
||||
|
||||
/--
|
||||
Returns the number of leading `∀` binders of an expression. Ignores metadata.
|
||||
-/
|
||||
def getNumHeadForalls : Expr → Nat
|
||||
| mdata _ b => getNumHeadForalls b
|
||||
| forallE _ _ body _ => getNumHeadForalls body + 1
|
||||
| _ => 0
|
||||
|
||||
/--
|
||||
If the given expression is a sequence of
|
||||
function applications `f a₁ .. aₙ`, return `f`.
|
||||
@@ -1085,6 +1093,16 @@ private def getAppNumArgsAux : Expr → Nat → Nat
|
||||
def getAppNumArgs (e : Expr) : Nat :=
|
||||
getAppNumArgsAux e 0
|
||||
|
||||
/-- Like `getAppNumArgs` but ignores metadata. -/
|
||||
def getAppNumArgs' (e : Expr) : Nat :=
|
||||
go e 0
|
||||
where
|
||||
/-- Auxiliary definition for `getAppNumArgs'`. -/
|
||||
go : Expr → Nat → Nat
|
||||
| mdata _ b, n => go b n
|
||||
| app f _ , n => go f (n + 1)
|
||||
| _ , n => n
|
||||
|
||||
/--
|
||||
Like `Lean.Expr.getAppFn` but assumes the application has up to `maxArgs` arguments.
|
||||
If there are any more arguments than this, then they are returned by `getAppFn` as part of the function.
|
||||
|
||||
@@ -243,11 +243,16 @@ instance : ToSnapshotTree SnapshotLeaf where
|
||||
structure DynamicSnapshot where
|
||||
/-- Concrete snapshot value as `Dynamic`. -/
|
||||
val : Dynamic
|
||||
/-- Snapshot tree retrieved from `val` before erasure. -/
|
||||
tree : SnapshotTree
|
||||
/--
|
||||
Snapshot tree retrieved from `val` before erasure. We do thunk even the first level as accessing
|
||||
it too early can create some unnecessary tasks from `toSnapshotTree` that are otherwise avoided by
|
||||
`(sync := true)` when accessing only after elaboration has finished. Early access can even lead to
|
||||
deadlocks when later forcing these unnecessary tasks on a starved thread pool.
|
||||
-/
|
||||
tree : Thunk SnapshotTree
|
||||
|
||||
instance : ToSnapshotTree DynamicSnapshot where
|
||||
toSnapshotTree s := s.tree
|
||||
toSnapshotTree s := s.tree.get
|
||||
|
||||
/-- Creates a `DynamicSnapshot` from a typed snapshot value. -/
|
||||
def DynamicSnapshot.ofTyped [TypeName α] [ToSnapshotTree α] (val : α) : DynamicSnapshot where
|
||||
|
||||
@@ -1,42 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.MonadEnv
|
||||
|
||||
namespace Lean
|
||||
|
||||
structure LazyInitExtension (m : Type → Type) (α : Type) where
|
||||
ext : EnvExtension (Option α)
|
||||
fn : m α
|
||||
|
||||
instance [Monad m] [Inhabited α] : Inhabited (LazyInitExtension m α) where
|
||||
default := {
|
||||
ext := default
|
||||
fn := pure default
|
||||
}
|
||||
|
||||
/--
|
||||
Register an environment extension for storing the result of `fn`.
|
||||
We initialize the extension with `none`, and `fn` is executed the
|
||||
first time `LazyInit.get` is executed.
|
||||
|
||||
This kind of extension is useful for avoiding work duplication in
|
||||
scenarios where a thunk cannot be used because the computation depends
|
||||
on state from the `m` monad. For example, we may want to "cache" a collection
|
||||
of theorems as a `SimpLemmas` object. -/
|
||||
def registerLazyInitExtension (fn : m α) : IO (LazyInitExtension m α) := do
|
||||
let ext ← registerEnvExtension (pure none)
|
||||
return { ext, fn }
|
||||
|
||||
def LazyInitExtension.get [MonadEnv m] [Monad m] (init : LazyInitExtension m α) : m α := do
|
||||
match init.ext.getState (← getEnv) with
|
||||
| some a => return a
|
||||
| none =>
|
||||
let a ← init.fn
|
||||
modifyEnv fun env => init.ext.setState env (some a)
|
||||
return a
|
||||
|
||||
end Lean
|
||||
@@ -37,7 +37,7 @@ def constructorNameAsVariable : Linter where
|
||||
let warnings : IO.Ref (Std.HashMap String.Range (Syntax × Name × Name)) ← IO.mkRef {}
|
||||
|
||||
for tree in infoTrees do
|
||||
tree.visitM' (preNode := fun ci info _ => do
|
||||
tree.visitM' (postNode := fun ci info _ => do
|
||||
match info with
|
||||
| .ofTermInfo ti =>
|
||||
match ti.expr with
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user