Compare commits

..

1 Commits

Author SHA1 Message Date
Kim Morrison
6639a043f1 chore: rename List.bind and Array.concatMap to flatMap
fix
2024-10-16 16:45:20 +11:00
639 changed files with 1694 additions and 3802 deletions

View File

@@ -11,9 +11,7 @@ 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
src/Std
sparse-checkout: src/Lean
- name: Check Prelude
run: |
failed_files=""
@@ -21,8 +19,8 @@ jobs:
if ! grep -q "^prelude$" "$file"; then
failed_files="$failed_files$file\n"
fi
done < <(find src/Lean src/Std -name '*.lean' -print0)
done < <(find src/Lean -name '*.lean' -print0)
if [ -n "$failed_files" ]; then
echo -e "The following files should use 'prelude':\n$failed_files"
exit 1
fi
fi

View File

@@ -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 @kim-em
/RELEASES.md @kim-em
/.github/ @Kha @semorrison
/RELEASES.md @semorrison
/src/kernel/ @leodemoura
/src/lake/ @tydeu
/src/Lean/Compiler/ @leodemoura
/src/Lean/Data/Lsp/ @mhuisi
/src/Lean/Elab/Deriving/ @kim-em
/src/Lean/Elab/Tactic/ @kim-em
/src/Lean/Elab/Deriving/ @semorrison
/src/Lean/Elab/Tactic/ @semorrison
/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/ @kim-em
/src/Init/Data/ @semorrison
/src/Init/Data/Array/Lemmas.lean @digama0
/src/Init/Data/List/Lemmas.lean @digama0
/src/Init/Data/List/BasicAux.lean @digama0
@@ -45,4 +45,3 @@
/src/Std/ @TwoFX
/src/Std/Tactic/BVDecide/ @hargoniX
/src/Lean/Elab/Tactic/BVDecide/ @hargoniX
/src/Std/Sat/ @hargoniX

View File

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

View File

@@ -1385,7 +1385,6 @@ 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
@@ -1865,8 +1864,7 @@ section
variable {α : Type u}
variable (r : α α Prop)
instance Quotient.decidableEq {α : Sort u} {s : Setoid α} [d : (a b : α), Decidable (a b)]
: DecidableEq (Quotient s) :=
instance {α : Sort u} {s : Setoid α} [d : (a b : α), Decidable (a b)] : DecidableEq (Quotient s) :=
fun (q₁ q₂ : Quotient s) =>
Quotient.recOnSubsingleton₂ q₁ q₂
fun a₁ a₂ =>
@@ -1937,6 +1935,15 @@ 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 -/
@@ -2112,14 +2119,4 @@ 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

View File

@@ -16,4 +16,3 @@ 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

View File

@@ -7,7 +7,7 @@ prelude
import Init.WFTactics
import Init.Data.Nat.Basic
import Init.Data.Fin.Basic
import Init.Data.UInt.BasicAux
import Init.Data.UInt.Basic
import Init.Data.Repr
import Init.Data.ToString.Basic
import Init.GetElem
@@ -25,8 +25,6 @@ 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 :=
@@ -80,26 +78,6 @@ theorem ext' {as bs : Array α} (h : as.toList = bs.toList) : as = bs := by
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
@[simp] theorem getElem_toList {a : Array α} {i : Nat} (h : i < a.size) : a.toList[i] = a[i] := rfl
end Array
namespace List
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[simp] theorem getElem_toArray {a : List α} {i : Nat} (h : i < a.toArray.size) :
a.toArray[i] = a[i]'(by simpa using h) := rfl
@[simp] theorem getElem?_toArray {a : List α} {i : Nat} : a.toArray[i]? = a[i]? := rfl
@[simp] theorem getElem!_toArray [Inhabited α] {a : List α} {i : Nat} :
a.toArray[i]! = a[i]! := rfl
end List
namespace Array
@[deprecated toList_toArray (since := "2024-09-09")] abbrev data_toArray := @toList_toArray
@[deprecated Array.toList (since := "2024-09-10")] abbrev Array.data := @Array.toList
@@ -418,25 +396,20 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
decreasing_by simp_wf; decreasing_trivial_pre_omega
map 0 (mkEmpty as.size)
/-- Variant of `mapIdxM` which receives the index as a `Fin as.size`. -/
@[inline]
def mapFinIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m]
(as : Array α) (f : Fin as.size α m β) : m (Array β) :=
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : Fin as.size α m β) : m (Array β) :=
let rec @[specialize] map (i : Nat) (j : Nat) (inv : i + j = as.size) (bs : Array β) : m (Array β) := do
match i, inv with
| 0, _ => pure bs
| i+1, inv =>
have j_lt : j < as.size := by
have : j < as.size := by
rw [ inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_comm]
apply Nat.le_add_right
let idx : Fin as.size := j, this
have : i + (j + 1) = as.size := by rw [ inv, Nat.add_comm j 1, Nat.add_assoc]
map i (j+1) this (bs.push ( f j, j_lt (as.get j, j_lt)))
map i (j+1) this (bs.push ( f idx (as.get idx)))
map as.size 0 rfl (mkEmpty as.size)
@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : Nat α m β) : m (Array β) :=
as.mapFinIdxM fun i a => f i a
@[inline]
def findSomeM? {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : α m (Option β)) : m (Option β) := do
for a in as do
@@ -542,13 +515,8 @@ def foldr {α : Type u} {β : Type v} (f : α → β → β) (init : β) (as : A
def map {α : Type u} {β : Type v} (f : α β) (as : Array α) : Array β :=
Id.run <| as.mapM f
/-- Variant of `mapIdx` which receives the index as a `Fin as.size`. -/
@[inline]
def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size α β) : Array β :=
Id.run <| as.mapFinIdxM f
@[inline]
def mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Nat α β) : Array β :=
def mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size α β) : Array β :=
Id.run <| as.mapIdxM f
/-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/
@@ -849,15 +817,9 @@ def split (as : Array α) (p : α → Bool) : Array α × Array α :=
/-! ## Auxiliary functions used in metaprogramming.
We do not currently intend to provide verification theorems for these functions.
We do not 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 -/
/--

View File

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

View File

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

View File

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

View File

@@ -8,17 +8,19 @@ 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
/-!
## Theorems about `Array`.
## Bootstrapping theorems about arrays
This file contains some theorems about `Array` and `List` needed for `Init.Data.List.Impl`.
-/
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
@@ -43,32 +45,31 @@ theorem getElem?_eq_getElem?_toList (a : Array α) (i : Nat) : a[i]? = a.toList[
rw [getElem?_eq]
split <;> simp_all
theorem getElem_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
@[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) :
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 getElem_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
@[simp] theorem get_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 getElem_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
theorem get_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 [getElem_push_lt, h']
· simp [get_push_lt, h']
· simp at 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)]
simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
end Array
@@ -76,15 +77,28 @@ namespace List
open Array
/-! ### Lemmas about `List.toArray`.
We prefer to pull `List.toArray` outwards.
-/
/-! ### Lemmas about `List.toArray`. -/
@[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
@@ -94,14 +108,6 @@ We prefer to pull `List.toArray` outwards.
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]
@@ -157,15 +163,20 @@ 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]
@@ -214,6 +225,9 @@ 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
@@ -234,10 +248,21 @@ theorem foldl_toList_eq_flatMap (l : List α) (acc : Array β)
(l.foldl F acc).toList = acc.toList ++ l.flatMap G := by
induction l generalizing acc <;> simp [*, List.flatMap]
@[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
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
@@ -252,18 +277,12 @@ 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)
@@ -286,10 +305,8 @@ 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 only [get!_eq_getD, getD_eq_get?, getD_get?, p, get?_eq_getElem?]
@[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]
/-! # set -/
@@ -369,8 +386,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 [getElem_push, hj, hacc j hj]
| inr hj => simp [getElem_push, *]
| inl hj => simp [get_push, hj, hacc j hj]
| inr hj => simp [get_push, *]
else
simp [hin, hacc k (Nat.lt_of_lt_of_le hki (Nat.le_of_not_lt (hi hin)))]
termination_by n - i
@@ -379,10 +396,6 @@ 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 :=
@@ -390,17 +403,19 @@ theorem getElem?_ofFn (f : Fin n → α) (i : Nat) :
@[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 α} :
@@ -410,12 +425,6 @@ 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]
@@ -438,60 +447,75 @@ theorem lt_of_getElem {x : α} {a : Array α} {idx : Nat} {hidx : idx < a.size}
idx < a.size :=
hidx
@[simp] theorem getElem_mem {l : Array α} {i : Nat} (h : i < l.size) : l[i] l := by
theorem getElem?_mem {l : Array α} {i : Fin l.size} : l[i] l := by
erw [Array.mem_def, getElem_eq_getElem_toList]
apply List.get_mem
theorem getElem_fin_eq_getElem_toList (a : Array α) (i : Fin a.size) : a[i] = a.toList[i] := rfl
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
@[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) :
a[i] = a[i.toNat] := rfl
theorem getElem?_size_le (a : Array α) (i : Nat) (h : a.size i) : a[i]? = none := by
theorem get?_len_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]
theorem get?_eq_get?_toList (a : Array α) (i : Nat) : a.get? i = a.toList.get? i := by
simp [getElem?_eq_getElem?_toList]
@[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? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by
simp only [get!_eq_getElem?, get?_eq_getElem?]
simp [get!_eq_getD]
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 only [back, get!_eq_getElem?, get?_eq_getElem?, back?]
simp [back, back?]
@[simp] theorem back?_push (a : Array α) : (a.push x).back? = some x := by
simp [back?, getElem?_eq_getElem?_toList]
simp [back?, getElem?_eq_toList_getElem?]
theorem back_push [Inhabited α] (a : Array α) : (a.push x).back = x := by simp
theorem getElem?_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
theorem get?_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
(a.push x)[i]? = some a[i] := by
rw [getElem?_pos, getElem_push_lt]
rw [getElem?_pos, get_push_lt]
@[deprecated getElem?_push_lt (since := "2024-10-21")] abbrev get?_push_lt := @getElem?_push_lt
theorem get?_push_eq (a : Array α) (x : α) : (a.push x)[a.size]? = some x := by
rw [getElem?_pos, get_push_eq]
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
theorem get?_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, getElem_push_lt]
simp [getElem?_def, size_push, g, h1, h2, get_push_lt]
| Or.inr (Or.inl heq) =>
simp [heq, getElem?_pos, getElem_push_eq]
simp [heq, getElem?_pos, get_push_eq]
| Or.inr (Or.inr g) =>
simp only [getElem?_def, size_push]
have h1 : ¬ (i < a.size) := by omega
@@ -499,15 +523,14 @@ theorem getElem?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some
have h3 : i a.size := by omega
simp [h1, h2, h3]
@[deprecated getElem?_push (since := "2024-10-21")] abbrev get?_push := @getElem?_push
@[simp] theorem getElem?_size {a : Array α} : a[a.size]? = none := by
@[simp] theorem get?_size {a : Array α} : a[a.size]? = none := by
simp only [getElem?_def, Nat.lt_irrefl, dite_false]
@[deprecated getElem?_size (since := "2024-10-21")] abbrev get?_size := @getElem?_size
@[simp] theorem toList_set (a : Array α) (i v) : (a.set i v).toList = a.toList.set i.1 v := rfl
@[deprecated toList_set (since := "2024-09-09")]
abbrev data_set := @toList_set
theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) :
(a.set i v)[i.1] = v := by
simp only [set, getElem_eq_getElem_toList, List.getElem_set_self]
@@ -548,16 +571,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]
theorem getElem?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]? =
@[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]? =
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_getElem_toList]
simp [swap_def, get?_set, getElem_fin_eq_toList_get]
@[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]
@@ -571,6 +594,9 @@ 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]
@@ -590,11 +616,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 [getElem_push_lt (h:=hlt), getElem_pop]
rw [get_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 [getElem_push_eq, back, size_pop, get!_eq_getD, getD, dif_pos h]; rfl
cases heq; rw [get_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 :=
@@ -603,6 +629,9 @@ 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]
@@ -627,10 +656,14 @@ theorem size_eq_length_toList (as : Array α) : as.size = as.toList.length := rf
@[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)
@@ -643,9 +676,9 @@ theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Arra
· rwa [Nat.add_right_comm i]
· simp [size_swap, h₂]
· intro k
rw [ getElem?_eq_getElem?_toList, getElem?_swap]
rw [ getElem?_eq_toList_getElem?, get?_swap]
simp only [H, getElem_eq_getElem_toList, List.getElem?_eq_getElem, Nat.le_of_lt h₁,
getElem?_eq_getElem?_toList]
getElem?_eq_toList_getElem?]
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
@@ -672,6 +705,9 @@ theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Arra
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) :
@@ -700,7 +736,7 @@ theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Arra
foldrM f init #[] start stop = return init := by
simp [foldrM]
-- This proof is the pure version of `Array.SatisfiesM_foldlM` in Batteries,
-- This proof is the pure version of `Array.SatisfiesM_foldlM`,
-- reproduced to avoid a dependency on `SatisfiesM`.
theorem foldl_induction
{as : Array α} (motive : Nat β Prop) {init : β} (h0 : motive 0 init) {f : β α β}
@@ -716,7 +752,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` in Batteries,
-- This proof is the pure version of `Array.SatisfiesM_foldrM`,
-- reproduced to avoid a dependency on `SatisfiesM`.
theorem foldr_induction
{as : Array α} (motive : Nat β Prop) {init : β} (h0 : motive as.size init) {f : α β β}
@@ -762,6 +798,9 @@ 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
@@ -803,9 +842,9 @@ theorem map_induction (as : Array α) (f : α → β) (motive : Nat → Prop) (h
· intro j h
simp at h
by_cases h' : j < size b
· rw [getElem_push]
· rw [get_push]
simp_all
· rw [getElem_push, dif_neg h']
· rw [get_push, dif_neg h']
simp only [show j = i by omega]
exact (hs _ m).1
@@ -830,14 +869,59 @@ 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, getElem_push, size_map]
· simp only [getElem_map, get_push, size_map]
split <;> rfl
@[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]
/-! ### 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
/-! ### modify -/
@@ -852,12 +936,6 @@ theorem getElem_modify {as : Array α} {x i} (h : i < (as.modify x f).size) :
· simp only [Id.bind_eq, get_set _ _ _ (by simpa using h)]; split <;> simp [*]
· rw [if_neg (mt (by rintro rfl; exact h) (by simp_all))]
@[simp] theorem toList_modify (as : Array α) (f : α α) :
(as.modify x f).toList = as.toList.modify f x := by
apply List.ext_getElem
· simp
· simp [getElem_modify, List.getElem_modify]
theorem getElem_modify_self {as : Array α} {i : Nat} (f : α α) (h : i < (as.modify i f).size) :
(as.modify i f)[i] = f (as[i]'(by simpa using h)) := by
simp [getElem_modify h]
@@ -867,10 +945,11 @@ 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]
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
@[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]
/-! ### filter -/
@@ -885,6 +964,9 @@ theorem getElem?_modify {as : Array α} {i : Nat} {f : αα} {j : Nat} :
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'
@@ -918,6 +1000,9 @@ 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]
@@ -933,7 +1018,10 @@ theorem filterMap_congr {as bs : Array α} (h : as = bs)
theorem size_empty : (#[] : Array α).size = 0 := rfl
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
theorem toList_empty : (#[] : Array α).toList = [] := rfl
@[deprecated toList_empty (since := "2024-09-09")]
abbrev empty_data := @toList_empty
/-! ### append -/
@@ -957,6 +1045,9 @@ 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
@@ -965,6 +1056,9 @@ 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]
@@ -1091,7 +1185,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₂, getElem_push_eq]
rw [getElem_extract_loop_lt as (bs.push as[start]) size (start+1) h₁ h₂, get_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
@@ -1118,14 +1212,6 @@ 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]
@@ -1215,6 +1301,9 @@ 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 α) :
@@ -1254,6 +1343,9 @@ 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]
@@ -1295,7 +1387,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
@@ -1305,7 +1397,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
@@ -1323,8 +1415,33 @@ 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
@@ -1440,11 +1557,6 @@ theorem all_toArray (p : α → Bool) (l : List α) : l.toArray.all p = l.all p
apply ext'
simp
@[simp] theorem modify_toArray (f : α α) (l : List α) :
l.toArray.modify i f = (l.modify f i).toArray := by
apply ext'
simp
@[simp] theorem filter_toArray' (p : α Bool) (l : List α) (h : stop = l.toArray.size) :
l.toArray.filter p 0 stop = (l.filter p).toArray := by
subst h
@@ -1473,164 +1585,4 @@ 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

View File

@@ -1,92 +0,0 @@
/-
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

View File

@@ -8,13 +8,12 @@ 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 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 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 many of the bitvector operations from the
[`QF_BV` logic](https://smtlib.cs.uiowa.edu/logics-all.shtml#QF_BV).
@@ -23,12 +22,60 @@ 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
@@ -191,6 +238,22 @@ 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`.
@@ -324,6 +387,10 @@ 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.
@@ -331,6 +398,10 @@ 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.

View File

@@ -1,52 +0,0 @@
/-
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

View File

@@ -267,21 +267,6 @@ 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)]
@@ -307,26 +292,6 @@ 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) :

View File

@@ -286,19 +286,6 @@ theorem getLsbD_ofNat (n : Nat) (x : Nat) (i : Nat) :
@[simp] theorem getMsbD_zero : (0#w).getMsbD i = false := by simp [getMsbD]
@[simp] theorem getLsbD_one : (1#w).getLsbD i = (decide (0 < w) && decide (i = 0)) := by
simp only [getLsbD, toNat_ofNat, Nat.testBit_mod_two_pow]
by_cases h : i = 0
<;> simp [h, Nat.testBit_to_div_mod, Nat.div_eq_of_lt]
@[simp] theorem getElem_one (h : i < w) : (1#w)[i] = decide (i = 0) := by
simp [ getLsbD_eq_getElem, getLsbD_one, h, show 0 < w by omega]
/-- The msb at index `w-1` is the least significant bit, and is true when the width is nonzero. -/
@[simp] theorem getMsbD_one : (1#w).getMsbD i = (decide (i = w - 1) && decide (0 < w)) := by
simp only [getMsbD]
by_cases h : 0 < w <;> by_cases h' : i = w - 1 <;> simp [h, h'] <;> omega
@[simp] theorem toNat_mod_cancel (x : BitVec n) : x.toNat % (2^n) = x.toNat :=
Nat.mod_eq_of_lt x.isLt
@@ -316,12 +303,6 @@ theorem getLsbD_ofNat (n : Nat) (x : Nat) (i : Nat) :
simp [Nat.sub_sub_eq_min, Nat.min_eq_right]
omega
@[simp] theorem sub_add_bmod_cancel {x y : BitVec w} :
((((2 ^ w : Nat) - y.toNat) : Int) + x.toNat).bmod (2 ^ w) =
((x.toNat : Int) - y.toNat).bmod (2 ^ w) := by
rw [Int.sub_eq_add_neg, Int.add_assoc, Int.add_comm, Int.bmod_add_cancel, Int.add_comm,
Int.sub_eq_add_neg]
private theorem lt_two_pow_of_le {x m n : Nat} (lt : x < 2 ^ m) (le : m n) : x < 2 ^ n :=
Nat.lt_of_lt_of_le lt (Nat.pow_le_pow_of_le_right (by trivial : 0 < 2) le)
@@ -366,10 +347,6 @@ theorem getElem_ofBool {b : Bool} {i : Nat} : (ofBool b)[0] = b := by
@[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsbD]
@[simp] theorem msb_one : (1#w).msb = decide (w = 1) := by
simp [BitVec.msb, getMsbD_one, Bool.decide_and]
omega
theorem msb_eq_getLsbD_last (x : BitVec w) :
x.msb = x.getLsbD (w - 1) := by
simp only [BitVec.msb, getMsbD]
@@ -1980,10 +1957,6 @@ theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n ((2^n - y.toNat) + x.toN
@[simp] theorem toNat_sub {n} (x y : BitVec n) :
(x - y).toNat = (((2^n - y.toNat) + x.toNat) % 2^n) := rfl
@[simp, bv_toNat] theorem toInt_sub {x y : BitVec w} :
(x - y).toInt = (x.toInt - y.toInt).bmod (2 ^ w) := by
simp [toInt_eq_toNat_bmod, @Int.ofNat_sub y.toNat (2 ^ w) (by omega)]
-- We prefer this lemma to `toNat_sub` for the `bv_toNat` simp set.
-- For reasons we don't yet understand, unfolding via `toNat_sub` sometimes
-- results in `omega` generating proof terms that are very slow in the kernel.
@@ -2006,8 +1979,6 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
@[simp] protected theorem sub_zero (x : BitVec n) : x - 0#n = x := by apply eq_of_toNat_eq ; simp
@[simp] protected theorem zero_sub (x : BitVec n) : 0#n - x = -x := rfl
@[simp] protected theorem sub_self (x : BitVec n) : x - x = 0#n := by
apply eq_of_toNat_eq
simp only [toNat_sub]
@@ -2020,8 +1991,18 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
theorem toInt_neg {x : BitVec w} :
(-x).toInt = (-x.toInt).bmod (2 ^ w) := by
rw [ BitVec.zero_sub, toInt_sub]
simp [BitVec.toInt_ofNat]
simp only [toInt_eq_toNat_bmod, toNat_neg, Int.ofNat_emod, Int.emod_bmod_congr]
rw [ Int.subNatNat_of_le (by omega), Int.subNatNat_eq_coe, Int.sub_eq_add_neg, Int.add_comm,
Int.bmod_add_cancel]
by_cases h : x.toNat < ((2 ^ w) + 1) / 2
· rw [Int.bmod_pos (x := x.toNat)]
all_goals simp only [toNat_mod_cancel']
norm_cast
· rw [Int.bmod_neg (x := x.toNat)]
· simp only [toNat_mod_cancel']
rw_mod_cast [Int.neg_sub, Int.sub_eq_add_neg, Int.add_comm, Int.bmod_add_cancel]
· norm_cast
simp_all
@[simp] theorem toFin_neg (x : BitVec n) :
(-x).toFin = Fin.ofNat' (2^n) (2^n - x.toNat) :=
@@ -2092,11 +2073,6 @@ theorem sub_eq_xor {a b : BitVec 1} : a - b = a ^^^ b := by
have hb : b = 0 b = 1 := eq_zero_or_eq_one _
rcases ha with h | h <;> (rcases hb with h' | h' <;> (simp [h, h']))
@[simp]
theorem sub_eq_self {x : BitVec 1} : -x = x := by
have ha : x = 0 x = 1 := eq_zero_or_eq_one _
rcases ha with h | h <;> simp [h]
theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
rcases w with _ | w
· apply Subsingleton.elim
@@ -2365,24 +2341,6 @@ theorem toNat_sdiv {x y : BitVec w} : (x.sdiv y).toNat =
simp only [sdiv_eq, toNat_udiv]
by_cases h : x.msb <;> by_cases h' : y.msb <;> simp [h, h']
@[simp]
theorem zero_sdiv {x : BitVec w} : (0#w).sdiv x = 0#w := by
simp only [sdiv_eq]
rcases x.msb with msb | msb <;> simp
@[simp]
theorem sdiv_zero {x : BitVec n} : x.sdiv 0#n = 0#n := by
simp only [sdiv_eq, msb_zero]
rcases x.msb with msb | msb <;> apply eq_of_toNat_eq <;> simp
@[simp]
theorem sdiv_one {x : BitVec w} : x.sdiv 1#w = x := by
simp only [sdiv_eq]
· by_cases h : w = 1
· subst h
rcases x.msb with msb | msb <;> simp
· rcases x.msb with msb | msb <;> simp [h]
theorem sdiv_eq_and (x y : BitVec 1) : x.sdiv y = x &&& y := by
have hx : x = 0#1 x = 1#1 := by bv_omega
have hy : y = 0#1 y = 1#1 := by bv_omega
@@ -2391,13 +2349,9 @@ theorem sdiv_eq_and (x y : BitVec 1) : x.sdiv y = x &&& y := by
rfl
@[simp]
theorem sdiv_self {x : BitVec w} :
x.sdiv x = if x == 0#w then 0#w else 1#w := by
simp [sdiv_eq]
· by_cases h : w = 1
· subst h
rcases x.msb with msb | msb <;> simp
· rcases x.msb with msb | msb <;> simp [h]
theorem sdiv_zero {x : BitVec n} : x.sdiv 0#n = 0#n := by
simp only [sdiv_eq, msb_zero]
rcases x.msb with msb | msb <;> apply eq_of_toNat_eq <;> simp
/-! ### smod -/
@@ -2699,6 +2653,14 @@ theorem twoPow_zero {w : Nat} : twoPow w 0 = 1#w := by
apply eq_of_toNat_eq
simp
@[simp]
theorem getLsbD_one {w i : Nat} : (1#w).getLsbD i = (decide (0 < w) && decide (0 = i)) := by
rw [ twoPow_zero, getLsbD_twoPow]
@[simp]
theorem getElem_one {w i : Nat} (h : i < w) : (1#w)[i] = decide (i = 0) := by
rw [ twoPow_zero, getElem_twoPow]
theorem shiftLeft_eq_mul_twoPow (x : BitVec w) (n : Nat) :
x <<< n = x * (BitVec.twoPow w n) := by
ext i
@@ -2718,6 +2680,7 @@ theorem shiftLeft_eq_mul_twoPow (x : BitVec w) (n : Nat) :
@[simp] theorem zero_concat_true : concat 0#w true = 1#(w + 1) := by
ext
simp [getLsbD_concat]
omega
/- ### setWidth, setWidth, and bitwise operations -/
@@ -2758,7 +2721,7 @@ theorem and_one_eq_setWidth_ofBool_getLsbD {x : BitVec w} :
ext i
simp only [getLsbD_and, getLsbD_one, getLsbD_setWidth, Fin.is_lt, decide_True, getLsbD_ofBool,
Bool.true_and]
by_cases h : ((i : Nat) = 0) <;> simp [h] <;> omega
by_cases h : (0 = (i : Nat)) <;> simp [h] <;> omega
@[simp]
theorem replicate_zero_eq {x : BitVec w} : x.replicate 0 = 0#0 := by

View File

@@ -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.BasicAux
import Init.Data.UInt.Basic
/-- Determines if the given integer is a valid [Unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value).
@@ -42,10 +42,8 @@ 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 (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₂
| Or.inl h => Or.inl h
| Or.inr h₁, h₂ => Or.inr h₁, h
theorem isValidChar_zero : isValidChar 0 :=
Or.inl (by decide)
@@ -59,7 +57,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.toBitVec.isLt (by decide))
def ofUInt8 (n : UInt8) : Char := n.toUInt32, .inl (Nat.lt_trans n.1.2 (by decide))
instance : Inhabited Char where
default := 'A'

View File

@@ -51,9 +51,6 @@ 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)

View File

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

View File

@@ -38,7 +38,7 @@ The operations are organized as follow:
* Sublists: `take`, `drop`, `takeWhile`, `dropWhile`, `partition`, `dropLast`,
`isPrefixOf`, `isPrefixOf?`, `isSuffixOf`, `isSuffixOf?`, `Subset`, `Sublist`,
`rotateLeft` and `rotateRight`.
* Manipulating elements: `replace`, `insert`, `modify`, `erase`, `eraseP`, `eraseIdx`.
* Manipulating elements: `replace`, `insert`, `erase`, `eraseP`, `eraseIdx`.
* Finding elements: `find?`, `findSome?`, `findIdx`, `indexOf`, `findIdx?`, `indexOf?`,
`countP`, `count`, and `lookup`.
* Logic: `any`, `all`, `or`, and `and`.
@@ -122,11 +122,6 @@ protected def beq [BEq α] : List α → List α → Bool
| a::as, b::bs => a == b && List.beq as bs
| _, _ => false
@[simp] theorem beq_nil_nil [BEq α] : List.beq ([] : List α) ([] : List α) = true := rfl
@[simp] theorem beq_cons_nil [BEq α] (a : α) (as : List α) : List.beq (a::as) [] = false := rfl
@[simp] theorem beq_nil_cons [BEq α] (a : α) (as : List α) : List.beq [] (a::as) = false := rfl
theorem beq_cons₂ [BEq α] (a b : α) (as bs : List α) : List.beq (a::as) (b::bs) = (a == b && List.beq as bs) := rfl
instance [BEq α] : BEq (List α) := List.beq
instance [BEq α] [LawfulBEq α] : LawfulBEq (List α) where
@@ -563,13 +558,10 @@ def flatten : List (List α) → List α
@[deprecated flatten (since := "2024-10-14"), inherit_doc flatten] abbrev join := @flatten
/-! ### singleton -/
/-! ### pure -/
/-- `singleton x = [x]`. -/
@[inline] protected def singleton {α : Type u} (a : α) : List α := [a]
set_option linter.missingDocs false in
@[deprecated singleton (since := "2024-10-16")] protected abbrev pure := @singleton
/-- `pure x = [x]` is the `pure` operation of the list monad. -/
@[inline] protected def pure {α : Type u} (a : α) : List α := [a]
/-! ### flatMap -/
@@ -1119,35 +1111,6 @@ theorem replace_cons [BEq α] {a : α} :
@[inline] protected def insert [BEq α] (a : α) (l : List α) : List α :=
if l.elem a then l else a :: l
/-! ### modify -/
/--
Apply a function to the nth tail of `l`. Returns the input without
using `f` if the index is larger than the length of the List.
```
modifyTailIdx f 2 [a, b, c] = [a, b] ++ f [c]
```
-/
@[simp] def modifyTailIdx (f : List α List α) : Nat List α List α
| 0, l => f l
| _+1, [] => []
| n+1, a :: l => a :: modifyTailIdx f n l
/-- Apply `f` to the head of the list, if it exists. -/
@[inline] def modifyHead (f : α α) : List α List α
| [] => []
| a :: l => f a :: l
@[simp] theorem modifyHead_nil (f : α α) : [].modifyHead f = [] := by rw [modifyHead]
@[simp] theorem modifyHead_cons (a : α) (l : List α) (f : α α) :
(a :: l).modifyHead f = f a :: l := by rw [modifyHead]
/--
Apply `f` to the nth element of the list, if it exists, replacing that element with the result.
-/
def modify (f : α α) : Nat List α List α :=
modifyTailIdx (modifyHead f)
/-! ### erase -/
/--
@@ -1442,25 +1405,12 @@ def unzip : List (α × β) → List α × List β
/-! ## Ranges and enumeration -/
/-- Sum of a list.
`List.sum [a, b, c] = a + (b + (c + 0))` -/
def sum {α} [Add α] [Zero α] : List α α :=
foldr (· + ·) 0
@[simp] theorem sum_nil [Add α] [Zero α] : ([] : List α).sum = 0 := rfl
@[simp] theorem sum_cons [Add α] [Zero α] {a : α} {l : List α} : (a::l).sum = a + l.sum := rfl
/-- Sum of a list of natural numbers. -/
@[deprecated List.sum (since := "2024-10-17")]
-- This is not in the `List` namespace as later `List.sum` will be defined polymorphically.
protected def _root_.Nat.sum (l : List Nat) : Nat := l.foldr (·+·) 0
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) :
@[simp] theorem _root_.Nat.sum_nil : Nat.sum ([] : List Nat) = 0 := rfl
@[simp] theorem _root_.Nat.sum_cons (a : Nat) (l : List Nat) :
Nat.sum (a::l) = a + Nat.sum l := rfl
/-! ### range -/

View File

@@ -232,8 +232,7 @@ 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 : Std.Antisymm (¬ · < · : α α Prop)]
{as bs : List α} (h₁ : as bs) (h₂ : bs as) : as = bs :=
theorem le_antisymm [LT α] [s : Antisymm (¬ · < · : α α Prop)] {as bs : List α} (h₁ : as bs) (h₂ : bs as) : as = bs :=
match as, bs with
| [], [] => rfl
| [], _::_ => False.elim <| h₂ (List.lt.nil ..)
@@ -249,8 +248,7 @@ theorem le_antisymm [LT α] [s : Std.Antisymm (¬ · < · : αα → Prop)]
have : a = b := s.antisymm hab hba
simp [this, ih]
instance [LT α] [Std.Antisymm (¬ · < · : α α Prop)] :
Std.Antisymm (· · : List α List α Prop) where
instance [LT α] [Antisymm (¬ · < · : α α Prop)] : Antisymm (· · : List α List α Prop) where
antisymm h₁ h₂ := le_antisymm h₁ h₂
end List

View File

@@ -156,7 +156,7 @@ theorem countP_filterMap (p : β → Bool) (f : α → Option β) (l : List α)
simp (config := { contextual := true }) [Option.getD_eq_iff, Option.isSome_eq_isSome]
@[simp] theorem countP_flatten (l : List (List α)) :
countP p l.flatten = (l.map (countP p)).sum := by
countP p l.flatten = Nat.sum (l.map (countP p)) := by
simp only [countP_eq_length_filter, filter_flatten]
simp [countP_eq_length_filter']
@@ -232,7 +232,7 @@ theorem count_singleton (a b : α) : count a [b] = if b == a then 1 else 0 := by
@[simp] theorem count_append (a : α) : l₁ l₂, count a (l₁ ++ l₂) = count a l₁ + count a l₂ :=
countP_append _
theorem count_flatten (a : α) (l : List (List α)) : count a l.flatten = (l.map (count a)).sum := by
theorem count_flatten (a : α) (l : List (List α)) : count a l.flatten = Nat.sum (l.map (count a)) := by
simp only [count_eq_countP, countP_flatten, count_eq_countP']
@[deprecated count_flatten (since := "2024-10-14")] abbrev count_join := @count_flatten

View File

@@ -793,7 +793,7 @@ theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p
theorem findIdx?_flatten {l : List (List α)} {p : α Bool} :
l.flatten.findIdx? p =
(l.findIdx? (·.any p)).map
fun i => ((l.take i).map List.length).sum +
fun i => Nat.sum ((l.take i).map List.length) +
(l[i]?.map fun xs => xs.findIdx p).getD 0 := by
induction l with
| nil => simp

View File

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

View File

@@ -1047,6 +1047,9 @@ 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
@@ -1080,21 +1083,6 @@ 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 -/
@@ -2082,7 +2070,8 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∃ L b, l = concat L b
/-! ### flatten -/
@[simp] theorem length_flatten (L : List (List α)) : (flatten L).length = (L.map length).sum := by
@[simp] theorem length_flatten (L : List (List α)) : (flatten L).length = Nat.sum (L.map length) := by
induction L with
| nil => rfl
| cons =>

View File

@@ -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 : Std.Antisymm ((· : α) ·)]
theorem min?_eq_some_iff [Min α] [LE α] [anti : 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 : Std.Antisymm ((· : α) ·)]
theorem max?_eq_some_iff [Max α] [LE α] [anti : 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 α} :

View File

@@ -99,14 +99,4 @@ 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

View File

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

View File

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

View File

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

View File

@@ -20,6 +20,7 @@ open Nat
/-! ## Ranges and enumeration -/
/-! ### range' -/
theorem range'_succ (s n step) : range' s (n + 1) step = s :: range' (s + step) n step := by

View File

@@ -976,7 +976,7 @@ theorem mem_of_mem_drop {n} {l : List α} (h : a ∈ l.drop n) : a ∈ l :=
drop_subset _ _ h
theorem drop_suffix_drop_left (l : List α) {m n : Nat} (h : m n) : drop n l <:+ drop m l := by
rw [ Nat.sub_add_cancel h, Nat.add_comm, drop_drop]
rw [ Nat.sub_add_cancel h, drop_drop]
apply drop_suffix
-- See `Init.Data.List.Nat.TakeDrop` for `take_prefix_take_left`.

View File

@@ -97,14 +97,14 @@ theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l.
theorem getElem?_take_of_succ {l : List α} {n : Nat} : (l.take (n + 1))[n]? = l[n]? := by simp
@[simp] theorem drop_drop (n : Nat) : (m) (l : List α), drop n (drop m l) = drop (m + n) l
@[simp] theorem drop_drop (n : Nat) : (m) (l : List α), drop n (drop m l) = drop (n + m) l
| m, [] => by simp
| 0, l => by simp
| m + 1, a :: l =>
calc
drop n (drop (m + 1) (a :: l)) = drop n (drop m l) := rfl
_ = drop (m + n) l := drop_drop n m l
_ = drop ((m + 1) + n) (a :: l) := by rw [Nat.add_right_comm]; rfl
_ = drop (n + m) l := drop_drop n m l
_ = drop (n + (m + 1)) (a :: l) := rfl
theorem take_drop : (m n : Nat) (l : List α), take n (drop m l) = drop m (take (m + n) l)
| 0, _, _ => by simp
@@ -112,7 +112,7 @@ theorem take_drop : ∀ (m n : Nat) (l : List α), take n (drop m l) = drop m (t
| _+1, _, _ :: _ => by simpa [Nat.succ_add, take_succ_cons, drop_succ_cons] using take_drop ..
@[deprecated drop_drop (since := "2024-06-15")]
theorem drop_add (m n) (l : List α) : drop (m + n) l = drop n (drop m l) := by
theorem drop_add (m n) (l : List α) : drop (m + n) l = drop m (drop n l) := by
simp [drop_drop]
@[simp]
@@ -126,7 +126,7 @@ theorem tail_drop (l : List α) (n : Nat) : (l.drop n).tail = l.drop (n + 1) :=
@[simp]
theorem drop_tail (l : List α) (n : Nat) : l.tail.drop n = l.drop (n + 1) := by
rw [Nat.add_comm, drop_drop, drop_one]
rw [ drop_drop, drop_one]
@[simp]
theorem drop_eq_nil_iff {l : List α} {k : Nat} : l.drop k = [] l.length k := by

View File

@@ -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 := by simpa using h
eq_of_beq h := Nat.eq_of_beq_eq_true 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 : Std.Antisymm ( . . : Nat Nat Prop) where
instance : Antisymm ( . . : Nat Nat Prop) where
antisymm h₁ h₂ := Nat.le_antisymm h₁ h₂
instance : Std.Antisymm (¬ . < . : Nat Nat Prop) where
instance : 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,8 +796,6 @@ 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 _))

View File

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

View File

@@ -8,6 +8,8 @@ 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]

View File

@@ -10,10 +10,8 @@ import Init.Data.Nat.Log2
/-- For decimal and scientific numbers (e.g., `1.23`, `3.12e10`).
Examples:
- `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.
- `OfScientific.ofScientific 123 true 2` represents `1.23`
- `OfScientific.ofScientific 121 false 100` represents `121e100`
-/
class OfScientific (α : Type u) where
ofScientific (mantissa : Nat) (exponentSign : Bool) (decimalExponent : Nat) : α

View File

@@ -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 _ h => H _ (w h) := by
o₁.attachWith P H = o₂.attachWith P fun x 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 _ h => H _ (mem_map_of_mem f h))).map
(o.map f).attachWith P H = (o.attachWith (P f) (fun a 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 _ h => h) := by
o.attach.map f = o.pmap (fun a (h : a o) => f a, h) (fun a h => h) := by
cases o <;> simp
theorem map_attachWith {o : Option α} {P : α Prop} {H : (a : α), a o P a}

View File

@@ -7,8 +7,6 @@ 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
@@ -16,65 +14,9 @@ instance [BEq α] [BEq β] [LawfulBEq α] [LawfulBEq β] : LawfulBEq (α × β)
rfl {a} := by cases a; simp [BEq.beq, LawfulBEq.rfl]
@[simp]
protected theorem «forall» {p : α × β Prop} : ( x, p x) a b, p (a, b) :=
protected theorem Prod.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 «exists» {p : α × β Prop} : ( x, p x) a b, p (a, b) :=
protected theorem Prod.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

View File

@@ -7,7 +7,7 @@ prelude
import Init.Data.Format.Basic
import Init.Data.Int.Basic
import Init.Data.Nat.Div
import Init.Data.UInt.BasicAux
import Init.Data.UInt.Basic
import Init.Control.Id
open Sum Subtype Nat

View File

@@ -317,9 +317,6 @@ theorem _root_.Char.utf8Size_le_four (c : Char) : c.utf8Size ≤ 4 := by
@[simp] theorem pos_add_char (p : Pos) (c : Char) : (p + c).byteIdx = p.byteIdx + c.utf8Size := rfl
protected theorem Pos.ne_zero_of_lt : {a b : Pos} a < b b 0
| _, _, hlt, rfl => Nat.not_lt_zero _ hlt
theorem lt_next (s : String) (i : Pos) : i.1 < (s.next i).1 :=
Nat.add_lt_add_left (Char.utf8Size_pos _) _
@@ -1024,66 +1021,6 @@ instance hasBeq : BEq Substring := ⟨beq⟩
def sameAs (ss1 ss2 : Substring) : Bool :=
ss1.startPos == ss2.startPos && ss1 == ss2
/--
Returns the longest common prefix of two substrings.
The returned substring will use the same underlying string as `s`.
-/
def commonPrefix (s t : Substring) : Substring :=
{ s with stopPos := loop s.startPos t.startPos }
where
/-- Returns the ending position of the common prefix, working up from `spos, tpos`. -/
loop spos tpos :=
if h : spos < s.stopPos tpos < t.stopPos then
if s.str.get spos == t.str.get tpos then
have := Nat.sub_lt_sub_left h.1 (s.str.lt_next spos)
loop (s.str.next spos) (t.str.next tpos)
else
spos
else
spos
termination_by s.stopPos.byteIdx - spos.byteIdx
/--
Returns the longest common suffix of two substrings.
The returned substring will use the same underlying string as `s`.
-/
def commonSuffix (s t : Substring) : Substring :=
{ s with startPos := loop s.stopPos t.stopPos }
where
/-- Returns the starting position of the common prefix, working down from `spos, tpos`. -/
loop spos tpos :=
if h : s.startPos < spos t.startPos < tpos then
let spos' := s.str.prev spos
let tpos' := t.str.prev tpos
if s.str.get spos' == t.str.get tpos' then
have : spos' < spos := s.str.prev_lt_of_pos spos (String.Pos.ne_zero_of_lt h.1)
loop spos' tpos'
else
spos
else
spos
termination_by spos.byteIdx
/--
If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`.
-/
def dropPrefix? (s : Substring) (pre : Substring) : Option Substring :=
let t := s.commonPrefix pre
if t.bsize = pre.bsize then
some { s with startPos := t.stopPos }
else
none
/--
If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`.
-/
def dropSuffix? (s : Substring) (suff : Substring) : Option Substring :=
let t := s.commonSuffix suff
if t.bsize = suff.bsize then
some { s with stopPos := t.startPos }
else
none
end Substring
namespace String
@@ -1145,28 +1082,6 @@ namespace String
@[inline] def decapitalize (s : String) :=
s.set 0 <| s.get 0 |>.toLower
/--
If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`.
-/
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 : 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 : 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 : String) : String :=
s.dropSuffix? suff |>.map Substring.toString |>.getD s
end String
namespace Char

View File

@@ -5,7 +5,6 @@ Author: Leonardo de Moura
-/
prelude
import Init.Data.ByteArray
import Init.Data.UInt.Lemmas
namespace String
@@ -21,14 +20,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.toBitVec.isLt (by decide))
some c.toUInt32, .inl (Nat.lt_trans c.1.2 (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 (UInt32.toNat_lt_of_lt (by decide) h) else none
if h : r < 0xd800 then some r, .inl h else none
else if c &&& 0xf0 == 0xe0 then
let c1 a[i+1]?
let c2 a[i+2]?
@@ -39,14 +38,7 @@ 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
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
if h : r < 0xd800 0xdfff < r r < 0x110000 then some r, h else none
else if c &&& 0xf8 == 0xf0 then
let c1 a[i+1]?
let c2 a[i+2]?
@@ -58,7 +50,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) (UInt32.le_toNat_of_le (by decide) h.left), UInt32.toNat_lt_of_lt (by decide) h.right
some r, .inr Nat.lt_of_lt_of_le (by decide) h.1, h.2
else none
else
none

View File

@@ -4,5 +4,21 @@ 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.Data.Sum.Lemmas
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

View File

@@ -1,178 +0,0 @@
/-
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

View File

@@ -1,251 +0,0 @@
/-
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

View File

@@ -5,7 +5,7 @@ Author: Leonardo de Moura
-/
prelude
import Init.Data.String.Basic
import Init.Data.UInt.BasicAux
import Init.Data.UInt.Basic
import Init.Data.Nat.Div
import Init.Data.Repr
import Init.Data.Int.Basic

View File

@@ -4,7 +4,6 @@ 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

View File

@@ -4,50 +4,52 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.UInt.BasicAux
import Init.Data.BitVec.Basic
import Init.Data.Fin.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.toBitVec + b.toBitVec
def UInt8.add (a b : UInt8) : UInt8 := a.val + b.val
@[extern "lean_uint8_sub"]
def UInt8.sub (a b : UInt8) : UInt8 := a.toBitVec - b.toBitVec
def UInt8.sub (a b : UInt8) : UInt8 := a.val - b.val
@[extern "lean_uint8_mul"]
def UInt8.mul (a b : UInt8) : UInt8 := a.toBitVec * b.toBitVec
def UInt8.mul (a b : UInt8) : UInt8 := a.val * b.val
@[extern "lean_uint8_div"]
def UInt8.div (a b : UInt8) : UInt8 := BitVec.udiv a.toBitVec b.toBitVec
def UInt8.div (a b : UInt8) : UInt8 := a.val / b.val
@[extern "lean_uint8_mod"]
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.mod (a b : UInt8) : UInt8 := a.val % b.val
@[extern "lean_uint8_modn"]
def UInt8.modn (a : UInt8) (n : @& Nat) : UInt8 := Fin.modn a.val n
@[extern "lean_uint8_land"]
def UInt8.land (a b : UInt8) : UInt8 := a.toBitVec &&& b.toBitVec
def UInt8.land (a b : UInt8) : UInt8 := Fin.land a.val b.val
@[extern "lean_uint8_lor"]
def UInt8.lor (a b : UInt8) : UInt8 := a.toBitVec ||| b.toBitVec
def UInt8.lor (a b : UInt8) : UInt8 := Fin.lor a.val b.val
@[extern "lean_uint8_xor"]
def UInt8.xor (a b : UInt8) : UInt8 := a.toBitVec ^^^ b.toBitVec
def UInt8.xor (a b : UInt8) : UInt8 := Fin.xor a.val b.val
@[extern "lean_uint8_shift_left"]
def UInt8.shiftLeft (a b : UInt8) : UInt8 := a.toBitVec <<< (mod b 8).toBitVec
def UInt8.shiftLeft (a b : UInt8) : UInt8 := a.val <<< (modn b 8).val
@[extern "lean_uint8_shift_right"]
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
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
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 := ~~~a.toBitVec
def UInt8.complement (a:UInt8) : UInt8 := 0-(a+1)
instance : Complement UInt8 := UInt8.complement
instance : AndOp UInt8 := UInt8.land
@@ -56,58 +58,69 @@ 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) :=
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
match a, b with
| n, m => inferInstanceAs (Decidable (n < m))
set_option bootstrap.genMatcherCode false in
@[extern "lean_uint8_dec_le"]
def UInt8.decLe (a b : UInt8) : Decidable (a b) :=
inferInstanceAs (Decidable (a.toBitVec b.toBitVec))
match a, b with
| n, m => inferInstanceAs (Decidable (n <= m))
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.toBitVec + b.toBitVec
def UInt16.add (a b : UInt16) : UInt16 := a.val + b.val
@[extern "lean_uint16_sub"]
def UInt16.sub (a b : UInt16) : UInt16 := a.toBitVec - b.toBitVec
def UInt16.sub (a b : UInt16) : UInt16 := a.val - b.val
@[extern "lean_uint16_mul"]
def UInt16.mul (a b : UInt16) : UInt16 := a.toBitVec * b.toBitVec
def UInt16.mul (a b : UInt16) : UInt16 := a.val * b.val
@[extern "lean_uint16_div"]
def UInt16.div (a b : UInt16) : UInt16 := BitVec.udiv a.toBitVec b.toBitVec
def UInt16.div (a b : UInt16) : UInt16 := a.val / b.val
@[extern "lean_uint16_mod"]
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.mod (a b : UInt16) : UInt16 := a.val % b.val
@[extern "lean_uint16_modn"]
def UInt16.modn (a : UInt16) (n : @& Nat) : UInt16 := Fin.modn a.val n
@[extern "lean_uint16_land"]
def UInt16.land (a b : UInt16) : UInt16 := a.toBitVec &&& b.toBitVec
def UInt16.land (a b : UInt16) : UInt16 := Fin.land a.val b.val
@[extern "lean_uint16_lor"]
def UInt16.lor (a b : UInt16) : UInt16 := a.toBitVec ||| b.toBitVec
def UInt16.lor (a b : UInt16) : UInt16 := Fin.lor a.val b.val
@[extern "lean_uint16_xor"]
def UInt16.xor (a b : UInt16) : UInt16 := a.toBitVec ^^^ b.toBitVec
def UInt16.xor (a b : UInt16) : UInt16 := Fin.xor a.val b.val
@[extern "lean_uint16_shift_left"]
def UInt16.shiftLeft (a b : UInt16) : UInt16 := a.toBitVec <<< (mod b 16).toBitVec
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)
@[extern "lean_uint16_shift_right"]
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
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
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 := ~~~a.toBitVec
def UInt16.complement (a:UInt16) : UInt16 := 0-(a+1)
instance : Complement UInt16 := UInt16.complement
instance : AndOp UInt16 := UInt16.land
@@ -119,53 +132,74 @@ 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) :=
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
match a, b with
| n, m => inferInstanceAs (Decidable (n < m))
set_option bootstrap.genMatcherCode false in
@[extern "lean_uint16_dec_le"]
def UInt16.decLe (a b : UInt16) : Decidable (a b) :=
inferInstanceAs (Decidable (a.toBitVec b.toBitVec))
match a, b with
| n, m => inferInstanceAs (Decidable (n <= m))
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.toBitVec + b.toBitVec
def UInt32.add (a b : UInt32) : UInt32 := a.val + b.val
@[extern "lean_uint32_sub"]
def UInt32.sub (a b : UInt32) : UInt32 := a.toBitVec - b.toBitVec
def UInt32.sub (a b : UInt32) : UInt32 := a.val - b.val
@[extern "lean_uint32_mul"]
def UInt32.mul (a b : UInt32) : UInt32 := a.toBitVec * b.toBitVec
def UInt32.mul (a b : UInt32) : UInt32 := a.val * b.val
@[extern "lean_uint32_div"]
def UInt32.div (a b : UInt32) : UInt32 := BitVec.udiv a.toBitVec b.toBitVec
def UInt32.div (a b : UInt32) : UInt32 := a.val / b.val
@[extern "lean_uint32_mod"]
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.mod (a b : UInt32) : UInt32 := a.val % b.val
@[extern "lean_uint32_modn"]
def UInt32.modn (a : UInt32) (n : @& Nat) : UInt32 := Fin.modn a.val n
@[extern "lean_uint32_land"]
def UInt32.land (a b : UInt32) : UInt32 := a.toBitVec &&& b.toBitVec
def UInt32.land (a b : UInt32) : UInt32 := Fin.land a.val b.val
@[extern "lean_uint32_lor"]
def UInt32.lor (a b : UInt32) : UInt32 := a.toBitVec ||| b.toBitVec
def UInt32.lor (a b : UInt32) : UInt32 := Fin.lor a.val b.val
@[extern "lean_uint32_xor"]
def UInt32.xor (a b : UInt32) : UInt32 := a.toBitVec ^^^ b.toBitVec
def UInt32.xor (a b : UInt32) : UInt32 := Fin.xor a.val b.val
@[extern "lean_uint32_shift_left"]
def UInt32.shiftLeft (a b : UInt32) : UInt32 := a.toBitVec <<< (mod b 32).toBitVec
def UInt32.shiftLeft (a b : UInt32) : UInt32 := a.val <<< (modn b 32).val
@[extern "lean_uint32_shift_right"]
def UInt32.shiftRight (a b : UInt32) : UInt32 := a.toBitVec >>> (mod b 32).toBitVec
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)
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 := ~~~a.toBitVec
def UInt32.complement (a:UInt32) : UInt32 := 0-(a+1)
instance : Complement UInt32 := UInt32.complement
instance : AndOp UInt32 := UInt32.land
@@ -174,45 +208,60 @@ 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.toBitVec + b.toBitVec
def UInt64.add (a b : UInt64) : UInt64 := a.val + b.val
@[extern "lean_uint64_sub"]
def UInt64.sub (a b : UInt64) : UInt64 := a.toBitVec - b.toBitVec
def UInt64.sub (a b : UInt64) : UInt64 := a.val - b.val
@[extern "lean_uint64_mul"]
def UInt64.mul (a b : UInt64) : UInt64 := a.toBitVec * b.toBitVec
def UInt64.mul (a b : UInt64) : UInt64 := a.val * b.val
@[extern "lean_uint64_div"]
def UInt64.div (a b : UInt64) : UInt64 := BitVec.udiv a.toBitVec b.toBitVec
def UInt64.div (a b : UInt64) : UInt64 := a.val / b.val
@[extern "lean_uint64_mod"]
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.mod (a b : UInt64) : UInt64 := a.val % b.val
@[extern "lean_uint64_modn"]
def UInt64.modn (a : UInt64) (n : @& Nat) : UInt64 := Fin.modn a.val n
@[extern "lean_uint64_land"]
def UInt64.land (a b : UInt64) : UInt64 := a.toBitVec &&& b.toBitVec
def UInt64.land (a b : UInt64) : UInt64 := Fin.land a.val b.val
@[extern "lean_uint64_lor"]
def UInt64.lor (a b : UInt64) : UInt64 := a.toBitVec ||| b.toBitVec
def UInt64.lor (a b : UInt64) : UInt64 := Fin.lor a.val b.val
@[extern "lean_uint64_xor"]
def UInt64.xor (a b : UInt64) : UInt64 := a.toBitVec ^^^ b.toBitVec
def UInt64.xor (a b : UInt64) : UInt64 := Fin.xor a.val b.val
@[extern "lean_uint64_shift_left"]
def UInt64.shiftLeft (a b : UInt64) : UInt64 := a.toBitVec <<< (mod b 64).toBitVec
def UInt64.shiftLeft (a b : UInt64) : UInt64 := a.val <<< (modn b 64).val
@[extern "lean_uint64_shift_right"]
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
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)
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 := ~~~a.toBitVec
def UInt64.complement (a:UInt64) : UInt64 := 0-(a+1)
instance : Complement UInt64 := UInt64.complement
instance : AndOp UInt64 := UInt64.land
@@ -224,52 +273,79 @@ 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) :=
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
match a, b with
| n, m => inferInstanceAs (Decidable (n < m))
set_option bootstrap.genMatcherCode false in
@[extern "lean_uint64_dec_le"]
def UInt64.decLe (a b : UInt64) : Decidable (a b) :=
inferInstanceAs (Decidable (a.toBitVec b.toBitVec))
match a, b with
| n, m => inferInstanceAs (Decidable (n <= m))
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.toBitVec * b.toBitVec
def USize.mul (a b : USize) : USize := a.val * b.val
@[extern "lean_usize_div"]
def USize.div (a b : USize) : USize := a.toBitVec / b.toBitVec
def USize.div (a b : USize) : USize := a.val / b.val
@[extern "lean_usize_mod"]
def USize.mod (a b : USize) : USize := a.toBitVec % b.toBitVec
@[extern "lean_usize_modn", deprecated USize.mod (since := "2024-09-23")]
def USize.mod (a b : USize) : USize := a.val % b.val
@[extern "lean_usize_modn"]
def USize.modn (a : USize) (n : @& Nat) : USize := Fin.modn a.val n
@[extern "lean_usize_land"]
def USize.land (a b : USize) : USize := a.toBitVec &&& b.toBitVec
def USize.land (a b : USize) : USize := Fin.land a.val b.val
@[extern "lean_usize_lor"]
def USize.lor (a b : USize) : USize := a.toBitVec ||| b.toBitVec
def USize.lor (a b : USize) : USize := Fin.lor a.val b.val
@[extern "lean_usize_xor"]
def USize.xor (a b : USize) : USize := a.toBitVec ^^^ b.toBitVec
def USize.xor (a b : USize) : USize := Fin.xor a.val b.val
@[extern "lean_usize_shift_left"]
def USize.shiftLeft (a b : USize) : USize := a.toBitVec <<< (mod b (USize.ofNat System.Platform.numBits)).toBitVec
def USize.shiftLeft (a b : USize) : USize := a.val <<< (modn b System.Platform.numBits).val
@[extern "lean_usize_shift_right"]
def USize.shiftRight (a b : USize) : USize := a.toBitVec >>> (mod b (USize.ofNat System.Platform.numBits)).toBitVec
def USize.shiftRight (a b : USize) : USize := a.val >>> (modn b System.Platform.numBits).val
@[extern "lean_uint32_to_usize"]
def UInt32.toUSize (a : UInt32) : USize := USize.ofNat32 a.toBitVec.toNat a.toBitVec.isLt
def UInt32.toUSize (a : UInt32) : USize := USize.ofNat32 a.val a.1.2
@[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 := ~~~a.toBitVec
def USize.complement (a:USize) : USize := 0-(a+1)
instance : Complement USize := USize.complement
instance : AndOp USize := USize.land
@@ -278,5 +354,19 @@ 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

View File

@@ -1,132 +0,0 @@
/-
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

View File

@@ -6,14 +6,13 @@ 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 := BitVec.toNat_and ..
@[simp] protected theorem and_toNat (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := Fin.and_val ..
end $typeName
)

View File

@@ -6,8 +6,6 @@ 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 =>
@@ -19,111 +17,50 @@ 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.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
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
@[simp] theorem mk_toBitVec_eq : (a : $typeName), mk a.toBitVec = a
@[simp] theorem mk_val_eq : (a : $typeName), mk a.val = a
| _, _ => rfl
theorem toBitVec_eq_of_lt {a : Nat} : a < size (ofNat a).toBitVec.toNat = a :=
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, 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]
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
@[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 := 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
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)
@[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 := 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
@[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)
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
)
@@ -133,34 +70,27 @@ 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

View File

@@ -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

View File

@@ -224,7 +224,11 @@ structure Config where
-/
index : Bool := true
/--
This option does not have any effect (yet).
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.
-/
implicitDefEqProofs : Bool := true
deriving Inhabited, BEq

View File

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

View File

@@ -1592,6 +1592,9 @@ 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
@@ -1866,52 +1869,6 @@ 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
@@ -1920,12 +1877,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 `BitVec 8`.
/-- Unpack a `UInt8` as a `Nat` less than `2^8`.
This function is overridden with a native implementation. -/
toBitVec : BitVec 8
val : Fin UInt8.size
attribute [extern "lean_uint8_of_nat_mk"] UInt8.mk
attribute [extern "lean_uint8_to_nat"] UInt8.toBitVec
attribute [extern "lean_uint8_to_nat"] UInt8.val
/--
Pack a `Nat` less than `2^8` into a `UInt8`.
@@ -1933,7 +1890,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
toBitVec := BitVec.ofNatLt n h
val := { val := n, isLt := h }
set_option bootstrap.genMatcherCode false in
/--
@@ -1944,9 +1901,7 @@ 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
@@ -1961,12 +1916,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 `BitVec 16`.
/-- Unpack a `UInt16` as a `Nat` less than `2^16`.
This function is overridden with a native implementation. -/
toBitVec : BitVec 16
val : Fin UInt16.size
attribute [extern "lean_uint16_of_nat_mk"] UInt16.mk
attribute [extern "lean_uint16_to_nat"] UInt16.toBitVec
attribute [extern "lean_uint16_to_nat"] UInt16.val
/--
Pack a `Nat` less than `2^16` into a `UInt16`.
@@ -1974,7 +1929,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
toBitVec := BitVec.ofNatLt n h
val := { val := n, isLt := h }
set_option bootstrap.genMatcherCode false in
/--
@@ -1985,9 +1940,7 @@ 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
@@ -2002,12 +1955,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 `BitVec 32.
/-- Unpack a `UInt32` as a `Nat` less than `2^32`.
This function is overridden with a native implementation. -/
toBitVec : BitVec 32
val : Fin UInt32.size
attribute [extern "lean_uint32_of_nat_mk"] UInt32.mk
attribute [extern "lean_uint32_to_nat"] UInt32.toBitVec
attribute [extern "lean_uint32_to_nat"] UInt32.val
/--
Pack a `Nat` less than `2^32` into a `UInt32`.
@@ -2015,14 +1968,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
toBitVec := BitVec.ofNatLt n h
val := { val := n, isLt := 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.toBitVec.toNat
def UInt32.toNat (n : UInt32) : Nat := n.val.val
set_option bootstrap.genMatcherCode false in
/--
@@ -2041,26 +1994,30 @@ instance : Inhabited UInt32 where
default := UInt32.ofNatCore 0 (by decide)
instance : LT UInt32 where
lt a b := LT.lt a.toBitVec b.toBitVec
lt a b := LT.lt a.val b.val
instance : LE UInt32 where
le a b := LE.le a.toBitVec b.toBitVec
le a b := LE.le a.val b.val
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) :=
inferInstanceAs (Decidable (LT.lt a.toBitVec b.toBitVec))
match a, b with
| n, m => inferInstanceAs (Decidable (LT.lt n m))
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) :=
inferInstanceAs (Decidable (LE.le a.toBitVec b.toBitVec))
match a, b with
| n, m => inferInstanceAs (Decidable (LE.le n m))
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
@@ -2074,12 +2031,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 `BitVec 64`.
/-- Unpack a `UInt64` as a `Nat` less than `2^64`.
This function is overridden with a native implementation. -/
toBitVec: BitVec 64
val : Fin UInt64.size
attribute [extern "lean_uint64_of_nat_mk"] UInt64.mk
attribute [extern "lean_uint64_to_nat"] UInt64.toBitVec
attribute [extern "lean_uint64_to_nat"] UInt64.val
/--
Pack a `Nat` less than `2^64` into a `UInt64`.
@@ -2087,7 +2044,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
toBitVec := BitVec.ofNatLt n h
val := { val := n, isLt := h }
set_option bootstrap.genMatcherCode false in
/--
@@ -2098,20 +2055,36 @@ 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`. -/
abbrev USize.size : Nat := (hPow 2 System.Platform.numBits)
/--
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
theorem usize_size_eq : Or (Eq USize.size 4294967296) (Eq USize.size 18446744073709551616) :=
show Or (Eq (hPow 2 System.Platform.numBits) 4294967296) (Eq (hPow 2 System.Platform.numBits) 18446744073709551616) from
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
match System.Platform.numBits, System.Platform.numBits_eq with
| _, Or.inl rfl => Or.inl (by decide)
| _, Or.inr rfl => Or.inr (by decide)
@@ -2124,20 +2097,21 @@ 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 `BitVec System.Platform.numBits`.
/-- Unpack a `USize` as a `Nat` less than `USize.size`.
This function is overridden with a native implementation. -/
toBitVec : BitVec System.Platform.numBits
val : Fin USize.size
attribute [extern "lean_usize_of_nat_mk"] USize.mk
attribute [extern "lean_usize_to_nat"] USize.toBitVec
attribute [extern "lean_usize_to_nat"] USize.val
/--
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 where
toBitVec := BitVec.ofNatLt n h
def USize.ofNatCore (n : @& Nat) (h : LT.lt n USize.size) : USize := {
val := { val := n, isLt := h }
}
set_option bootstrap.genMatcherCode false in
/--
@@ -2148,9 +2122,7 @@ 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
@@ -2166,12 +2138,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
toBitVec :=
BitVec.ofNatLt n (
match System.Platform.numBits, System.Platform.numBits_eq with
val := {
val := n
isLt := match USize.size, usize_size_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
@@ -2206,7 +2178,7 @@ This function is overridden with a native implementation.
-/
@[extern "lean_uint32_of_nat"]
def Char.ofNatAux (n : @& Nat) (h : n.isValidChar) : Char :=
{ val := BitVec.ofNatLt n (isValidChar_UInt32 h), valid := h }
{ val := { val := n, isLt := isValidChar_UInt32 h }, valid := h }
/--
Convert a `Nat` into a `Char`. If the `Nat` does not encode a valid unicode scalar value,
@@ -2216,7 +2188,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 := BitVec.ofNatLt 0 (by decide), valid := Or.inl (by decide) })
(fun _ => { val := { val := 0, isLt := 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
@@ -3476,13 +3448,15 @@ This function is overridden with a native implementation.
-/
@[extern "lean_usize_to_uint64"]
def USize.toUInt64 (u : USize) : UInt64 where
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
)
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
}
/-- An opaque hash mixing operation, used to implement hashing for tuples. -/
@[extern "lean_uint64_mix_hash"]

View File

@@ -135,10 +135,6 @@ 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 -/
@@ -388,17 +384,6 @@ 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 :=

View File

@@ -67,7 +67,6 @@ 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

View File

@@ -11,25 +11,22 @@ 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 BitVec.sizeOf (a : BitVec w) : sizeOf a = sizeOf a.toFin + 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 UInt8.sizeOf (a : UInt8) : sizeOf a = a.toNat + 3 := by
cases a; simp_arith [UInt8.toNat, BitVec.toNat]
@[simp] protected theorem UInt16.sizeOf (a : UInt16) : sizeOf a = a.toNat + 2 := by
cases a; simp_arith [UInt16.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 UInt32.sizeOf (a : UInt32) : sizeOf a = a.toNat + 2 := by
cases a; simp_arith [UInt32.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 UInt64.sizeOf (a : UInt64) : sizeOf a = a.toNat + 2 := by
cases a; simp_arith [UInt64.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 USize.sizeOf (a : USize) : sizeOf a = a.toNat + 2 := by
cases a; simp_arith [USize.toNat]
@[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
@[simp] protected theorem Char.sizeOf (a : Char) : sizeOf a = a.toNat + 3 := 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

View File

@@ -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 nextTk:"next " args:binderIdent* arrowTk:" => " tac:tacticSeq : tactic =>
macro "next " args:binderIdent* arrowTk:" => " tac:tacticSeq : tactic =>
-- Limit ref variability for incrementality; see Note [Incremental Macros]
withRef arrowTk `(tactic| case%$nextTk _ $args* =>%$arrowTk $tac)
withRef arrowTk `(tactic| case _ $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,15 +910,6 @@ 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.

View File

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

View File

@@ -29,6 +29,7 @@ import Lean.Server
import Lean.ScopedEnvExtension
import Lean.DocString
import Lean.DeclarationRange
import Lean.LazyInitExtension
import Lean.LoadDynlib
import Lean.Widget
import Lean.Log

View File

@@ -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; apply Nat.pos_of_isPowerOfTwo h
0, by simp [USize.toNat, OfNat.ofNat, USize.ofNat]; apply Nat.pos_of_isPowerOfTwo h
@[inline] def reinsertAux (hashFn : α UInt64) (data : HashMapBucket α β) (a : α) (b : β) : HashMapBucket α β :=
let i, h := mkIdx (hashFn a) data.property

View File

@@ -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; apply Nat.pos_of_isPowerOfTwo h
0, by simp [USize.toNat, OfNat.ofNat, USize.ofNat]; apply Nat.pos_of_isPowerOfTwo h
@[inline] def reinsertAux (hashFn : α UInt64) (data : HashSetBucket α) (a : α) : HashSetBucket α :=
let i, h := mkIdx (hashFn a) data.property

View File

@@ -54,7 +54,7 @@ structure WorkspaceEditClientCapabilities where
deriving ToJson, FromJson
structure WorkspaceClientCapabilities where
applyEdit? : Option Bool := none
applyEdit: Bool
workspaceEdit? : Option WorkspaceEditClientCapabilities := none
deriving ToJson, FromJson

View File

@@ -7,7 +7,6 @@ prelude
import Init.Data.Array.Basic
import Init.NotationExtra
import Init.Data.ToString.Macro
import Init.Data.UInt.Basic
universe u v w

View File

@@ -6,7 +6,6 @@ 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'

View File

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

View File

@@ -12,18 +12,16 @@ 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 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]}"
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]}"
private def addScope (isNewNamespace : Bool) (isNoncomputable : Bool) (header : String) (newNamespace : Name) : CommandElabM Unit := do
modify fun s => { s with
@@ -405,16 +403,6 @@ 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"

View File

@@ -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, stx := .missing }
let defView := mkDefViewOfDef { isUnsafe := true }
( `(Parser.Command.definition|
def $(mkIdent <| `_root_ ++ declName) := $( Term.exprToSyntax value)))
Term.elabMutualDef #[] { header := "" } #[defView]

View File

@@ -135,21 +135,13 @@ 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 $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
| `(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
open Lean.Parser in
private def elabParserMacroAux (prec e : Term) (withAnonymousAntiquot : Bool) : TermElabM Syntax := do

View File

@@ -532,12 +532,11 @@ 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 ( 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
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 }

View File

@@ -57,7 +57,6 @@ 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
@@ -122,16 +121,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 : 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]
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]
let recKind :=
if stx.raw[5].isNone then
if stx[5].isNone then
RecKind.default
else if stx.raw[5][0].getKind == ``Parser.Command.partial then
else if stx[5][0].getKind == ``Parser.Command.partial then
RecKind.partial
else
RecKind.nonrec
@@ -149,7 +148,7 @@ def elabModifiers (stx : TSyntax ``Parser.Command.declModifiers) : m Modifiers :
| none => pure #[]
| some attrs => elabDeclAttrs attrs
return {
stx, docString?, visibility, recKind, attrs,
docString?, visibility, recKind, attrs,
isUnsafe := !unsafeStx.isNone
isNoncomputable := !noncompStx.isNone
}

View File

@@ -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 modifiers.stx stx
addDeclarationRanges declName 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 modifiers.stx decl
addDeclarationRanges declName 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,18 +214,17 @@ 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 modifiers
let modifiers elabModifiers stx[0]
elabAxiom modifiers decl
else if declKind == ``Lean.Parser.Command.«inductive» then
let modifiers elabModifiers modifiers
let modifiers elabModifiers stx[0]
elabInductive modifiers decl
else if declKind == ``Lean.Parser.Command.classInductive then
let modifiers elabModifiers modifiers
let modifiers elabModifiers stx[0]
elabClassInductive modifiers decl
else if declKind == ``Lean.Parser.Command.«structure» then
let modifiers elabModifiers modifiers
let modifiers elabModifiers stx[0]
elabStructure modifiers decl
else
throwError "unexpected declaration"
@@ -239,7 +238,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
@@ -400,7 +399,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.raw[0] defStx.raw[1]
addDeclarationRanges fullId defStx
elabCommand ( `(
$[unsafe%$unsafe?]? def initFn : IO $type := with_decl_name% $(mkIdent fullId) do $doSeq
$defStx:command))

View File

@@ -11,14 +11,12 @@ import Lean.Data.Lsp.Utf16
namespace Lean.Elab
def getDeclarationRange? [Monad m] [MonadFileMap m] (stx : Syntax) : m (Option DeclarationRange) := do
let some range := stx.getRange?
| return none
def getDeclarationRange [Monad m] [MonadFileMap m] (stx : Syntax) : m DeclarationRange := do
let fileMap getFileMap
--let range := fileMap.utf8RangeToLspRange
let pos := fileMap.toPosition range.start
let endPos := fileMap.toPosition range.stop
return some {
let pos := stx.getPos?.getD 0
let endPos := stx.getTailPos?.getD pos |> fileMap.toPosition
let pos := pos |> fileMap.toPosition
return {
pos := pos
charUtf16 := fileMap.leanPosToLspPos pos |>.character
endPos := endPos
@@ -51,27 +49,23 @@ def getDeclarationSelectionRef (stx : Syntax) : Syntax :=
/--
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
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
return ()
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 }
else
Lean.addDeclarationRanges declName {
range := ( getDeclarationRange stx)
selectionRange := ( getDeclarationRange (getDeclarationSelectionRef stx))
}
/-- 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
-- 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 }
Lean.addDeclarationRanges declName {
range := ( getDeclarationRange stx)
selectionRange := ( getDeclarationRange header)
}
end Lean.Elab

View File

@@ -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
let commands := commands.push snap.data.stx
if let some next := snap.nextCmdSnap? then
go initialSnap next.task commands
else
@@ -111,15 +111,13 @@ where
let messages := toSnapshotTree initialSnap
|>.getAll.map (·.diagnostics.msgLog)
|>.foldl (· ++ ·) {}
-- 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'
let trees := toSnapshotTree initialSnap
|>.getAll.map (·.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
commands := commands.map (·.stx)
inputCtx, initialSnap
inputCtx, initialSnap, commands
}
def IO.processCommands (inputCtx : Parser.InputContext) (parserState : Parser.ModuleParserState)

View File

@@ -90,7 +90,6 @@ 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

View File

@@ -410,15 +410,11 @@ 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
-- 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
-- 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
let val mkLambdaFVars xs val
if linter.unusedSectionVars.get ( getOptions) && !header.type.hasSorry && !val.hasSorry then
let unusedVars vars.filterMapM fun var => do
@@ -887,7 +883,6 @@ 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
@@ -998,7 +993,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.modifiers.stx view.ref
addDeclarationRanges header.declName view.ref
processDeriving (headers : Array DefViewElabHeader) := do
@@ -1022,7 +1017,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]

View File

@@ -221,7 +221,7 @@ def addAndCompilePartialRec (preDefs : Array PreDefinition) : TermElabM Unit :=
else
none
| _ => none
modifiers := default }
modifiers := {} }
private def containsRecFn (recFnNames : Array Name) (e : Expr) : Bool :=
(e.find? fun e => e.isConst && recFnNames.contains e.constName!).isSome

View File

@@ -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 `FType` is the expected type of the argument.
The `type` 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 (indicesMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor xs
let FType instantiateForall FType indicesMajorArgs
let (indexMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor xs
let FType instantiateForall FType indexMajorArgs
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 (indicesMajorArgs ++ #[below] ++ otherArgs) valueNew
let valueNew replaceRecApps recArgInfos positions below value
mkLambdaFVars (indexMajorArgs ++ #[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 recArgInfo.indIdx
let brecOn := brecOnConst 0
check brecOn
let brecOnType inferType brecOn
-- Skip the indices and major argument

View File

@@ -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

View File

@@ -107,9 +107,9 @@ private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr
check valueNew
return #[{ preDef with value := valueNew }]
-- Groups the (indices of the) definitions by their position in indInfo.all
-- Sort 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] "assignments of type formers of {indInfo.name} to functions: {positions}"
trace[Elab.definition.structural] "positions: {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

View File

@@ -15,7 +15,7 @@ partial def addSmartUnfoldingDefAux (preDef : PreDefinition) (recArgPos : Nat) :
return { preDef with
declName := mkSmartUnfoldingNameFor preDef.declName
value := ( visit preDef.value)
modifiers := default
modifiers := {}
}
where
/--

View File

@@ -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 := default, name := defaultCtorName, declName }
pure { ref, modifiers := {}, 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 modifiers.stx stx
addDeclarationRanges declName stx
Term.withDeclName declName do
let ctor expandCtor stx modifiers declName
let fields expandFields stx modifiers declName

View File

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

View File

@@ -43,4 +43,3 @@ 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

View File

@@ -65,218 +65,202 @@ def getNatOrBvValue? (ty : Expr) (expr : Expr) : M (Option Nat) := do
| _ => return none
/--
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`.
Reify an `Expr` that's a `BitVec`.
-/
partial def of (x : Expr) : M (Option ReifiedBVExpr) := do
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
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
.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)
.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)
(toExpr inner.width)
(toExpr n)
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.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)
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)
(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
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
(toExpr inner.width)
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
| _ => return none
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
/--
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
ofOrAtom (x : Expr) : M (Option ReifiedBVExpr) := do
let res of x
match res with
| some exp => return some exp
| none => bitVecAtom x
| none => ofAtom x
shiftConstLikeReflection (distance : Nat) (innerExpr : Expr) (shiftOp : Nat BVUnOp)
(shiftOpName : Name) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
let some inner goOrAtom innerExpr | return none
let some inner ofOrAtom innerExpr | return none
let bvExpr : BVExpr inner.width := .un (shiftOp distance) inner.bvExpr
let expr :=
mkApp3
@@ -294,22 +278,24 @@ where
rotateReflection (distanceExpr : Expr) (innerExpr : Expr) (rotateOp : Nat BVUnOp)
(rotateOpName : Name) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
let some distance getNatValue? distanceExpr | return none
-- Either the shift values are constant or we abstract the entire term as atoms
let some distance getNatValue? distanceExpr | return ofAtom x
shiftConstLikeReflection distance innerExpr rotateOp rotateOpName congrThm
shiftConstReflection (β : Expr) (distanceExpr : Expr) (innerExpr : Expr) (shiftOp : Nat BVUnOp)
(shiftOpName : Name) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
let some distance getNatOrBvValue? β distanceExpr | return none
-- Either the shift values are constant or we abstract the entire term as atoms
let some distance getNatOrBvValue? β distanceExpr | return ofAtom x
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 none
let some inner goOrAtom innerExpr | return none
let some distance goOrAtom distanceExpr | return none
let_expr BitVec _ β | return ofAtom x
let some inner of innerExpr | return none
let some distance of distanceExpr | return none
let bvExpr : BVExpr inner.width := shiftOp inner.bvExpr distance.bvExpr
let expr :=
mkApp4
@@ -328,8 +314,8 @@ where
binaryReflection (lhsExpr rhsExpr : Expr) (op : BVBinOp) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
let some lhs goOrAtom lhsExpr | return none
let some rhs goOrAtom rhsExpr | return none
let some lhs ofOrAtom lhsExpr | return none
let some rhs ofOrAtom 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
@@ -349,7 +335,7 @@ where
unaryReflection (innerExpr : Expr) (op : BVUnOp) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
let some inner goOrAtom innerExpr | return none
let some inner ofOrAtom 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)
@@ -361,7 +347,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 bitVecAtom x
let some width, bvVal getBitVecValue? x | return ofAtom x
let bvExpr : BVExpr width := .const bvVal
let expr := mkApp2 (mkConst ``BVExpr.const) (toExpr width) (toExpr bvVal)
let proof := do

View File

@@ -44,75 +44,40 @@ 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
goOrAtom t
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
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 goOrAtom lhsExpr | return none
let some rhs goOrAtom rhsExpr | return none
let some lhs of lhsExpr | return none
let some rhs of rhsExpr | return none
let boolExpr := .gate gate lhs.bvExpr rhs.bvExpr
let expr :=
mkApp4
@@ -134,8 +99,11 @@ where
return some boolExpr, proof, expr
goPred (t : Expr) : M (Option ReifiedBVLogical) := do
let some pred ReifiedBVPred.of t | return none
ofPred pred
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
end ReifiedBVLogical

View File

@@ -37,68 +37,54 @@ structure ReifiedBVPred where
namespace ReifiedBVPred
/--
Construct an uninterpreted `Bool` atom from `t`.
Reify an `Expr` that is a proof of a predicate about `BitVec`.
-/
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
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
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

View File

@@ -52,7 +52,6 @@ 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
@@ -301,22 +300,13 @@ 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.tryCatchRestore
tryCatch := Tactic.tryCatch
/-- Execute `x` with error recovery disabled -/
def withoutRecover (x : TacticM α) : TacticM α :=
@@ -352,26 +342,12 @@ def adaptExpander (exp : Syntax → TacticM Syntax) : Tactic := fun stx => do
let stx' exp stx
withMacroExpansion stx stx' $ evalTactic stx'
/-- 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. -/
/-- Add the given goals at the end of the current goals collection. -/
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. 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.
-/
/-- Discard the first goal and replace it by the given list of goals,
keeping the other goals. -/
def replaceMainGoal (mvarIds : List MVarId) : TacticM Unit := do
let (_ :: mvarIds') getGoals | throwNoGoalsToBeSolved
modify fun _ => { goals := mvarIds ++ mvarIds' }
@@ -389,16 +365,6 @@ 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

View File

@@ -520,7 +520,7 @@ where
@[builtin_tactic «case», builtin_incremental]
def evalCase : Tactic
| stx@`(tactic| case%$caseTk $[$tag $hs*]|* =>%$arr $tac:tacticSeq1Indented) =>
| stx@`(tactic| case $[$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 (mkNullNode #[caseTk, arr]) <|
withCaseRef arr tac <| closeUsingOrAdmit <| withTacticInfoContext stx <|
Term.withNarrowedArgTacticReuse (argIdx := 3) (evalTactic ·) stx
setGoals gs
| _ => throwUnsupportedSyntax
@[builtin_tactic «case'»] def evalCase' : Tactic
| `(tactic| case'%$caseTk $[$tag $hs*]|* =>%$arr $tac:tacticSeq) => do
| `(tactic| case' $[$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 <| withTacticInfoContext (mkNullNode #[caseTk, arr]) <| evalTactic tac
withCaseRef arr tac (evalTactic tac)
let gs' getUnsolvedGoals
if let [g'] := gs' then
g'.setTag mvarTag

View File

@@ -14,9 +14,9 @@ open Meta
@[builtin_tactic Lean.calcTactic]
def evalCalc : Tactic := fun stx => withMainContext do
let steps : TSyntax ``calcSteps := stx[1]
let target := ( getMainTarget).consumeMData
let tag getMainTag
let (val, mvarIds) withCollectingNewGoalsFrom (parentTag := tag) (tagSuffix := `calc) do
let (val, mvarIds) withCollectingNewGoalsFrom (tagSuffix := `calc) do
let target := ( getMainTarget).consumeMData
let tag getMainTag
runTermElab do
let mut val Term.elabCalcSteps steps
let mut valType instantiateMVars ( inferType val)

View File

@@ -1,34 +0,0 @@
/-
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

View File

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

View File

@@ -56,6 +56,11 @@ 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
@@ -64,37 +69,14 @@ 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 fun type _ => elabTermEnsuringType e type
| `(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
| _ => throwUnsupportedSyntax
def sortMVarIdArrayByIndex [MonadMCtx m] [Monad m] (mvarIds : Array MVarId) : m (Array MVarId) := do
@@ -111,12 +93,9 @@ 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.
* `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.
Execute `k`, and collect new "holes" in the resulting expression.
-/
def withCollectingNewGoalsFrom (k : TacticM Expr) (parentTag : Name) (tagSuffix : Name) (allowNaturalHoles := false) : TacticM (Expr × List MVarId) :=
def withCollectingNewGoalsFrom (k : TacticM Expr) (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`.
@@ -165,7 +144,7 @@ where
appear in the `.lean` file. We should tell users to prefer tagged goals.
-/
let newMVarIds sortMVarIdsByIndex newMVarIds.toList
tagUntaggedGoals parentTag tagSuffix newMVarIds
tagUntaggedGoals ( getMainTag) tagSuffix newMVarIds
return (val, newMVarIds)
/-- Elaborates `stx` and collects the `MVarId`s of any holes that were created during elaboration.
@@ -174,8 +153,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 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.
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.
Note:
* Previously-created `MVarId`s which appear in `stx` are not returned.
@@ -184,8 +163,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) (parentTag? : Option Name := none) : TacticM (Expr × List MVarId) := do
withCollectingNewGoalsFrom (elabTermEnsuringType stx expectedType?) ( parentTag?.getDM getMainTag) tagSuffix allowNaturalHoles
def elabTermWithHoles (stx : Syntax) (expectedType? : Option Expr) (tagSuffix : Name) (allowNaturalHoles := false) : TacticM (Expr × List MVarId) := do
withCollectingNewGoalsFrom (elabTermEnsuringType stx expectedType?) 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
@@ -416,7 +395,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`
@@ -522,7 +501,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

View File

@@ -123,7 +123,9 @@ def realizeExtTheorem (structName : Name) (flat : Bool) : Elab.Command.CommandEl
levelParams := info.levelParams
}
modifyEnv fun env => addProtected env extName
addAuxDeclarationRanges extName ( getRef) ( getRef)
Lean.addDeclarationRanges extName {
range := getDeclarationRange ( getRef)
selectionRange := getDeclarationRange ( getRef) }
catch e =>
throwError m!"\
Failed to generate an 'ext' theorem for '{MessageData.ofConstName structName}': {e.toMessageData}"
@@ -161,7 +163,9 @@ 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
addAuxDeclarationRanges extName ( getRef) ( getRef)
Lean.addDeclarationRanges extIffName {
range := getDeclarationRange ( getRef)
selectionRange := getDeclarationRange ( getRef) }
catch e =>
throwError m!"\
Failed to generate an 'ext_iff' theorem from '{MessageData.ofConstName extName}': {e.toMessageData}\n\

View File

@@ -27,10 +27,8 @@ open Meta
syntax inductionAlt := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> syntheticHole <|> tacticSeq)
```
-/
private def getAltLhses (alt : Syntax) : Syntax :=
alt[0]
private def getFirstAltLhs (alt : Syntax) : Syntax :=
(getAltLhses alt)[0]
alt[0][0]
/-- Return `inductionAlt` name. It assumes `alt` does not have multiple `inductionAltLHS` -/
private def getAltName (alt : Syntax) : Name :=
let lhs := getFirstAltLhs alt
@@ -72,9 +70,7 @@ def evalAlt (mvarId : MVarId) (alt : Syntax) (addInfo : TermElabM Unit) : Tactic
let goals getGoals
try
setGoals [mvarId]
closeUsingOrAdmit <|
withTacticInfoContext (mkNullNode #[getAltLhses alt, getAltDArrow alt]) <|
(addInfo *> evalTactic rhs)
closeUsingOrAdmit (withTacticInfoContext alt (addInfo *> evalTactic rhs))
finally
setGoals goals

View File

@@ -914,9 +914,7 @@ private def applyAttributesCore
Remark: if the declaration has syntax errors, `declName` may be `.anonymous` see issue #4309
In this case, we skip attribute application.
-/
if declName == .anonymous then
return
withDeclName declName do
unless declName == .anonymous do
for attr in attrs do
withRef attr.stx do withLogging do
let env getEnv

View File

@@ -1038,14 +1038,6 @@ 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`.
@@ -1093,16 +1085,6 @@ 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.

View File

@@ -243,16 +243,11 @@ instance : ToSnapshotTree SnapshotLeaf where
structure DynamicSnapshot where
/-- Concrete snapshot value as `Dynamic`. -/
val : Dynamic
/--
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
/-- Snapshot tree retrieved from `val` before erasure. -/
tree : SnapshotTree
instance : ToSnapshotTree DynamicSnapshot where
toSnapshotTree s := s.tree.get
toSnapshotTree s := s.tree
/-- Creates a `DynamicSnapshot` from a typed snapshot value. -/
def DynamicSnapshot.ofTyped [TypeName α] [ToSnapshotTree α] (val : α) : DynamicSnapshot where

View File

@@ -0,0 +1,42 @@
/-
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

View File

@@ -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' (postNode := fun ci info _ => do
tree.visitM' (preNode := 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