From 7f35b0673f727a5d6f8c50243c9106bee99a5115 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 2 Feb 2024 09:15:35 +0000 Subject: [PATCH 001/213] chore: bump to nightly-2024-02-02 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index cfcdd3277d..c7f38d984a 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.6.0-rc1 +leanprover/lean4:nightly-2024-02-02 From cb3165c7fa567d916867e553a557326af8f8f5ab Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 5 Feb 2024 09:15:18 +0000 Subject: [PATCH 002/213] chore: bump to nightly-2024-02-05 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index c7f38d984a..7f89b25bf0 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-02 +leanprover/lean4:nightly-2024-02-05 From a2a5a228e54c589b04d46282ba4abded2ef1ea2c Mon Sep 17 00:00:00 2001 From: Leonardo de Moura Date: Tue, 6 Feb 2024 01:01:01 -0800 Subject: [PATCH 003/213] feat: simprocs for `BitVec` literals (#581) * chore: missing `BitVec` `Decidable` instances * feat: simprocs for `BitVec` literals * add doc-strings * add lint exceptions --------- Co-authored-by: Scott Morrison --- Std/Data/BitVec.lean | 1 + Std/Data/BitVec/Basic.lean | 2 +- Std/Data/BitVec/Lemmas.lean | 8 +- Std/Data/BitVec/Simprocs.lean | 283 ++++++++++++++++++++++++++++++++++ lean-toolchain | 2 +- scripts/nolints.json | 46 +++++- test/bitvec_simproc.lean | 112 ++++++++++++++ 7 files changed, 449 insertions(+), 5 deletions(-) create mode 100644 Std/Data/BitVec/Simprocs.lean create mode 100644 test/bitvec_simproc.lean diff --git a/Std/Data/BitVec.lean b/Std/Data/BitVec.lean index 037cb6b6c9..3448b2d7c2 100644 --- a/Std/Data/BitVec.lean +++ b/Std/Data/BitVec.lean @@ -2,3 +2,4 @@ import Std.Data.BitVec.Basic import Std.Data.BitVec.Bitblast import Std.Data.BitVec.Folds import Std.Data.BitVec.Lemmas +import Std.Data.BitVec.Simprocs diff --git a/Std/Data/BitVec/Basic.lean b/Std/Data/BitVec/Basic.lean index 900a8aa486..70147ed1c0 100644 --- a/Std/Data/BitVec/Basic.lean +++ b/Std/Data/BitVec/Basic.lean @@ -71,7 +71,7 @@ protected def zero (n : Nat) : BitVec n := ⟨0, Nat.pow_two_pos n⟩ instance : Inhabited (BitVec n) where default := .zero n -instance : OfNat (BitVec n) i where ofNat := .ofNat n i +instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i /-- Notation for bit vector literals. `i#n` is a shorthand for `BitVec.ofNat n i`. -/ scoped syntax:max term:max noWs "#" noWs term:max : term diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index b25e97a713..c18cad698b 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -79,7 +79,9 @@ theorem eq_of_getMsb_eq {x y : BitVec w} @[simp] theorem toNat_ofNat (x w : Nat) : (x#w).toNat = x % 2^w := by simp [BitVec.toNat, BitVec.ofNat, Fin.ofNat'] -@[simp] theorem getLsb_ofNat (n : Nat) (x : Nat) (i : Nat) : +-- Remark: we don't use `[simp]` here because simproc` subsumes it for literals. +-- If `x` and `n` are not literals, applying this theorem eagerly may not be a good idea. +theorem getLsb_ofNat (n : Nat) (x : Nat) (i : Nat) : getLsb (x#n) i = (i < n && x.testBit i) := by simp [getLsb, BitVec.ofNat, Fin.val_ofNat'] @@ -314,7 +316,9 @@ theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n (x.toNat + (2^n - y.toNa rfl @[simp] theorem sub_ofFin (x : BitVec n) (y : Fin (2^n)) : x - .ofFin y = .ofFin (x.toFin - y) := rfl -@[simp] theorem ofNat_sub_ofNat {n} (x y : Nat) : x#n - y#n = .ofNat n (x + (2^n - y % 2^n)) := by +-- Remark: we don't use `[simp]` here because simproc` subsumes it for literals. +-- If `x` and `n` are not literals, applying this theorem eagerly may not be a good idea. +theorem ofNat_sub_ofNat {n} (x y : Nat) : x#n - y#n = .ofNat n (x + (2^n - y % 2^n)) := by apply eq_of_toNat_eq ; simp [BitVec.ofNat] @[simp] protected theorem sub_zero (x : BitVec n) : x - (0#n) = x := by apply eq_of_toNat_eq ; simp diff --git a/Std/Data/BitVec/Simprocs.lean b/Std/Data/BitVec/Simprocs.lean new file mode 100644 index 0000000000..9263d2f80e --- /dev/null +++ b/Std/Data/BitVec/Simprocs.lean @@ -0,0 +1,283 @@ +/- +Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura +-/ +import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Nat +import Std.Data.BitVec.Basic + +namespace Std.BitVec +open Lean Meta Simp + +/-- A bit-vector literal -/ +structure Literal where + /-- Size. -/ + n : Nat + /-- Actual value. -/ + value : BitVec n + +/-- +Try to convert an `OfNat.ofNat`-application into a bitvector literal. +-/ +private def fromOfNatExpr? (e : Expr) : SimpM (Option Literal) := OptionT.run do + guard (e.isAppOfArity ``OfNat.ofNat 3) + let type ← whnf e.appFn!.appFn!.appArg! + guard (type.isAppOfArity ``BitVec 1) + let n ← Nat.fromExpr? type.appArg! + let v ← Nat.fromExpr? e.appFn!.appArg! + return { n, value := BitVec.ofNat n v } + +/-- +Try to convert an `Std.BitVec.ofNat`-application into a bitvector literal. +-/ +private def fromBitVecExpr? (e : Expr) : SimpM (Option Literal) := OptionT.run do + guard (e.isAppOfArity ``Std.BitVec.ofNat 2) + let n ← Nat.fromExpr? e.appFn!.appArg! + let v ← Nat.fromExpr? e.appArg! + return { n, value := BitVec.ofNat n v } + +/-- +Try to convert `OfNat.ofNat`/`Std.BitVec.OfNat` application into a +bitvector literal. +-/ +def fromExpr? (e : Expr) : SimpM (Option Literal) := OptionT.run do + fromBitVecExpr? e <|> fromOfNatExpr? e + +/-- +Convert a bitvector literal into an expression. +-/ +-- Using `Std.BitVec.ofNat` because it is being used in `simp` theorems +def Literal.toExpr (lit : Literal) : Expr := + mkApp2 (mkConst ``Std.BitVec.ofNat) (mkNatLit lit.n) (mkNatLit lit.value.toNat) + +/-- +Helper function for reducing homogenous unary bitvector operators. +-/ +@[inline] def reduceUnary (declName : Name) (arity : Nat) + (op : {n : Nat} → BitVec n → BitVec n) (e : Expr) : SimpM Step := do + unless e.isAppOfArity declName arity do return .continue + let some v ← fromExpr? e.appArg! | return .continue + let v := { v with value := op v.value } + return .done { expr := v.toExpr } + +/-- +Helper function for reducing homogenous binary bitvector operators. +-/ +@[inline] def reduceBin (declName : Name) (arity : Nat) + (op : {n : Nat} → BitVec n → BitVec n → BitVec n) (e : Expr) : SimpM Step := do + unless e.isAppOfArity declName arity do return .continue + let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue + let some v₂ ← fromExpr? e.appArg! | return .continue + if h : v₁.n = v₂.n then + trace[Meta.debug] "reduce [{declName}] {v₁.value}, {v₂.value}" + let v := { v₁ with value := op v₁.value (h ▸ v₂.value) } + return .done { expr := v.toExpr } + else + return .continue + +/-- +Helper function for reducing bitvector functions such as `getLsb` and `getMsb`. +-/ +@[inline] def reduceGetBit (declName : Name) (op : {n : Nat} → BitVec n → Nat → Bool) (e : Expr) + : SimpM Step := do + unless e.isAppOfArity declName 3 do return .continue + let some v ← fromExpr? e.appFn!.appArg! | return .continue + let some i ← Nat.fromExpr? e.appArg! | return .continue + let b := op v.value i + return .done { expr := toExpr b } + +/-- +Helper function for reducing bitvector functions such as `shiftLeft` and `rotateRight`. +-/ +@[inline] def reduceShift (declName : Name) (arity : Nat) + (op : {n : Nat} → BitVec n → Nat → BitVec n) (e : Expr) : SimpM Step := do + unless e.isAppOfArity declName arity do return .continue + let some v ← fromExpr? e.appFn!.appArg! | return .continue + let some i ← Nat.fromExpr? e.appArg! | return .continue + let v := { v with value := op v.value i } + return .done { expr := v.toExpr } + +/-- +Helper function for reducing bitvector predicates. +-/ +@[inline] def reduceBinPred (declName : Name) (arity : Nat) + (op : {n : Nat} → BitVec n → BitVec n → Bool) (e : Expr) (isProp := true) : SimpM Step := do + unless e.isAppOfArity declName arity do return .continue + let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue + let some v₂ ← fromExpr? e.appArg! | return .continue + if h : v₁.n = v₂.n then + let b := op v₁.value (h ▸ v₂.value) + if isProp then + evalPropStep e b + else + return .done { expr := toExpr b } + else + return .continue + +/-- Simplification procedure for negation of `BitVec`s. -/ +simproc [simp, seval] reduceNeg ((- _ : BitVec _)) := reduceUnary ``Neg.neg 3 (- ·) +/-- Simplification procedure for bitwise not of `BitVec`s. -/ +simproc [simp, seval] reduceNot ((~~~ _ : BitVec _)) := + reduceUnary ``Complement.complement 3 (~~~ ·) +/-- Simplification procedure for absolute value of `BitVec`s. -/ +simproc [simp, seval] reduceAbs (BitVec.abs _) := reduceUnary ``BitVec.abs 2 BitVec.abs +/-- Simplification procedure for bitwise and of `BitVec`s. -/ +simproc [simp, seval] reduceAnd ((_ &&& _ : BitVec _)) := reduceBin ``HAnd.hAnd 6 (· &&& ·) +/-- Simplification procedure for bitwise or of `BitVec`s. -/ +simproc [simp, seval] reduceOr ((_ ||| _ : BitVec _)) := reduceBin ``HOr.hOr 6 (· ||| ·) +/-- Simplification procedure for bitwise xor of `BitVec`s. -/ +simproc [simp, seval] reduceXOr ((_ ^^^ _ : BitVec _)) := reduceBin ``HXor.hXor 6 (· ^^^ ·) +/-- Simplification procedure for addition of `BitVec`s. -/ +simproc [simp, seval] reduceAdd ((_ + _ : BitVec _)) := reduceBin ``HAdd.hAdd 6 (· + ·) +/-- Simplification procedure for multiplication of `BitVec`s. -/ +simproc [simp, seval] reduceMul ((_ * _ : BitVec _)) := reduceBin ``HMul.hMul 6 (· * ·) +/-- Simplification procedure for subtraction of `BitVec`s. -/ +simproc [simp, seval] reduceSub ((_ - _ : BitVec _)) := reduceBin ``HSub.hSub 6 (· - ·) +/-- Simplification procedure for division of `BitVec`s. -/ +simproc [simp, seval] reduceDiv ((_ / _ : BitVec _)) := reduceBin ``HDiv.hDiv 6 (· / ·) +/-- Simplification procedure for the modulo operation on `BitVec`s. -/ +simproc [simp, seval] reduceMod ((_ % _ : BitVec _)) := reduceBin ``HMod.hMod 6 (· % ·) +/-- Simplification procedure for for the unsigned modulo operation on `BitVec`s. -/ +simproc [simp, seval] reduceUMod ((umod _ _ : BitVec _)) := reduceBin ``umod 3 umod +/-- Simplification procedure for unsigned division of `BitVec`s. -/ +simproc [simp, seval] reduceUDiv ((udiv _ _ : BitVec _)) := reduceBin ``udiv 3 udiv +/-- Simplification procedure for division of `BitVec`s using the SMT-Lib conventions. -/ +simproc [simp, seval] reduceSMTUDiv ((smtUDiv _ _ : BitVec _)) := reduceBin ``smtUDiv 3 smtUDiv +/-- Simplification procedure for the signed modulo operation on `BitVec`s. -/ +simproc [simp, seval] reduceSMod ((smod _ _ : BitVec _)) := reduceBin ``smod 3 smod +/-- Simplification procedure for signed remainder of `BitVec`s. -/ +simproc [simp, seval] reduceSRem ((srem _ _ : BitVec _)) := reduceBin ``srem 3 srem +/-- Simplification procedure for signed t-division of `BitVec`s. -/ +simproc [simp, seval] reduceSDiv ((sdiv _ _ : BitVec _)) := reduceBin ``sdiv 3 sdiv +/-- Simplification procedure for signed division of `BitVec`s using the SMT-Lib conventions. -/ +simproc [simp, seval] reduceSMTSDiv ((smtSDiv _ _ : BitVec _)) := reduceBin ``smtSDiv 3 smtSDiv +/-- Simplification procedure for `getLsb` (lowest significant bit) on `BitVec`. -/ +simproc [simp, seval] reduceGetLsb (getLsb _ _) := reduceGetBit ``getLsb getLsb +/-- Simplification procedure for `getMsb` (most significant bit) on `BitVec`. -/ +simproc [simp, seval] reduceGetMsb (getMsb _ _) := reduceGetBit ``getMsb getMsb + +/-- Simplification procedure for shift left on `BitVec`. -/ +simproc [simp, seval] reduceShiftLeft (BitVec.shiftLeft _ _) := + reduceShift ``BitVec.shiftLeft 3 BitVec.shiftLeft +/-- Simplification procedure for unsigned shift right on `BitVec`. -/ +simproc [simp, seval] reduceUShiftRight (BitVec.ushiftRight _ _) := + reduceShift ``BitVec.ushiftRight 3 BitVec.ushiftRight +/-- Simplification procedure for signed shift right on `BitVec`. -/ +simproc [simp, seval] reduceSShiftRight (BitVec.sshiftRight _ _) := + reduceShift ``BitVec.sshiftRight 3 BitVec.sshiftRight +/-- Simplification procedure for shift left on `BitVec`. -/ +simproc [simp, seval] reduceHShiftLeft ((_ <<< _ : BitVec _)) := + reduceShift ``HShiftLeft.hShiftLeft 6 (· <<< ·) +/-- Simplification procedure for shift right on `BitVec`. -/ +simproc [simp, seval] reduceHShiftRight ((_ >>> _ : BitVec _)) := + reduceShift ``HShiftRight.hShiftRight 6 (· >>> ·) +/-- Simplification procedure for rotate left on `BitVec`. -/ +simproc [simp, seval] reduceRotateLeft (BitVec.rotateLeft _ _) := + reduceShift ``BitVec.rotateLeft 3 BitVec.rotateLeft +/-- Simplification procedure for rotate right on `BitVec`. -/ +simproc [simp, seval] reduceRotateRight (BitVec.rotateRight _ _) := + reduceShift ``BitVec.rotateRight 3 BitVec.rotateRight + +/-- Simplification procedure for append on `BitVec`. -/ +simproc [simp, seval] reduceAppend ((_ ++ _ : BitVec _)) := fun e => do + unless e.isAppOfArity ``HAppend.hAppend 6 do return .continue + let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue + let some v₂ ← fromExpr? e.appArg! | return .continue + let v : Literal := { n := v₁.n + v₂.n, value := v₁.value ++ v₂.value } + return .done { expr := v.toExpr } + +/-- Simplification procedure for casting `BitVec`s along an equality of the size. -/ +simproc [simp, seval] reduceCast (cast _ _) := fun e => do + unless e.isAppOfArity ``cast 4 do return .continue + let some v ← fromExpr? e.appArg! | return .continue + let some m ← Nat.fromExpr? e.appFn!.appFn!.appArg! | return .continue + let v : Literal := { n := m, value := BitVec.ofNat m v.value.toNat } + return .done { expr := v.toExpr } + +/-- Simplification procedure for `BitVec.toNat`. -/ +simproc [simp, seval] reduceToNat (BitVec.toNat _) := fun e => do + unless e.isAppOfArity ``BitVec.toNat 2 do return .continue + let some v ← fromExpr? e.appArg! | return .continue + return .done { expr := mkNatLit v.value.toNat } + +/-- Simplification procedure for `BitVec.toInt`. -/ +simproc [simp, seval] reduceToInt (BitVec.toInt _) := fun e => do + unless e.isAppOfArity ``BitVec.toInt 2 do return .continue + let some v ← fromExpr? e.appArg! | return .continue + return .done { expr := Int.toExpr v.value.toInt } + +/-- Simplification procedure for `BitVec.ofInt`. -/ +simproc [simp, seval] reduceOfInt (BitVec.ofInt _ _) := fun e => do + unless e.isAppOfArity ``BitVec.ofInt 2 do return .continue + let some n ← Nat.fromExpr? e.appFn!.appArg! | return .continue + let some i ← Int.fromExpr? e.appArg! | return .continue + let lit : Literal := { n, value := BitVec.ofInt n i } + return .done { expr := lit.toExpr } + +/-- Simplification procedure for `<` on `BitVec`s. -/ +simproc [simp, seval] reduceLT (( _ : BitVec _) < _) := reduceBinPred ``LT.lt 4 (· < ·) +/-- Simplification procedure for `≤` on `BitVec`s. -/ +simproc [simp, seval] reduceLE (( _ : BitVec _) ≤ _) := reduceBinPred ``LE.le 4 (. ≤ .) +/-- Simplification procedure for `>` on `BitVec`s. -/ +simproc [simp, seval] reduceGT (( _ : BitVec _) > _) := reduceBinPred ``GT.gt 4 (. > .) +/-- Simplification procedure for `≥` on `BitVec`s. -/ +simproc [simp, seval] reduceGE (( _ : BitVec _) ≥ _) := reduceBinPred ``GE.ge 4 (. ≥ .) + +/-- Simplification procedure for unsigned less than `ult` on `BitVec`s. -/ +simproc [simp, seval] reduceULT (BitVec.ult _ _) := + reduceBinPred ``BitVec.ult 3 BitVec.ult (isProp := false) +/-- Simplification procedure for unsigned less than or equal `ule` on `BitVec`s. -/ +simproc [simp, seval] reduceULE (BitVec.ule _ _) := + reduceBinPred ``BitVec.ule 3 BitVec.ule (isProp := false) +/-- Simplification procedure for signed less than `slt` on `BitVec`s. -/ +simproc [simp, seval] reduceSLT (BitVec.slt _ _) := + reduceBinPred ``BitVec.slt 3 BitVec.slt (isProp := false) +/-- Simplification procedure for signed less than or equal `sle` on `BitVec`s. -/ +simproc [simp, seval] reduceSLE (BitVec.sle _ _) := + reduceBinPred ``BitVec.sle 3 BitVec.sle (isProp := false) + +/-- Simplification procedure for `zeroExtend'` on `BitVec`s. -/ +simproc [simp, seval] reduceZeroExtend' (zeroExtend' _ _) := fun e => do + unless e.isAppOfArity ``zeroExtend' 4 do return .continue + let some v ← fromExpr? e.appArg! | return .continue + let some w ← Nat.fromExpr? e.appFn!.appFn!.appArg! | return .continue + if h : v.n ≤ w then + let lit : Literal := { n := w, value := v.value.zeroExtend' h } + return .done { expr := lit.toExpr } + else + return .continue + +/-- Simplification procedure for `shiftLeftZeroExtend` on `BitVec`s. -/ +simproc [simp, seval] reduceShiftLeftZeroExtend (shiftLeftZeroExtend _ _) := fun e => do + unless e.isAppOfArity ``shiftLeftZeroExtend 3 do return .continue + let some v ← fromExpr? e.appFn!.appArg! | return .continue + let some m ← Nat.fromExpr? e.appArg! | return .continue + let lit : Literal := { n := v.n + m, value := v.value.shiftLeftZeroExtend m } + return .done { expr := lit.toExpr } + +/-- Simplification procedure for `extractLsb'` on `BitVec`s. -/ +simproc [simp, seval] reduceExtracLsb' (extractLsb' _ _ _) := fun e => do + unless e.isAppOfArity ``extractLsb' 4 do return .continue + let some v ← fromExpr? e.appArg! | return .continue + let some start ← Nat.fromExpr? e.appFn!.appFn!.appArg! | return .continue + let some len ← Nat.fromExpr? e.appFn!.appArg! | return .continue + let lit : Literal := { n := len, value := v.value.extractLsb' start len } + return .done { expr := lit.toExpr } + +/-- Simplification procedure for `replicate` on `BitVec`s. -/ +simproc [simp, seval] reduceReplicate (replicate _ _) := fun e => do + unless e.isAppOfArity ``replicate 3 do return .continue + let some v ← fromExpr? e.appArg! | return .continue + let some w ← Nat.fromExpr? e.appFn!.appArg! | return .continue + let lit : Literal := { n := v.n * w, value := v.value.replicate w } + return .done { expr := lit.toExpr } + +/-- Simplification procedure for `zeroExtend` on `BitVec`s. -/ +simproc [simp, seval] reduceZeroExtend (zeroExtend _ _) := fun e => do + unless e.isAppOfArity ``zeroExtend 3 do return .continue + let some v ← fromExpr? e.appArg! | return .continue + let some n ← Nat.fromExpr? e.appFn!.appArg! | return .continue + let lit : Literal := { n, value := v.value.zeroExtend n } + return .done { expr := lit.toExpr } + +end Std.BitVec diff --git a/lean-toolchain b/lean-toolchain index cfcdd3277d..7f89b25bf0 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.6.0-rc1 +leanprover/lean4:nightly-2024-02-05 diff --git a/scripts/nolints.json b/scripts/nolints.json index 0637a088a0..274f119219 100644 --- a/scripts/nolints.json +++ b/scripts/nolints.json @@ -1 +1,45 @@ -[] \ No newline at end of file +[["docBlame", "Std.BitVec.reduceAbs"], + ["docBlame", "Std.BitVec.reduceAdd"], + ["docBlame", "Std.BitVec.reduceAnd"], + ["docBlame", "Std.BitVec.reduceAppend"], + ["docBlame", "Std.BitVec.reduceCast"], + ["docBlame", "Std.BitVec.reduceDiv"], + ["docBlame", "Std.BitVec.reduceExtracLsb'"], + ["docBlame", "Std.BitVec.reduceGE"], + ["docBlame", "Std.BitVec.reduceGT"], + ["docBlame", "Std.BitVec.reduceGetLsb"], + ["docBlame", "Std.BitVec.reduceGetMsb"], + ["docBlame", "Std.BitVec.reduceHShiftLeft"], + ["docBlame", "Std.BitVec.reduceHShiftRight"], + ["docBlame", "Std.BitVec.reduceLE"], + ["docBlame", "Std.BitVec.reduceLT"], + ["docBlame", "Std.BitVec.reduceMod"], + ["docBlame", "Std.BitVec.reduceMul"], + ["docBlame", "Std.BitVec.reduceNeg"], + ["docBlame", "Std.BitVec.reduceNot"], + ["docBlame", "Std.BitVec.reduceOfInt"], + ["docBlame", "Std.BitVec.reduceOr"], + ["docBlame", "Std.BitVec.reduceReplicate"], + ["docBlame", "Std.BitVec.reduceRotateLeft"], + ["docBlame", "Std.BitVec.reduceRotateRight"], + ["docBlame", "Std.BitVec.reduceSDiv"], + ["docBlame", "Std.BitVec.reduceSLE"], + ["docBlame", "Std.BitVec.reduceSLT"], + ["docBlame", "Std.BitVec.reduceSMTSDiv"], + ["docBlame", "Std.BitVec.reduceSMTUDiv"], + ["docBlame", "Std.BitVec.reduceSMod"], + ["docBlame", "Std.BitVec.reduceSRem"], + ["docBlame", "Std.BitVec.reduceSShiftRight"], + ["docBlame", "Std.BitVec.reduceShiftLeft"], + ["docBlame", "Std.BitVec.reduceShiftLeftZeroExtend"], + ["docBlame", "Std.BitVec.reduceSub"], + ["docBlame", "Std.BitVec.reduceToInt"], + ["docBlame", "Std.BitVec.reduceToNat"], + ["docBlame", "Std.BitVec.reduceUDiv"], + ["docBlame", "Std.BitVec.reduceULE"], + ["docBlame", "Std.BitVec.reduceULT"], + ["docBlame", "Std.BitVec.reduceUMod"], + ["docBlame", "Std.BitVec.reduceUShiftRight"], + ["docBlame", "Std.BitVec.reduceXOr"], + ["docBlame", "Std.BitVec.reduceZeroExtend"], + ["docBlame", "Std.BitVec.reduceZeroExtend'"]] \ No newline at end of file diff --git a/test/bitvec_simproc.lean b/test/bitvec_simproc.lean new file mode 100644 index 0000000000..b3c42ec12c --- /dev/null +++ b/test/bitvec_simproc.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura +-/ +import Std.Data.BitVec +open Std BitVec + +example (h : x = (6 : Std.BitVec 3)) : x = -2 := by + simp; guard_target =ₛ x = 6#3; assumption +example (h : x = (5 : Std.BitVec 3)) : x = ~~~2 := by + simp; guard_target =ₛ x = 5#3; assumption +example (h : x = (1 : Std.BitVec 32)) : x = BitVec.abs (-1#32) := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = (5 : Std.BitVec 3)) : x = 2 + 3 := by + simp; guard_target =ₛ x = 5#3; assumption +example (h : x = (1 : Std.BitVec 3)) : x = 5 &&& 3 := by + simp; guard_target =ₛ x = 1#3; assumption +example (h : x = (7 : Std.BitVec 3)) : x = 5 ||| 3 := by + simp; guard_target =ₛ x = 7#3; assumption +example (h : x = (6 : Std.BitVec 3)) : x = 5 ^^^ 3 := by + simp; guard_target =ₛ x = 6#3; assumption +example (h : x = (3 : Std.BitVec 32)) : x = 5 - 2 := by + simp; guard_target =ₛ x = 3#32; assumption +example (h : x = (10 : Std.BitVec 32)) : x = 5 * 2 := by + simp; guard_target =ₛ x = 10#32; assumption +example (h : x = (4 : Std.BitVec 32)) : x = 9 / 2 := by + simp; guard_target =ₛ x = 4#32; assumption +example (h : x = (1 : Std.BitVec 32)) : x = 9 % 2 := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = (4 : Std.BitVec 32)) : x = udiv 9 2 := by + simp; guard_target =ₛ x = 4#32; assumption +example (h : x = (1 : Std.BitVec 32)) : x = umod 9 2 := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = (4 : Std.BitVec 32)) : x = sdiv (-9) (-2) := by + simp; guard_target =ₛ x = 4#32; assumption +example (h : x = (1 : Std.BitVec 32)) : x = smod (-9) 2 := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = (1 : Std.BitVec 32)) : x = - smtUDiv 9 0 := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = (1 : Std.BitVec 32)) : x = - srem (-9) 2 := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = (1 : Std.BitVec 32)) : x = - smtSDiv 9 0 := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = (1 : Std.BitVec 32)) : x = smtSDiv (-9) 0 := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = false) : x = (4#3).getLsb 0:= by + simp; guard_target =ₛ x = false; assumption +example (h : x = true) : x = (4#3).getLsb 2:= by + simp; guard_target =ₛ x = true; assumption +example (h : x = true) : x = (4#3).getMsb 0:= by + simp; guard_target =ₛ x = true; assumption +example (h : x = false) : x = (4#3).getMsb 2:= by + simp; guard_target =ₛ x = false; assumption +example (h : x = (24 : Std.BitVec 32)) : x = 6#32 <<< 2 := by + simp; guard_target =ₛ x = 24#32; assumption +example (h : x = (1 : Std.BitVec 32)) : x = 6#32 >>> 2 := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = (24 : Std.BitVec 32)) : x = BitVec.shiftLeft 6#32 2 := by + simp; guard_target =ₛ x = 24#32; assumption +example (h : x = (1 : Std.BitVec 32)) : x = BitVec.ushiftRight 6#32 2 := by + simp; guard_target =ₛ x = 1#32; assumption +example (h : x = (2 : Std.BitVec 32)) : x = - BitVec.sshiftRight (- 6#32) 2 := by + simp; guard_target =ₛ x = 2#32; assumption +example (h : x = (5 : Std.BitVec 3)) : x = BitVec.rotateLeft (6#3) 1 := by + simp; guard_target =ₛ x = 5#3; assumption +example (h : x = (3 : Std.BitVec 3)) : x = BitVec.rotateRight (6#3) 1 := by + simp; guard_target =ₛ x = 3#3; assumption +example (h : x = (7 : Std.BitVec 5)) : x = 1#3 ++ 3#2 := by + simp; guard_target =ₛ x = 7#5; assumption +example (h : x = (1 : Std.BitVec 3)) : x = BitVec.cast (by decide : 3=2+1) 1#3 := by + simp; guard_target =ₛ x = 1#3; assumption +example (h : x = 5) : x = (2#3 + 3#3).toNat := by + simp; guard_target =ₛ x = 5; assumption +example (h : x = -1) : x = (2#3 - 3#3).toInt := by + simp; guard_target =ₛ x = -1; assumption +example (h : x = (1 : Std.BitVec 3)) : x = -BitVec.ofInt 3 (-1) := by + simp; guard_target =ₛ x = 1#3; assumption +example (h : x) : x = (1#3 < 3#3) := by + simp; guard_target =ₛ x; assumption +example (h : x) : x = (BitVec.ult 1#3 3#3) := by + simp; guard_target =ₛ x; assumption +example (h : ¬x) : x = (4#3 < 3#3) := by + simp; guard_target =ₛ ¬x; assumption +example (h : x) : x = (BitVec.slt (- 4#3) 3#3) := by + simp; guard_target =ₛ x; assumption +example (h : x) : x = (BitVec.sle (- 4#3) 3#3) := by + simp; guard_target =ₛ x; assumption +example (h : x) : x = (3#3 > 1#3) := by + simp; guard_target =ₛ x; assumption +example (h : ¬x) : x = (3#3 > 4#3) := by + simp; guard_target =ₛ ¬x; assumption +example (h : x) : x = (1#3 ≤ 3#3) := by + simp; guard_target =ₛ x; assumption +example (h : ¬x) : x = (4#3 ≤ 3#3) := by + simp; guard_target =ₛ ¬x; assumption +example (h : ¬x) : x = (BitVec.ule 4#3 3#3) := by + simp; guard_target =ₛ ¬x; assumption +example (h : x) : x = (3#3 ≥ 1#3) := by + simp; guard_target =ₛ x; assumption +example (h : ¬x) : x = (3#3 ≥ 4#3) := by + simp; guard_target =ₛ ¬x; assumption +example (h : x = (5 : Std.BitVec 7)) : x = (5#3).zeroExtend' (by decide) := by + simp; guard_target =ₛ x = 5#7; assumption +example (h : x = (80 : Std.BitVec 7)) : x = (5#3).shiftLeftZeroExtend 4 := by + simp; guard_target =ₛ x = 80#7; assumption +example (h : x = (5: Std.BitVec 3)) : x = (10#5).extractLsb' 1 3 := by + simp; guard_target =ₛ x = 5#3; assumption +example (h : x = (9: Std.BitVec 6)) : x = (1#3).replicate 2 := by + simp; guard_target =ₛ x = 9#6; assumption +example (h : x = (5 : Std.BitVec 7)) : x = (5#3).zeroExtend 7 := by + simp; guard_target =ₛ x = 5#7; assumption From ae5dcfd030aae230566e536aa03847d4bfdefaca Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Tue, 6 Feb 2024 09:15:06 +0000 Subject: [PATCH 004/213] chore: bump to nightly-2024-02-06 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 7f89b25bf0..6802ed8704 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-05 +leanprover/lean4:nightly-2024-02-06 From e3a69ce0e67c0ffa842c6c23c7d23663cef65501 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Wed, 7 Feb 2024 09:15:13 +0000 Subject: [PATCH 005/213] chore: bump to nightly-2024-02-07 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 6802ed8704..e862a0b958 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-06 +leanprover/lean4:nightly-2024-02-07 From d09ea9852c53e7e4e2d768684cfbc4ad7614c962 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 7 Feb 2024 21:32:21 +1100 Subject: [PATCH 006/213] chore: Lean.Elab.InfoTree.foldInfo' moved to core --- Std.lean | 1 - Std/CodeAction/Basic.lean | 4 ++-- Std/Lean/InfoTree.lean | 23 ----------------------- 3 files changed, 2 insertions(+), 26 deletions(-) delete mode 100644 Std/Lean/InfoTree.lean diff --git a/Std.lean b/Std.lean index 5085b56362..bc62ce54af 100644 --- a/Std.lean +++ b/Std.lean @@ -52,7 +52,6 @@ import Std.Lean.Format import Std.Lean.HashMap import Std.Lean.HashSet import Std.Lean.IO.Process -import Std.Lean.InfoTree import Std.Lean.Json import Std.Lean.LocalContext import Std.Lean.Meta.AssertHypotheses diff --git a/Std/CodeAction/Basic.lean b/Std/CodeAction/Basic.lean index 7302aaa9c5..d15e086f86 100644 --- a/Std/CodeAction/Basic.lean +++ b/Std/CodeAction/Basic.lean @@ -5,7 +5,7 @@ Authors: Mario Carneiro -/ import Lean.Elab.BuiltinTerm import Lean.Elab.BuiltinNotation -import Std.Lean.InfoTree +import Lean.Server.InfoUtils import Std.CodeAction.Attr /-! @@ -213,7 +213,7 @@ A code action which calls all `@[command_code_action]` code actions on each comm let doc ← readDoc let startPos := doc.meta.text.lspPosToUtf8Pos params.range.start let endPos := doc.meta.text.lspPosToUtf8Pos params.range.end - have cmds := snap.infoTree.foldInfo' (init := #[]) fun ctx node result => Id.run do + have cmds := snap.infoTree.foldInfoTree (init := #[]) fun ctx node result => Id.run do let .node (.ofCommandInfo info) _ := node | result let (some head, some tail) := (info.stx.getPos? true, info.stx.getTailPos? true) | result unless head ≤ endPos && startPos ≤ tail do return result diff --git a/Std/Lean/InfoTree.lean b/Std/Lean/InfoTree.lean deleted file mode 100644 index d69450d575..0000000000 --- a/Std/Lean/InfoTree.lean +++ /dev/null @@ -1,23 +0,0 @@ -/- -Copyright (c) 2023 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. - -Authors: Mario Carneiro --/ -import Lean.Elab.InfoTree.Main - -namespace Lean.Elab - -/-- Like `InfoTree.foldInfo`, but also passes the whole node to `f` instead of just the head. -/ -partial def InfoTree.foldInfo' (init : α) (f : ContextInfo → InfoTree → α → α) : InfoTree → α := - go none init -where - /-- `foldInfo'.go` is like `foldInfo'` but with an additional outer context parameter `ctx?`. -/ - go ctx? a - | context ctx t => go (ctx.mergeIntoOuter? ctx?) a t - | t@(node i ts) => - let a := match ctx? with - | none => a - | some ctx => f ctx t a - ts.foldl (init := a) (go <| i.updateContext? ctx?) - | _ => a From c6ad8220b7ca6360caae161158fa9b7f8736d032 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 8 Feb 2024 00:08:22 +1100 Subject: [PATCH 007/213] chore: Lean.Elab.InfoTree.foldInfo' moved to core (#598) * chore: Lean.Elab.InfoTree.foldInfo' moved to core * toolchain --- Std.lean | 1 - Std/CodeAction/Basic.lean | 4 ++-- Std/Lean/InfoTree.lean | 23 ----------------------- lean-toolchain | 2 +- 4 files changed, 3 insertions(+), 27 deletions(-) delete mode 100644 Std/Lean/InfoTree.lean diff --git a/Std.lean b/Std.lean index 5085b56362..bc62ce54af 100644 --- a/Std.lean +++ b/Std.lean @@ -52,7 +52,6 @@ import Std.Lean.Format import Std.Lean.HashMap import Std.Lean.HashSet import Std.Lean.IO.Process -import Std.Lean.InfoTree import Std.Lean.Json import Std.Lean.LocalContext import Std.Lean.Meta.AssertHypotheses diff --git a/Std/CodeAction/Basic.lean b/Std/CodeAction/Basic.lean index 7302aaa9c5..d15e086f86 100644 --- a/Std/CodeAction/Basic.lean +++ b/Std/CodeAction/Basic.lean @@ -5,7 +5,7 @@ Authors: Mario Carneiro -/ import Lean.Elab.BuiltinTerm import Lean.Elab.BuiltinNotation -import Std.Lean.InfoTree +import Lean.Server.InfoUtils import Std.CodeAction.Attr /-! @@ -213,7 +213,7 @@ A code action which calls all `@[command_code_action]` code actions on each comm let doc ← readDoc let startPos := doc.meta.text.lspPosToUtf8Pos params.range.start let endPos := doc.meta.text.lspPosToUtf8Pos params.range.end - have cmds := snap.infoTree.foldInfo' (init := #[]) fun ctx node result => Id.run do + have cmds := snap.infoTree.foldInfoTree (init := #[]) fun ctx node result => Id.run do let .node (.ofCommandInfo info) _ := node | result let (some head, some tail) := (info.stx.getPos? true, info.stx.getTailPos? true) | result unless head ≤ endPos && startPos ≤ tail do return result diff --git a/Std/Lean/InfoTree.lean b/Std/Lean/InfoTree.lean deleted file mode 100644 index d69450d575..0000000000 --- a/Std/Lean/InfoTree.lean +++ /dev/null @@ -1,23 +0,0 @@ -/- -Copyright (c) 2023 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. - -Authors: Mario Carneiro --/ -import Lean.Elab.InfoTree.Main - -namespace Lean.Elab - -/-- Like `InfoTree.foldInfo`, but also passes the whole node to `f` instead of just the head. -/ -partial def InfoTree.foldInfo' (init : α) (f : ContextInfo → InfoTree → α → α) : InfoTree → α := - go none init -where - /-- `foldInfo'.go` is like `foldInfo'` but with an additional outer context parameter `ctx?`. -/ - go ctx? a - | context ctx t => go (ctx.mergeIntoOuter? ctx?) a t - | t@(node i ts) => - let a := match ctx? with - | none => a - | some ctx => f ctx t a - ts.foldl (init := a) (go <| i.updateContext? ctx?) - | _ => a diff --git a/lean-toolchain b/lean-toolchain index 7f89b25bf0..e862a0b958 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-05 +leanprover/lean4:nightly-2024-02-07 From f2601b580ece394beee51782e9314b7226a680b8 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Thu, 8 Feb 2024 09:15:05 +0000 Subject: [PATCH 008/213] chore: bump to nightly-2024-02-08 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index e862a0b958..c23b3e7191 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-07 +leanprover/lean4:nightly-2024-02-08 From 909e5ff9a1196299c40bbe6ea0d5b2819ccb49fd Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 8 Feb 2024 20:39:43 +1100 Subject: [PATCH 009/213] chore: update for nightly-2024-02-08 --- Std.lean | 2 -- Std/Data/Json.lean | 80 ----------------------------------------- Std/Lean/Format.lean | 19 ---------- Std/Lean/Name.lean | 14 +------- Std/Lean/Syntax.lean | 9 ----- Std/Tactic/TryThis.lean | 4 +-- test/json.lean | 4 +-- 7 files changed, 3 insertions(+), 129 deletions(-) delete mode 100644 Std/Data/Json.lean delete mode 100644 Std/Lean/Format.lean diff --git a/Std.lean b/Std.lean index 2ce78fd8f3..07b67c34e4 100644 --- a/Std.lean +++ b/Std.lean @@ -26,7 +26,6 @@ import Std.Data.DList import Std.Data.Fin import Std.Data.HashMap import Std.Data.Int -import Std.Data.Json import Std.Data.List import Std.Data.MLList import Std.Data.Nat @@ -48,7 +47,6 @@ import Std.Lean.Elab.Tactic import Std.Lean.Except import Std.Lean.Expr import Std.Lean.Float -import Std.Lean.Format import Std.Lean.HashMap import Std.Lean.HashSet import Std.Lean.IO.Process diff --git a/Std/Data/Json.lean b/Std/Data/Json.lean deleted file mode 100644 index 95486cd148..0000000000 --- a/Std/Data/Json.lean +++ /dev/null @@ -1,80 +0,0 @@ -/- - Copyright (c) 2022 E.W.Ayers. All rights reserved. - Released under Apache 2.0 license as described in the file LICENSE. - Authors: E.W.Ayers, Wojciech Nawrocki --/ -import Lean.Data.Json.FromToJson -import Lean.Syntax - -/-! -# JSON-like syntax for Lean. - -Now you can write - -```lean -open Std.Json - -#eval json% { - hello : "world", - cheese : ["edam", "cheddar", {kind : "spicy", rank : 100.2}], - lemonCount : 100e30, - isCool : true, - isBug : null, - lookACalc: $(23 + 54 * 2) -} -``` --/ - -namespace Std.Json -open Lean - -/-- Json syntactic category -/ -declare_syntax_cat jso (behavior := symbol) -/-- Json null value syntax. -/ -syntax "null" : jso -/-- Json true value syntax. -/ -syntax "true" : jso -/-- Json false value syntax. -/ -syntax "false" : jso -/-- Json string syntax. -/ -syntax str : jso -/-- Json number negation syntax for ordinary numbers. -/ -syntax "-"? num : jso -/-- Json number negation syntax for scientific numbers. -/ -syntax "-"? scientific : jso -/-- Json array syntax. -/ -syntax "[" jso,* "]" : jso -/-- Json identifier syntax. -/ -syntax jsoIdent := ident <|> str -/-- Json key/value syntax. -/ -syntax jsoField := jsoIdent ": " jso -/-- Json object syntax. -/ -syntax "{" jsoField,* "}" : jso -/-- Allows to use Json syntax in a Lean file. -/ -syntax "json% " jso : term - - -macro_rules - | `(json% null) => `(Lean.Json.null) - | `(json% true) => `(Lean.Json.bool Bool.true) - | `(json% false) => `(Lean.Json.bool Bool.false) - | `(json% $n:str) => `(Lean.Json.str $n) - | `(json% $n:num) => `(Lean.Json.num $n) - | `(json% $n:scientific) => `(Lean.Json.num $n) - | `(json% -$n:num) => `(Lean.Json.num (-$n)) - | `(json% -$n:scientific) => `(Lean.Json.num (-$n)) - | `(json% [$[$xs],*]) => `(Lean.Json.arr #[$[json% $xs],*]) - | `(json% {$[$ks:jsoIdent : $vs:jso],*}) => do - let ks : Array (TSyntax `term) ← ks.mapM fun - | `(jsoIdent| $k:ident) => pure (k.getId |> toString |> quote) - | `(jsoIdent| $k:str) => pure k - | _ => Macro.throwUnsupported - `(Lean.Json.mkObj [$[($ks, json% $vs)],*]) - | `(json% $stx) => - if stx.raw.isAntiquot then - let stx := ⟨stx.raw.getAntiquotTerm⟩ - `(Lean.toJson $stx) - else - Macro.throwUnsupported - -end Std.Json diff --git a/Std/Lean/Format.lean b/Std/Lean/Format.lean deleted file mode 100644 index 3f23b01d72..0000000000 --- a/Std/Lean/Format.lean +++ /dev/null @@ -1,19 +0,0 @@ -/- -Copyright (c) 2023 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro --/ -import Std.Tactic.OpenPrivate - -namespace Std.Format - -open private State State.mk State.out from Init.Data.Format.Basic in -/-- -Renders a `Format` to a string. Similar to `Format.pretty`, but with additional options: -* `w`: the total width -* `indent`: the initial indentation -* `column`: the initial column for the first line --/ -def prettyExtra (f : Format) (w : Nat := defWidth) (indent : Nat := 0) (column := 0) : String := - let act : StateM State Unit := prettyM f w indent - State.out <| act (State.mk "" column) |>.snd diff --git a/Std/Lean/Name.lean b/Std/Lean/Name.lean index 3427a8ab8e..b3705e6a2e 100644 --- a/Std/Lean/Name.lean +++ b/Std/Lean/Name.lean @@ -3,22 +3,10 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ +import Lean.Data.Name namespace Lean.Name -/-- Returns true if the name has any numeric components. -/ -def hasNum : Name → Bool - | .anonymous => false - | .str p _ => p.hasNum - | .num _ _ => true - -/-- The frontend does not allow user declarations to start with `_` in any of its parts. - We use name parts starting with `_` internally to create auxiliary names (e.g., `_private`). -/ -def isInternalOrNum : Name → Bool - | .str p s => s.get 0 == '_' || isInternalOrNum p - | .num _ _ => true - | _ => false - /-- Returns true if this a part of name that is internal or dynamically generated so that it may easily be changed. diff --git a/Std/Lean/Syntax.lean b/Std/Lean/Syntax.lean index 5fa6e341b0..ab91bfe64c 100644 --- a/Std/Lean/Syntax.lean +++ b/Std/Lean/Syntax.lean @@ -19,12 +19,3 @@ Like `Syntax.replaceM` but for typed syntax. -/ def TSyntax.replaceM [Monad M] (f : Syntax → M (Option Syntax)) (stx : TSyntax k) : M (TSyntax k) := .mk <$> stx.1.replaceM f - -/-- -Constructs a typed separated array from elements. -The given array does not include the separators. - -Like `Syntax.SepArray.ofElems` but for typed syntax. --/ -def Syntax.TSepArray.ofElems {sep} (elems : Array (TSyntax k)) : TSepArray k sep := - .mk (SepArray.ofElems (sep := sep) elems).1 diff --git a/Std/Tactic/TryThis.lean b/Std/Tactic/TryThis.lean index 752a9e3d02..865aaea851 100644 --- a/Std/Tactic/TryThis.lean +++ b/Std/Tactic/TryThis.lean @@ -6,9 +6,7 @@ Authors: Gabriel Ebner, Mario Carneiro, Thomas Murrills import Lean.Server.CodeActions import Lean.Widget.UserWidget import Std.Lean.Name -import Std.Lean.Format import Std.Lean.Position -import Std.Data.Json import Std.Lean.Syntax /-! @@ -207,7 +205,7 @@ def prettyExtra (s : SuggestionText) (w : Option Nat := none) match s with | .tsyntax (kind := kind) stx => do let w ← match w with | none => do pure <| getInputWidth (← getOptions) | some n => pure n - return (← ppCategory kind stx).prettyExtra w indent column + return (← ppCategory kind stx).pretty w indent column | .string text => return text end SuggestionText diff --git a/test/json.lean b/test/json.lean index a08834e437..63df684c34 100644 --- a/test/json.lean +++ b/test/json.lean @@ -1,7 +1,5 @@ import Std.Tactic.GuardMsgs -import Std.Data.Json - -open scoped Std.Json +import Lean.Data.Json.Elab /-- info: {"lookACalc": 131, "lemonCount": 100000000000000000000000000000000, From 2102b16325760aa0a23dc587e7a553a8cce2d1d3 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 9 Feb 2024 09:15:15 +0000 Subject: [PATCH 010/213] chore: bump to nightly-2024-02-09 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index c23b3e7191..4d2a3908d0 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-08 +leanprover/lean4:nightly-2024-02-09 From f88512d5b8993bf6315fdf257af6e4f6f5236f05 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 9 Feb 2024 21:14:16 +1100 Subject: [PATCH 011/213] updates for nightly-2024-02-09 --- Std.lean | 5 -- Std/Classes/Cast.lean | 1 - Std/Classes/Dvd.lean | 12 --- Std/Data/Array.lean | 1 - Std/Data/Array/Basic.lean | 1 - Std/Data/Array/Init/Basic.lean | 40 --------- Std/Data/Array/Init/Lemmas.lean | 2 - Std/Data/Array/Lemmas.lean | 7 +- Std/Data/Int/Basic.lean | 1 - Std/Data/Int/Order.lean | 1 - Std/Data/List/Lemmas.lean | 2 +- Std/Data/Nat/Basic.lean | 1 - Std/Data/Range/Lemmas.lean | 1 - Std/Lean/LocalContext.lean | 49 ----------- Std/Lean/Meta/Basic.lean | 93 --------------------- Std/Lean/Tactic.lean | 17 ---- Std/Logic.lean | 1 - Std/Tactic/Basic.lean | 1 - Std/Tactic/ByCases.lean | 83 ------------------ Std/Tactic/CoeExt.lean | 144 -------------------------------- Std/Tactic/Init.lean | 1 - Std/Tactic/Lint/Misc.lean | 1 - Std/Tactic/Lint/TypeClass.lean | 1 - Std/Tactic/NormCast.lean | 2 - Std/Tactic/NormCast/Ext.lean | 3 +- Std/Tactic/Simpa.lean | 1 - test/by_cases.lean | 11 --- test/coe.lean | 5 +- 28 files changed, 8 insertions(+), 480 deletions(-) delete mode 100644 Std/Classes/Dvd.lean delete mode 100644 Std/Data/Array/Init/Basic.lean delete mode 100644 Std/Lean/LocalContext.lean delete mode 100644 Std/Lean/Tactic.lean delete mode 100644 Std/Tactic/ByCases.lean delete mode 100644 Std/Tactic/CoeExt.lean delete mode 100644 test/by_cases.lean diff --git a/Std.lean b/Std.lean index 07b67c34e4..3c23edc732 100644 --- a/Std.lean +++ b/Std.lean @@ -1,6 +1,5 @@ import Std.Classes.BEq import Std.Classes.Cast -import Std.Classes.Dvd import Std.Classes.LawfulMonad import Std.Classes.Order import Std.Classes.RatCast @@ -51,7 +50,6 @@ import Std.Lean.HashMap import Std.Lean.HashSet import Std.Lean.IO.Process import Std.Lean.Json -import Std.Lean.LocalContext import Std.Lean.Meta.AssertHypotheses import Std.Lean.Meta.Basic import Std.Lean.Meta.Clear @@ -74,7 +72,6 @@ import Std.Lean.Position import Std.Lean.SMap import Std.Lean.Syntax import Std.Lean.System.IO -import Std.Lean.Tactic import Std.Lean.TagAttribute import Std.Lean.Util.EnvSearch import Std.Lean.Util.Path @@ -84,11 +81,9 @@ import Std.Linter.UnreachableTactic import Std.Logic import Std.Tactic.Alias import Std.Tactic.Basic -import Std.Tactic.ByCases import Std.Tactic.Case import Std.Tactic.Change import Std.Tactic.Classical -import Std.Tactic.CoeExt import Std.Tactic.Congr import Std.Tactic.Exact import Std.Tactic.Ext diff --git a/Std/Classes/Cast.lean b/Std/Classes/Cast.lean index 3404fbc488..9adeb6ebe0 100644 --- a/Std/Classes/Cast.lean +++ b/Std/Classes/Cast.lean @@ -3,7 +3,6 @@ Copyright (c) 2014 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Gabriel Ebner -/ -import Std.Tactic.CoeExt import Std.Util.LibraryNote /-- Type class for the canonical homomorphism `Nat → R`. -/ diff --git a/Std/Classes/Dvd.lean b/Std/Classes/Dvd.lean deleted file mode 100644 index cbbcd72247..0000000000 --- a/Std/Classes/Dvd.lean +++ /dev/null @@ -1,12 +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 --/ - -/-- Notation typeclass for the `∣` operation (typed as `\|`), which represents divisibility. -/ -class Dvd (α : Type _) where - /-- Divisibility. `a ∣ b` (typed as `\|`) means that there is some `c` such that `b = a * c`. -/ - dvd : α → α → Prop - -@[inherit_doc] infix:50 " ∣ " => Dvd.dvd diff --git a/Std/Data/Array.lean b/Std/Data/Array.lean index f32f416e07..4d95900523 100644 --- a/Std/Data/Array.lean +++ b/Std/Data/Array.lean @@ -1,5 +1,4 @@ import Std.Data.Array.Basic -import Std.Data.Array.Init.Basic import Std.Data.Array.Init.Lemmas import Std.Data.Array.Lemmas import Std.Data.Array.Match diff --git a/Std/Data/Array/Basic.lean b/Std/Data/Array/Basic.lean index 04975b66a2..c52d77d949 100644 --- a/Std/Data/Array/Basic.lean +++ b/Std/Data/Array/Basic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Floris van Doorn, Jannis Limperg -/ import Std.Data.List.Init.Attach -import Std.Data.Array.Init.Basic import Std.Data.Ord /-! diff --git a/Std/Data/Array/Init/Basic.lean b/Std/Data/Array/Init/Basic.lean deleted file mode 100644 index 5b44d9227d..0000000000 --- a/Std/Data/Array/Init/Basic.lean +++ /dev/null @@ -1,40 +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 --/ - -/-! -## Bootstrapping definitions about arrays - -This file contains some definitions in `Array` needed for `Std.List.Basic`. --/ - -namespace Array - -/-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/ -def zipWithIndex (arr : Array α) : Array (α × Nat) := - arr.mapIdx fun i a => (a, i) - -/-- Like `as.toList ++ l`, but in a single pass. -/ -@[inline] def toListAppend (as : Array α) (l : List α) : List α := - as.foldr List.cons l - -/-- -`ofFn f` with `f : Fin n → α` returns the list whose ith element is `f i`. -``` -ofFn f = #[f 0, f 1, ... , f(n - 1)] -``` -/ -def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where - /-- Auxiliary for `ofFn`. `ofFn.go f i acc = acc ++ #[f i, ..., f(n - 1)]` -/ - go (i : Nat) (acc : Array α) : Array α := - if h : i < n then go (i+1) (acc.push (f ⟨i, h⟩)) else acc -termination_by n - i - -/-- The array `#[0, 1, ..., n - 1]`. -/ -def range (n : Nat) : Array Nat := - n.fold (flip Array.push) #[] - -/-- Turns `#[#[a₁, a₂, ⋯], #[b₁, b₂, ⋯], ⋯]` into `#[a₁, a₂, ⋯, b₁, b₂, ⋯]` -/ -def flatten (arr : Array (Array α)) : Array α := - arr.foldl (init := #[]) fun acc a => acc.append a diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index 01d6358ccc..5111234976 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -5,12 +5,10 @@ Authors: Mario Carneiro -/ import Std.Tactic.NoMatch import Std.Tactic.HaveI -import Std.Tactic.ByCases import Std.Classes.LawfulMonad import Std.Data.Fin.Init.Lemmas import Std.Data.Nat.Init.Lemmas import Std.Data.List.Init.Lemmas -import Std.Data.Array.Init.Basic /-! ## Bootstrapping theorems about arrays diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 101a85889d..73339b7d5c 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -314,9 +314,10 @@ theorem size_eq_length_data (as : Array α) : as.size = as.data.length := rfl @[simp] theorem size_range {n : Nat} : (range n).size = n := by unfold range - induction n with - | zero => simp only [Nat.fold, size_toArray, List.length_nil, Nat.zero_eq] - | succ k ih => simp only [Nat.fold, flip, size_push, ih] + sorry + -- induction n with + -- | zero => simp only [Nat.fold, size_toArray, List.length_nil, Nat.zero_eq] + -- | succ k ih => simp only [Nat.fold, flip, size_push, ih] theorem size_modifyM [Monad m] [LawfulMonad m] (a : Array α) (i : Nat) (f : α → m α) : SatisfiesM (·.size = a.size) (a.modifyM i f) := by diff --git a/Std/Data/Int/Basic.lean b/Std/Data/Int/Basic.lean index ee38a18e55..c483dd63c6 100644 --- a/Std/Data/Int/Basic.lean +++ b/Std/Data/Int/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Classes.Dvd import Lean.ToExpr open Nat diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index e2534e641e..c63ffe80f1 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -6,7 +6,6 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro import Std.Data.Int.Lemmas import Std.Data.Option.Basic import Std.Tactic.RCases -import Std.Tactic.ByCases /-! # Results about the order properties of the integers, and the integers as an ordered ring. diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 67a776074f..b91f3d4ccb 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -414,7 +414,7 @@ fun s => Subset.trans s <| subset_append_right _ _ l₁ ++ l₂ ⊆ l ↔ l₁ ⊆ l ∧ l₂ ⊆ l := by simp [subset_def, or_imp, forall_and] theorem subset_nil {l : List α} : l ⊆ [] ↔ l = [] := - ⟨fun h => match l with | [] => rfl | _::_ => nomatch h (.head ..), fun | rfl => Subset.refl _⟩ + ⟨fun h => match l with | [] => rfl | _::_ => (nomatch h (.head ..)), fun | rfl => Subset.refl _⟩ theorem map_subset {l₁ l₂ : List α} (f : α → β) (H : l₁ ⊆ l₂) : map f l₁ ⊆ map f l₂ := fun x => by simp only [mem_map]; exact .imp fun a => .imp_left (@H _) diff --git a/Std/Data/Nat/Basic.lean b/Std/Data/Nat/Basic.lean index 9a861fdf18..f72796e1b9 100644 --- a/Std/Data/Nat/Basic.lean +++ b/Std/Data/Nat/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ -import Std.Classes.Dvd namespace Nat diff --git a/Std/Data/Range/Lemmas.lean b/Std/Data/Range/Lemmas.lean index 958d074a6d..76bc082c3c 100644 --- a/Std/Data/Range/Lemmas.lean +++ b/Std/Data/Range/Lemmas.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.ByCases import Std.Tactic.SeqFocus import Std.Data.List.Lemmas import Std.Data.List.Init.Attach diff --git a/Std/Lean/LocalContext.lean b/Std/Lean/LocalContext.lean deleted file mode 100644 index 94f8781306..0000000000 --- a/Std/Lean/LocalContext.lean +++ /dev/null @@ -1,49 +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, Jannis Limperg --/ -import Lean.LocalContext - -namespace Lean - -/-- -Set the kind of a `LocalDecl`. --/ -def LocalDecl.setKind : LocalDecl → LocalDeclKind → LocalDecl - | cdecl index fvarId userName type bi _, kind => - cdecl index fvarId userName type bi kind - | ldecl index fvarId userName type value nonDep _, kind => - ldecl index fvarId userName type value nonDep kind - -namespace LocalContext - -/-- -Given an `FVarId`, this function returns the corresponding user name, -but only if the name can be used to recover the original FVarId. --/ -def getRoundtrippingUserName? (lctx : LocalContext) (fvarId : FVarId) : Option Name := do - let ldecl₁ ← lctx.find? fvarId - let ldecl₂ ← lctx.findFromUserName? ldecl₁.userName - guard <| ldecl₁.fvarId == ldecl₂.fvarId - some ldecl₁.userName - -/-- -Set the kind of the given fvar. --/ -def setKind (lctx : LocalContext) (fvarId : FVarId) - (kind : LocalDeclKind) : LocalContext := - lctx.modifyLocalDecl fvarId (·.setKind kind) - -/-- -Sort the given `FVarId`s by the order in which they appear in `lctx`. If any of -the `FVarId`s do not appear in `lctx`, the result is unspecified. --/ -def sortFVarsByContextOrder (lctx : LocalContext) (hyps : Array FVarId) : Array FVarId := - let hyps := hyps.map fun fvarId => - match lctx.fvarIdToDecl.find? fvarId with - | none => (0, fvarId) - | some ldecl => (ldecl.index, fvarId) - hyps.qsort (fun h i => h.fst < i.fst) |>.map (·.snd) - -end LocalContext diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index b594d2099c..b24de4566c 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -6,7 +6,6 @@ Authors: Mario Carneiro, Jannis Limperg import Lean.Elab.Term import Lean.Meta.Tactic.Apply import Lean.Meta.Tactic.Replace -import Std.Lean.LocalContext open Lean Lean.Meta @@ -77,49 +76,6 @@ def eraseExprMVarAssignment (mctx : MetavarContext) (mvarId : MVarId) : eAssignment := mctx.eAssignment.erase mvarId dAssignment := mctx.dAssignment.erase mvarId } -/-- -Modify the declaration of a metavariable. If the metavariable is not declared, -the `MetavarContext` is returned unchanged. - -You must ensure that the modification is legal. In particular, expressions may -only be replaced with defeq expressions. --/ -def modifyExprMVarDecl (mctx : MetavarContext) (mvarId : MVarId) - (f : MetavarDecl → MetavarDecl) : MetavarContext := - if let some mdecl := mctx.decls.find? mvarId then - { mctx with decls := mctx.decls.insert mvarId (f mdecl) } - else - mctx - -/-- -Modify the local context of a metavariable. If the metavariable is not declared, -the `MetavarContext` is returned unchanged. - -You must ensure that the modification is legal. In particular, expressions may -only be replaced with defeq expressions. --/ -def modifyExprMVarLCtx (mctx : MetavarContext) (mvarId : MVarId) - (f : LocalContext → LocalContext) : MetavarContext := - mctx.modifyExprMVarDecl mvarId fun mdecl => { mdecl with lctx := f mdecl.lctx } - -/-- -Set the kind of an fvar. If the given metavariable is not declared or the -given fvar doesn't exist in its context, the `MetavarContext` is returned -unchanged. --/ -def setFVarKind (mctx : MetavarContext) (mvarId : MVarId) (fvarId : FVarId) - (kind : LocalDeclKind) : MetavarContext := - mctx.modifyExprMVarLCtx mvarId (·.setKind fvarId kind) - -/-- -Set the `BinderInfo` of an fvar. If the given metavariable is not declared or -the given fvar doesn't exist in its context, the `MetavarContext` is returned -unchanged. --/ -def setFVarBinderInfo (mctx : MetavarContext) (mvarId : MVarId) - (fvarId : FVarId) (bi : BinderInfo) : MetavarContext := - mctx.modifyExprMVarLCtx mvarId (·.setBinderInfo fvarId bi) - /-- Obtain all unassigned metavariables from the given `MetavarContext`. If `includeDelayed` is `true`, delayed-assigned metavariables are considered @@ -139,17 +95,6 @@ end MetavarContext namespace MVarId -/-- -Check whether a metavariable is assigned or delayed-assigned. A -delayed-assigned metavariable is already 'solved' but the solution cannot be -substituted yet because we have to wait for some other metavariables to be -assigned first. So in most situations you want to treat a delayed-assigned -metavariable as assigned. --/ -def isAssignedOrDelayedAssigned [Monad m] [MonadMCtx m] (mvarId : MVarId) : - m Bool := - return (← getMCtx).isExprMVarAssignedOrDelayedAssigned mvarId - /-- Check whether a metavariable is declared. -/ @@ -170,44 +115,6 @@ Erase any assignment or delayed assignment of the given metavariable. def eraseAssignment [MonadMCtx m] (mvarId : MVarId) : m Unit := modifyMCtx (·.eraseExprMVarAssignment mvarId) -/-- -Modify the declaration of a metavariable. If the metavariable is not declared, -nothing happens. - -You must ensure that the modification is legal. In particular, expressions may -only be replaced with defeq expressions. --/ -def modifyDecl [MonadMCtx m] (mvarId : MVarId) - (f : MetavarDecl → MetavarDecl) : m Unit := - modifyMCtx (·.modifyExprMVarDecl mvarId f) - -/-- -Modify the local context of a metavariable. If the metavariable is not declared, -nothing happens. - -You must ensure that the modification is legal. In particular, expressions may -only be replaced with defeq expressions. --/ -def modifyLCtx [MonadMCtx m] (mvarId : MVarId) - (f : LocalContext → LocalContext) : m Unit := - modifyMCtx (·.modifyExprMVarLCtx mvarId f) - -/-- -Set the kind of an fvar. If the given metavariable is not declared or the -given fvar doesn't exist in its context, nothing happens. --/ -def setFVarKind [MonadMCtx m] (mvarId : MVarId) (fvarId : FVarId) - (kind : LocalDeclKind) : m Unit := - modifyMCtx (·.setFVarKind mvarId fvarId kind) - -/-- -Set the `BinderInfo` of an fvar. If the given metavariable is not declared or -the given fvar doesn't exist in its context, nothing happens. --/ -def setFVarBinderInfo [MonadMCtx m] (mvarId : MVarId) (fvarId : FVarId) - (bi : BinderInfo) : m Unit := - modifyMCtx (·.setFVarBinderInfo mvarId fvarId bi) - /-- Collect the metavariables which `mvarId` depends on. These are the metavariables which appear in the type and local context of `mvarId`, as well as the diff --git a/Std/Lean/Tactic.lean b/Std/Lean/Tactic.lean deleted file mode 100644 index a6f7d8f895..0000000000 --- a/Std/Lean/Tactic.lean +++ /dev/null @@ -1,17 +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 --/ -import Lean.Elab.Tactic.Basic - -namespace Lean.Elab.Tactic - -/-- -Like `evalTacticAt`, but without restoring the goal list or pruning solved goals. -Useful when these tasks are already being done in an outer loop. --/ -def evalTacticAtRaw (tac : Syntax) (mvarId : MVarId) : TacticM (List MVarId) := do - setGoals [mvarId] - evalTactic tac - getGoals diff --git a/Std/Logic.lean b/Std/Logic.lean index 16270b835e..049743a8b8 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -7,7 +7,6 @@ import Std.Tactic.Init import Std.Tactic.NoMatch import Std.Tactic.Alias import Std.Tactic.Lint.Misc -import Std.Tactic.ByCases instance {f : α → β} [DecidablePred p] : DecidablePred (p ∘ f) := inferInstanceAs <| DecidablePred fun x => p (f x) diff --git a/Std/Tactic/Basic.lean b/Std/Tactic/Basic.lean index 9872a7361d..cd6dfff0bd 100644 --- a/Std/Tactic/Basic.lean +++ b/Std/Tactic/Basic.lean @@ -1,6 +1,5 @@ import Lean.Elab.Tactic.ElabTerm import Std.Linter -import Std.Tactic.ByCases import Std.Tactic.Init import Std.Tactic.NoMatch import Std.Tactic.SeqFocus diff --git a/Std/Tactic/ByCases.lean b/Std/Tactic/ByCases.lean deleted file mode 100644 index 1fb5495e36..0000000000 --- a/Std/Tactic/ByCases.lean +++ /dev/null @@ -1,83 +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 --/ -import Lean.Parser.Tactic - -/-! -# `by_cases` and `if then else` tactics - -This implements the `if` tactic, which is a structured proof version of `by_cases`. -It allows writing `if h : t then tac1 else tac2` for case analysis on `h : t`, --/ -open Lean Parser.Tactic - --- This is an improved version of `by_cases` from core that uses `Decidable` if possible -macro_rules | `(tactic| by_cases $e) => `(tactic| by_cases h : $e) -macro_rules - | `(tactic| by_cases $h : $e) => - `(tactic| open Classical in refine if $h:ident : $e then ?pos else ?neg) - -private def expandIfThenElse - (ifTk thenTk elseTk pos neg : Syntax) - (mkIf : Term → Term → MacroM Term) : MacroM (TSyntax `tactic) := do - let mkCase tk holeOrTacticSeq mkName : MacroM (Term × Array (TSyntax `tactic)) := do - if holeOrTacticSeq.isOfKind ``Parser.Term.syntheticHole then - pure (⟨holeOrTacticSeq⟩, #[]) - else if holeOrTacticSeq.isOfKind ``Parser.Term.hole then - pure (← mkName, #[]) - else - let hole ← withFreshMacroScope mkName - let holeId := hole.raw[1] - let case ← (open TSyntax.Compat in `(tactic| - case $holeId:ident =>%$tk - -- annotate `then/else` with state after `case` - with_annotate_state $tk skip - $holeOrTacticSeq)) - pure (hole, #[case]) - let (posHole, posCase) ← mkCase thenTk pos `(?pos) - let (negHole, negCase) ← mkCase elseTk neg `(?neg) - `(tactic| (open Classical in refine%$ifTk $(← mkIf posHole negHole); $[$(posCase ++ negCase)]*)) - -/-- -In tactic mode, `if h : t then tac1 else tac2` can be used as alternative syntax for: -``` -by_cases h : t -· tac1 -· tac2 -``` -It performs case distinction on `h : t` or `h : ¬t` and `tac1` and `tac2` are the subproofs. - -You can use `?_` or `_` for either subproof to delay the goal to after the tactic, but -if a tactic sequence is provided for `tac1` or `tac2` then it will require the goal to be closed -by the end of the block. --/ -syntax (name := tacDepIfThenElse) - ppRealGroup(ppRealFill(ppIndent("if " binderIdent " : " term " then") ppSpace matchRhs) - ppDedent(ppSpace) ppRealFill("else " matchRhs)) : tactic - -/-- -In tactic mode, `if t then tac1 else tac2` is alternative syntax for: -``` -by_cases t -· tac1 -· tac2 -``` -It performs case distinction on `h† : t` or `h† : ¬t`, where `h†` is an anonymous -hypothesis, and `tac1` and `tac2` are the subproofs. (It doesn't actually use -nondependent `if`, since this wouldn't add anything to the context and hence would be -useless for proving theorems. To actually insert an `ite` application use -`refine if t then ?_ else ?_`.) --/ -syntax (name := tacIfThenElse) - ppRealGroup(ppRealFill(ppIndent("if " term " then") ppSpace matchRhs) - ppDedent(ppSpace) ppRealFill("else " matchRhs)) : tactic - -macro_rules - | `(tactic| if%$tk $h : $c then%$ttk $pos else%$etk $neg) => - expandIfThenElse tk ttk etk pos neg fun pos neg => `(if $h : $c then $pos else $neg) - -macro_rules - | `(tactic| if%$tk $c then%$ttk $pos else%$etk $neg) => - expandIfThenElse tk ttk etk pos neg fun pos neg => `(if h : $c then $pos else $neg) diff --git a/Std/Tactic/CoeExt.lean b/Std/Tactic/CoeExt.lean deleted file mode 100644 index 8f5508f617..0000000000 --- a/Std/Tactic/CoeExt.lean +++ /dev/null @@ -1,144 +0,0 @@ -/- -Copyright (c) 2022 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro --/ -import Lean.PrettyPrinter.Delaborator.Builtins - -open Lean Elab.Term Meta Std - -/-! -# The `@[coe]` attribute, used to delaborate coercion functions as `↑` - -When writing a coercion, if the pattern -``` -@[coe] -def A.toB (a : A) : B := sorry - -instance : Coe A B where coe := A.toB -``` -is used, then `A.toB a` will be pretty-printed as `↑a`. - -This file also provides `⇑f` and `↥t` notation, which are syntax for `Lean.Meta.coerceToFunction?` -and `Lean.Meta.coerceToSort?` respectively. --/ - -namespace Std.Tactic.Coe - -/-- `⇑ t` coerces `t` to a function. -/ --- the precendence matches that of `coeNotation` -elab:1024 (name := coeFunNotation) "⇑" m:term:1024 : term => do - let x ← elabTerm m none - if let some ty ← coerceToFunction? x then - return ty - else - throwError "cannot coerce to function{indentExpr x}" - -/-- `↥ t` coerces `t` to a type. -/ -elab:1024 (name := coeSortNotation) "↥" t:term:1024 : term => do - let x ← elabTerm t none - if let some ty ← coerceToSort? x then - return ty - else - throwError "cannot coerce to sort{indentExpr x}" - -/-- The different types of coercions that are supported by the `coe` attribute. -/ -inductive CoeFnType - /-- The basic coercion `↑x`, see `CoeT.coe` -/ - | coe - /-- The coercion to a function type, see `CoeFun.coe` -/ - | coeFun - /-- The coercion to a type, see `CoeSort.coe` -/ - | coeSort - deriving Inhabited, Repr, DecidableEq - -instance : ToExpr CoeFnType where - toTypeExpr := mkConst ``CoeFnType - toExpr := open CoeFnType in fun - | coe => mkConst ``coe - | coeFun => mkConst ``coeFun - | coeSort => mkConst ``coeSort - -/-- Information associated to a coercion function to enable sensible delaboration. -/ -structure CoeFnInfo where - /-- The number of arguments to the coercion function -/ - numArgs : Nat - /-- The argument index that represents the value being coerced -/ - coercee : Nat - /-- The type of coercion -/ - type : CoeFnType - deriving Inhabited, Repr - -instance : ToExpr CoeFnInfo where - toTypeExpr := mkConst ``CoeFnInfo - toExpr | ⟨a, b, c⟩ => mkApp3 (mkConst ``CoeFnInfo.mk) (toExpr a) (toExpr b) (toExpr c) - -/-- The environment extension for tracking coercion functions for delaboration -/ -initialize coeExt : SimpleScopedEnvExtension (Name × CoeFnInfo) (NameMap CoeFnInfo) ← - registerSimpleScopedEnvExtension { - addEntry := fun st (n, i) => st.insert n i - initial := {} - } - -/-- Lookup the coercion information for a given function -/ -def getCoeFnInfo? (fn : Name) : CoreM (Option CoeFnInfo) := - return (coeExt.getState (← getEnv)).find? fn - -open PrettyPrinter.Delaborator SubExpr - -/-- -This delaborator tries to elide functions which are known coercions. -For example, `Int.ofNat` is a coercion, so instead of printing `ofNat n` we just print `↑n`, -and when re-parsing this we can (usually) recover the specific coercion being used. --/ -def coeDelaborator (info : CoeFnInfo) : Delab := whenPPOption getPPCoercions do - let n := (← getExpr).getAppNumArgs - withOverApp info.numArgs do - match info.type with - | .coe => `(↑$(← withNaryArg info.coercee delab)) - | .coeFun => - if n = info.numArgs then - `(⇑$(← withNaryArg info.coercee delab)) - else - withNaryArg info.coercee delab - | .coeSort => `(↥$(← withNaryArg info.coercee delab)) - -/-- Add a coercion delaborator for the given function. -/ -def addCoeDelaborator (name : Name) (info : CoeFnInfo) : MetaM Unit := do - let delabName := name ++ `delaborator - addAndCompile <| Declaration.defnDecl { - name := delabName - levelParams := [] - type := mkConst ``Delab - value := mkApp (mkConst ``coeDelaborator) (toExpr info) - hints := .opaque - safety := .safe - } - let kind := `app ++ name - Attribute.add delabName `delab (Unhygienic.run `(attr| delab $(mkIdent kind):ident)) - -/-- Add `name` to the coercion extension and add a coercion delaborator for the function. -/ -def registerCoercion (name : Name) (info : Option CoeFnInfo := none) : MetaM Unit := do - let info ← match info with | some info => pure info | none => do - let fnInfo ← getFunInfo (← mkConstWithLevelParams name) - let some coercee := fnInfo.paramInfo.findIdx? (·.binderInfo.isExplicit) - | throwError "{name} has no explicit arguments" - pure { numArgs := coercee + 1, coercee, type := .coe } - modifyEnv (coeExt.addEntry · (name, info)) - addCoeDelaborator name info - -/-- -The `@[coe]` attribute on a function (which should also appear in a -`instance : Coe A B := ⟨myFn⟩` declaration) allows the delaborator to show -applications of this function as `↑` when printing expressions. --/ -syntax (name := Attr.coe) "coe" : attr - -initialize registerBuiltinAttribute { - name := `coe - descr := "Adds a definition as a coercion" - add := fun decl _stx kind => MetaM.run' do - unless kind == .global do - throwError "cannot add local or scoped coe attribute" - registerCoercion decl -} diff --git a/Std/Tactic/Init.lean b/Std/Tactic/Init.lean index 075e179ed8..22101a7127 100644 --- a/Std/Tactic/Init.lean +++ b/Std/Tactic/Init.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Std.Tactic.GuardExpr import Std.Lean.Meta.Basic -import Std.Lean.Tactic /-! # Simple tactics that are used throughout Std. diff --git a/Std/Tactic/Lint/Misc.lean b/Std/Tactic/Lint/Misc.lean index 77773eb5a7..8eb2bbce9a 100644 --- a/Std/Tactic/Lint/Misc.lean +++ b/Std/Tactic/Lint/Misc.lean @@ -6,7 +6,6 @@ Authors: Floris van Doorn, Robert Y. Lewis, Arthur Paulino, Gabriel Ebner import Lean.Util.CollectLevelParams import Lean.Meta.ForEachExpr import Std.Tactic.Lint.Basic -import Std.Data.Array.Init.Basic open Lean Meta diff --git a/Std/Tactic/Lint/TypeClass.lean b/Std/Tactic/Lint/TypeClass.lean index 61fbca5ff8..c6a92cd36c 100644 --- a/Std/Tactic/Lint/TypeClass.lean +++ b/Std/Tactic/Lint/TypeClass.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner -/ import Std.Tactic.Lint.Basic -import Std.Data.Array.Init.Basic namespace Std.Tactic.Lint open Lean Meta diff --git a/Std/Tactic/NormCast.lean b/Std/Tactic/NormCast.lean index 0dafd4770a..e79a0971a6 100644 --- a/Std/Tactic/NormCast.lean +++ b/Std/Tactic/NormCast.lean @@ -6,7 +6,6 @@ Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner import Lean.Elab.Tactic.Conv.Simp import Std.Lean.Meta.Simp import Std.Tactic.NormCast.Ext -import Std.Tactic.CoeExt import Std.Classes.Cast /-! @@ -15,7 +14,6 @@ import Std.Classes.Cast open Lean Meta Simp open Std.Tactic.NormCast -open Std.Tactic.Coe namespace Std.Tactic.NormCast diff --git a/Std/Tactic/NormCast/Ext.lean b/Std/Tactic/NormCast/Ext.lean index d85f3f7745..b43ae5bad2 100644 --- a/Std/Tactic/NormCast/Ext.lean +++ b/Std/Tactic/NormCast/Ext.lean @@ -3,14 +3,13 @@ Copyright (c) 2019 Paul-Nicolas Madelaine. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner -/ +import Lean.Meta.CoeAttr import Lean.Meta.CongrTheorems import Lean.Meta.Tactic.Simp.SimpTheorems -import Std.Tactic.CoeExt open Lean Meta namespace Std.Tactic.NormCast -open Tactic.Coe /-- `Label` is a type used to classify `norm_cast` lemmas. diff --git a/Std/Tactic/Simpa.lean b/Std/Tactic/Simpa.lean index e2a6bb1fdd..b50b740388 100644 --- a/Std/Tactic/Simpa.lean +++ b/Std/Tactic/Simpa.lean @@ -6,7 +6,6 @@ Authors: Arthur Paulino, Gabriel Ebner, Mario Carneiro import Lean.Meta.Tactic.Assumption import Lean.Elab.Tactic.Simp import Lean.Linter.Util -import Std.Lean.LocalContext import Std.Lean.Parser import Std.Tactic.OpenPrivate import Std.Tactic.TryThis diff --git a/test/by_cases.lean b/test/by_cases.lean deleted file mode 100644 index b2ad2bfec2..0000000000 --- a/test/by_cases.lean +++ /dev/null @@ -1,11 +0,0 @@ -import Std.Tactic.ByCases - -example : True := by - if 1 + 1 = 2 then _ else ?_ - case pos => trivial - fail_if_success case neg => contradiction - · contradiction - -example (p : Prop) : True := by - if p then ?foo else trivial - case foo => trivial diff --git a/test/coe.lean b/test/coe.lean index afca989c24..6a52129da0 100644 --- a/test/coe.lean +++ b/test/coe.lean @@ -1,4 +1,3 @@ -import Std.Tactic.CoeExt import Std.Tactic.GuardMsgs set_option linter.missingDocs false @@ -17,10 +16,10 @@ structure WrappedType where attribute [coe] WrappedNat.val instance : Coe WrappedNat Nat where coe := WrappedNat.val -#eval Std.Tactic.Coe.registerCoercion ``WrappedFun.fn (some ⟨2, 1, .coeFun⟩) +#eval Lean.Meta.registerCoercion ``WrappedFun.fn (some ⟨2, 1, .coeFun⟩) instance : CoeFun (WrappedFun α) (fun _ => Nat → α) where coe := WrappedFun.fn -#eval Std.Tactic.Coe.registerCoercion ``WrappedType.typ (some ⟨1, 0, .coeSort⟩) +#eval Lean.Meta.registerCoercion ``WrappedType.typ (some ⟨1, 0, .coeSort⟩) instance : CoeSort WrappedType Type where coe := WrappedType.typ section coe From c9d399d9f917f3647e3a52bc775314be29f22f42 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 9 Feb 2024 23:20:50 +1100 Subject: [PATCH 012/213] nomatch --- Std.lean | 1 - Std/Classes/LawfulMonad.lean | 2 +- Std/Data/Array/Init/Lemmas.lean | 3 +- Std/Data/Array/Lemmas.lean | 6 +-- Std/Data/Array/Match.lean | 2 +- Std/Data/Fin/Lemmas.lean | 4 +- Std/Data/HashMap/WF.lean | 4 +- Std/Data/Int/Lemmas.lean | 6 +-- Std/Data/Int/Order.lean | 2 +- Std/Data/List/Basic.lean | 5 +-- Std/Data/List/Init/Lemmas.lean | 4 +- Std/Data/List/Lemmas.lean | 10 ++--- Std/Data/Nat/Lemmas.lean | 4 +- Std/Data/Option/Basic.lean | 3 +- Std/Data/Option/Lemmas.lean | 6 +-- Std/Data/PairingHeap.lean | 2 +- Std/Data/RBMap/Alter.lean | 16 ++++---- Std/Data/RBMap/Lemmas.lean | 8 ++-- Std/Data/RBMap/WF.lean | 16 ++++---- Std/Data/Rat/Basic.lean | 2 +- Std/Data/Sum/Basic.lean | 6 +-- Std/Data/Sum/Lemmas.lean | 4 +- Std/Logic.lean | 5 +-- Std/Tactic/Basic.lean | 1 - Std/Tactic/NoMatch.lean | 65 --------------------------------- 25 files changed, 58 insertions(+), 129 deletions(-) delete mode 100644 Std/Tactic/NoMatch.lean diff --git a/Std.lean b/Std.lean index 3c23edc732..925a4d2f27 100644 --- a/Std.lean +++ b/Std.lean @@ -103,7 +103,6 @@ import Std.Tactic.Lint.Frontend import Std.Tactic.Lint.Misc import Std.Tactic.Lint.Simp import Std.Tactic.Lint.TypeClass -import Std.Tactic.NoMatch import Std.Tactic.NormCast import Std.Tactic.NormCast.Ext import Std.Tactic.NormCast.Lemmas diff --git a/Std/Classes/LawfulMonad.lean b/Std/Classes/LawfulMonad.lean index ca1a603e24..fa45dd7988 100644 --- a/Std/Classes/LawfulMonad.lean +++ b/Std/Classes/LawfulMonad.lean @@ -224,7 +224,7 @@ theorem SatisfiesM_StateRefT_eq [Monad m] : @[simp] theorem SatisfiesM_ExceptT_eq [Monad m] [LawfulMonad m] : SatisfiesM (m := ExceptT ρ m) (α := α) p x ↔ SatisfiesM (m := m) (∀ a, · = .ok a → p a) x := by refine ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, eq⟩ => eq ▸ ?_⟩ - · exists (fun | .ok ⟨a, h⟩ => ⟨.ok a, fun | _, rfl => h⟩ | .error e => ⟨.error e, fun.⟩) <$> f + · exists (fun | .ok ⟨a, h⟩ => ⟨.ok a, fun | _, rfl => h⟩ | .error e => ⟨.error e, nofun⟩) <$> f show _ = _ >>= _; rw [← comp_map, map_eq_pure_bind]; congr; funext a; cases a <;> rfl · exists ((fun | ⟨.ok a, h⟩ => .ok ⟨a, h _ rfl⟩ | ⟨.error e, _⟩ => .error e) <$> f : m _) show _ >>= _ = _; simp [← comp_map, map_eq_pure_bind]; congr; funext ⟨a, h⟩; cases a <;> rfl diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index 5111234976..5833f80ea3 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.NoMatch import Std.Tactic.HaveI import Std.Classes.LawfulMonad import Std.Data.Fin.Init.Lemmas @@ -164,7 +163,7 @@ theorem SatisfiesM_mapM [Monad m] [LawfulMonad m] (as : Array α) (f : α → m refine SatisfiesM_foldlM (m := m) (β := Array β) (motive := fun i arr => motive i ∧ arr.size = i ∧ ∀ i h2, p i (arr[i.1]'h2)) ?z ?s |>.imp fun ⟨h₁, eq, h₂⟩ => ⟨h₁, eq, fun _ _ => h₂ ..⟩ - · case z => exact ⟨h0, rfl, fun.⟩ + · case z => exact ⟨h0, rfl, nofun⟩ · case s => intro ⟨i, hi⟩ arr ⟨ih₁, eq, ih₂⟩ refine (hs _ ih₁).map fun ⟨h₁, h₂⟩ => ⟨h₂, by simp [eq], fun j hj => ?_⟩ diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 73339b7d5c..fc7047fb89 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -46,7 +46,7 @@ attribute [simp] isEmpty uget theorem mem_data {a : α} {l : Array α} : a ∈ l.data ↔ a ∈ l := (mem_def _ _).symm -theorem not_mem_nil (a : α) : ¬ a ∈ #[] := fun. +theorem not_mem_nil (a : α) : ¬ a ∈ #[] := nofun /-- # set -/ @@ -271,7 +271,7 @@ theorem SatisfiesM_mapIdxM [Monad m] [LawfulMonad m] (as : Array α) (f : Fin as simp at hi'; simp [get_push]; split · next h => exact h₂ _ _ h · next h => cases h₁.symm ▸ (Nat.le_or_eq_of_le_succ hi').resolve_left h; exact hb.1 - simp [mapIdxM]; exact go rfl (fun.) h0 + simp [mapIdxM]; exact go rfl (nofun) h0 theorem mapIdx_induction (as : Array α) (f : Fin as.size → α → β) (motive : Nat → Prop) (h0 : motive 0) @@ -401,7 +401,7 @@ termination_by n - i @[simp] theorem getElem_ofFn (f : Fin n → α) (i : Nat) (h) : (ofFn f)[i] = f ⟨i, size_ofFn f ▸ h⟩ := - getElem_ofFn_go _ _ _ (by simp) (by simp) fun. + getElem_ofFn_go _ _ _ (by simp) (by simp) nofun theorem forIn_eq_data_forIn [Monad m] (as : Array α) (b : β) (f : α → β → m (ForInStep β)) : diff --git a/Std/Data/Array/Match.lean b/Std/Data/Array/Match.lean index f5ff981777..5a2962d44a 100644 --- a/Std/Data/Array/Match.lean +++ b/Std/Data/Array/Match.lean @@ -18,7 +18,7 @@ structure PrefixTable (α : Type _) extends Array (α × Nat) where valid : (h : i < toArray.size) → toArray[i].2 ≤ i instance : Inhabited (PrefixTable α) where - default := ⟨#[], fun.⟩ + default := ⟨#[], nofun⟩ /-- Returns the size of the prefix table -/ abbrev PrefixTable.size (t : PrefixTable α) := t.toArray.size diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 51b30c152d..ac766e07c5 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -116,7 +116,7 @@ theorem mk_le_of_le_val {b : Fin n} {a : Nat} (h : a ≤ b) : theorem zero_lt_one : (0 : Fin (n + 2)) < 1 := Nat.zero_lt_one -@[simp] theorem not_lt_zero (a : Fin (n + 1)) : ¬a < 0 := fun. +@[simp] theorem not_lt_zero (a : Fin (n + 1)) : ¬a < 0 := nofun theorem pos_iff_ne_zero {a : Fin (n + 1)} : 0 < a ↔ a ≠ 0 := by rw [lt_def, val_zero, Nat.pos_iff_ne_zero, ← val_ne_iff]; rfl @@ -174,7 +174,7 @@ theorem val_lt_last {i : Fin (n + 1)} : i ≠ last n → (i : Nat) < n := theorem subsingleton_iff_le_one : Subsingleton (Fin n) ↔ n ≤ 1 := by (match n with | 0 | 1 | n+2 => ?_) <;> try simp - · exact ⟨fun.⟩ + · exact ⟨nofun⟩ · exact ⟨fun ⟨0, _⟩ ⟨0, _⟩ => rfl⟩ · exact iff_of_false (fun h => Fin.ne_of_lt zero_lt_one (h.elim ..)) (of_decide_eq_false rfl) diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index 82f1f9758e..06378b19da 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -80,7 +80,7 @@ theorem expand_size [Hashable α] {buckets : Buckets α β} : (expand sz buckets).buckets.size = buckets.size := by rw [expand, go] · rw [Buckets.mk_size]; simp [Buckets.size] - · intro. + · nofun where go (i source) (target : Buckets α β) (hs : ∀ j < i, source.data.getD j .nil = .nil) : (expand.go i source target).size = @@ -159,7 +159,7 @@ where | .inl hl => exact hs₁ _ hl | .inr e => exact e ▸ .nil · simp [Array.getElem_eq_data_get, List.get_set]; split - · intro. + · nofun · exact hs₂ _ (by simp_all) · let rank (k : α) := ((hash k).toUSize % source.size).toNat have := expand_WF.foldl rank ?_ (hs₂ _ H) ht.1 (fun _ h₁ _ h₂ => ?_) diff --git a/Std/Data/Int/Lemmas.lean b/Std/Data/Int/Lemmas.lean index 6ef85425f9..e4faa67afa 100644 --- a/Std/Data/Int/Lemmas.lean +++ b/Std/Data/Int/Lemmas.lean @@ -22,7 +22,7 @@ theorem ofNat_two : ((2 : Nat) : Int) = 2 := rfl @[simp] theorem default_eq_zero : default = (0 : Int) := rfl -protected theorem zero_ne_one : (0 : Int) ≠ 1 := fun. +protected theorem zero_ne_one : (0 : Int) ≠ 1 := nofun /- ## Definitions of basic functions -/ @@ -75,9 +75,9 @@ theorem negSucc_inj : negSucc m = negSucc n ↔ m = n := ⟨negSucc.inj, fun H = theorem negSucc_eq (n : Nat) : -[n+1] = -((n : Int) + 1) := rfl -@[simp] theorem negSucc_ne_zero (n : Nat) : -[n+1] ≠ 0 := fun. +@[simp] theorem negSucc_ne_zero (n : Nat) : -[n+1] ≠ 0 := nofun -@[simp] theorem zero_ne_negSucc (n : Nat) : 0 ≠ -[n+1] := fun. +@[simp] theorem zero_ne_negSucc (n : Nat) : 0 ≠ -[n+1] := nofun @[simp, norm_cast] theorem Nat.cast_ofNat_Int : (Nat.cast (no_index (OfNat.ofNat n)) : Int) = OfNat.ofNat n := rfl diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index c63ffe80f1..2e4420d991 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -994,7 +994,7 @@ theorem toNat_add_nat {a : Int} (ha : 0 ≤ a) (n : Nat) : (a + n).toNat = a.toN theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm - | -[m+1], n => by constructor <;> intro. + | -[m+1], n => by constructor <;> nofun @[simp] theorem toNat_neg_nat : ∀ n : Nat, (-(n : Int)).toNat = 0 | 0 => rfl diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index 42c32c7955..37bd012a46 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ import Std.Classes.SetNotation -import Std.Tactic.NoMatch import Std.Data.Option.Init.Lemmas import Std.Data.Array.Init.Lemmas @@ -265,7 +264,7 @@ instance : HasSubset (List α) := ⟨List.Subset⟩ instance decidableBEx (p : α → Prop) [DecidablePred p] : ∀ l : List α, Decidable (∃ x ∈ l, p x) - | [] => isFalse fun. + | [] => isFalse nofun | x :: xs => if h₁ : p x then isTrue ⟨x, .head .., h₁⟩ else match decidableBEx p xs with @@ -276,7 +275,7 @@ instance decidableBEx (p : α → Prop) [DecidablePred p] : instance decidableBAll (p : α → Prop) [DecidablePred p] : ∀ l : List α, Decidable (∀ x ∈ l, p x) - | [] => isTrue fun. + | [] => isTrue nofun | x :: xs => if h₁ : p x then match decidableBAll p xs with diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean index c78b28ee90..e651829492 100644 --- a/Std/Data/List/Init/Lemmas.lean +++ b/Std/Data/List/Init/Lemmas.lean @@ -55,7 +55,7 @@ theorem length_eq_zero : length l = 0 ↔ l = [] := /-! ### mem -/ -@[simp] theorem not_mem_nil (a : α) : ¬ a ∈ [] := fun. +@[simp] theorem not_mem_nil (a : α) : ¬ a ∈ [] := nofun @[simp] theorem mem_cons : a ∈ (b :: l) ↔ a = b ∨ a ∈ l := ⟨fun h => by cases h <;> simp [Membership.mem, *], @@ -223,7 +223,7 @@ theorem getLast?_eq_getLast : ∀ l h, @getLast? α l = some (getLast l h) theorem getLast?_eq_get? : ∀ (l : List α), getLast? l = l.get? (l.length - 1) | [] => rfl - | a::l => by rw [getLast?_eq_getLast (a::l) fun., getLast_eq_get, get?_eq_get] + | a::l => by rw [getLast?_eq_getLast (a::l) nofun, getLast_eq_get, get?_eq_get] @[simp] theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by simp [getLast?_eq_get?, Nat.succ_sub_succ] diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index b91f3d4ccb..3271ecd1ef 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -18,7 +18,7 @@ open Nat /-! # Basic properties of Lists -/ -theorem cons_ne_nil (a : α) (l : List α) : a :: l ≠ [] := fun. +theorem cons_ne_nil (a : α) (l : List α) : a :: l ≠ [] := nofun theorem cons_ne_self (a : α) (l : List α) : a :: l ≠ l := mt (congrArg length) (Nat.succ_ne_self _) @@ -75,7 +75,7 @@ theorem mem_of_mem_cons_of_mem : ∀ {a b : α} {l : List α}, a ∈ b :: l → theorem eq_or_ne_mem_of_mem {a b : α} {l : List α} (h' : a ∈ b :: l) : a = b ∨ (a ≠ b ∧ a ∈ l) := (Classical.em _).imp_right fun h => ⟨h, (mem_cons.1 h').resolve_left h⟩ -theorem ne_nil_of_mem {a : α} {l : List α} (h : a ∈ l) : l ≠ [] := by cases h <;> intro. +theorem ne_nil_of_mem {a : α} {l : List α} (h : a ∈ l) : l ≠ [] := by cases h <;> nofun theorem append_of_mem {a : α} {l : List α} : a ∈ l → ∃ s t : List α, l = s ++ a :: t | .head l => ⟨[], l, rfl⟩ @@ -355,9 +355,9 @@ theorem bind_map (f : β → γ) (g : α → List β) : /-! ### bounded quantifiers over Lists -/ -theorem exists_mem_nil (p : α → Prop) : ¬∃ x ∈ @nil α, p x := fun. +theorem exists_mem_nil (p : α → Prop) : ¬∃ x ∈ @nil α, p x := nofun -theorem forall_mem_nil (p : α → Prop) : ∀ x ∈ @nil α, p x := fun. +theorem forall_mem_nil (p : α → Prop) : ∀ x ∈ @nil α, p x := nofun theorem exists_mem_cons {p : α → Prop} {a : α} {l : List α} : (∃ x ∈ a :: l, p x) ↔ p a ∨ ∃ x ∈ l, p x := by simp @@ -373,7 +373,7 @@ theorem forall_mem_append {p : α → Prop} {l₁ l₂ : List α} : theorem subset_def {l₁ l₂ : List α} : l₁ ⊆ l₂ ↔ ∀ {a : α}, a ∈ l₁ → a ∈ l₂ := .rfl -@[simp] theorem nil_subset (l : List α) : [] ⊆ l := fun. +@[simp] theorem nil_subset (l : List α) : [] ⊆ l := nofun @[simp] theorem Subset.refl (l : List α) : l ⊆ l := fun _ i => i diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index 25bf8830ff..02c094ebc5 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -329,7 +329,7 @@ theorem le_succ_of_pred_le : pred n ≤ m → n ≤ succ m := pred_le_iff_le_suc theorem pred_le_of_le_succ : n ≤ succ m → pred n ≤ m := pred_le_iff_le_succ.2 theorem lt_pred_iff_succ_lt : ∀ {n m}, n < pred m ↔ succ n < m - | _, 0 => ⟨fun ., fun .⟩ + | _, 0 => ⟨nofun, nofun⟩ | _, _+1 => Nat.succ_lt_succ_iff.symm theorem succ_lt_of_lt_pred : n < pred m → succ n < m := lt_pred_iff_succ_lt.1 @@ -770,7 +770,7 @@ protected theorem two_mul (n) : 2 * n = n + n := by rw [Nat.succ_mul, Nat.one_mu theorem mul_eq_zero : ∀ {m n}, n * m = 0 ↔ n = 0 ∨ m = 0 | 0, _ => ⟨fun _ => .inr rfl, fun _ => rfl⟩ | _, 0 => ⟨fun _ => .inl rfl, fun _ => Nat.zero_mul ..⟩ - | _+1, _+1 => ⟨fun., fun.⟩ + | _+1, _+1 => ⟨nofun, nofun⟩ protected theorem mul_ne_zero_iff : n * m ≠ 0 ↔ n ≠ 0 ∧ m ≠ 0 := by rw [ne_eq, mul_eq_zero, not_or] diff --git a/Std/Data/Option/Basic.lean b/Std/Data/Option/Basic.lean index 92ea519057..644e2bcd61 100644 --- a/Std/Data/Option/Basic.lean +++ b/Std/Data/Option/Basic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Classes.SetNotation -import Std.Tactic.NoMatch namespace Option @@ -40,7 +39,7 @@ instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (∀ else isFalse <| mt (· _ rfl) h instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (∃ a ∈ o, p a) -| none => isFalse fun. +| none => isFalse nofun | some a => if h : p a then isTrue ⟨_, rfl, h⟩ else isFalse fun ⟨_, ⟨rfl, hn⟩⟩ => h hn /-- Extracts the value `a` from an option that is known to be `some a` for some `a`. -/ diff --git a/Std/Data/Option/Lemmas.lean b/Std/Data/Option/Lemmas.lean index 65eda678c7..fea0a04c28 100644 --- a/Std/Data/Option/Lemmas.lean +++ b/Std/Data/Option/Lemmas.lean @@ -12,7 +12,7 @@ namespace Option theorem mem_iff {a : α} {b : Option α} : a ∈ b ↔ b = a := .rfl -theorem some_ne_none (x : α) : some x ≠ none := fun. +theorem some_ne_none (x : α) : some x ≠ none := nofun protected theorem «forall» {p : Option α → Prop} : (∀ x, p x) ↔ p none ∧ ∀ x, p (some x) := ⟨fun h => ⟨h _, fun _ => h _⟩, fun h x => Option.casesOn x h.1 h.2⟩ @@ -27,7 +27,7 @@ theorem get_mem : ∀ {o : Option α} (h : isSome o), o.get h ∈ o theorem get_of_mem : ∀ {o : Option α} (h : isSome o), a ∈ o → o.get h = a | _, _, rfl => rfl -theorem not_mem_none (a : α) : a ∉ (none : Option α) := fun. +theorem not_mem_none (a : α) : a ∉ (none : Option α) := nofun @[simp] theorem some_get : ∀ {x : Option α} (h : isSome x), some (x.get h) = x | some _, _ => rfl @@ -65,7 +65,7 @@ theorem isSome_iff_exists : isSome x ↔ ∃ a, x = some a := by cases x <;> sim cases a <;> simp theorem eq_some_iff_get_eq : o = some a ↔ ∃ h : o.isSome, o.get h = a := by - cases o <;> simp; intro. + cases o <;> simp; nofun theorem eq_some_of_isSome : ∀ {o : Option α} (h : o.isSome), o = some (o.get h) | some _, _ => rfl diff --git a/Std/Data/PairingHeap.lean b/Std/Data/PairingHeap.lean index fbcdcdcb7f..312b9e3f59 100644 --- a/Std/Data/PairingHeap.lean +++ b/Std/Data/PairingHeap.lean @@ -86,7 +86,7 @@ instance : Decidable (Heap.NoSibling s) := match s with | .nil => isTrue .nil | .node a c .nil => isTrue (.node a c) - | .node _ _ (.node _ _ _) => isFalse fun. + | .node _ _ (.node _ _ _) => isFalse nofun theorem Heap.noSibling_merge (le) (s₁ s₂ : Heap α) : (s₁.merge le s₂).NoSibling := by diff --git a/Std/Data/RBMap/Alter.lean b/Std/Data/RBMap/Alter.lean index 2a13a8c5d8..a1584b9cfc 100644 --- a/Std/Data/RBMap/Alter.lean +++ b/Std/Data/RBMap/Alter.lean @@ -183,16 +183,16 @@ protected theorem Balanced.del {path : Path α} | red, ⟨_, h⟩ | black, ⟨_, _, h⟩ => exact h.setBlack | @redL _ n _ _ hb hp ih => match c', n, ht with | red, _, _ => cases hc rfl rfl - | black, _, ⟨_, rfl, ha⟩ => exact ih ((hb.balLeft ha).of_false (fun.)) (fun.) + | black, _, ⟨_, rfl, ha⟩ => exact ih ((hb.balLeft ha).of_false (nofun)) (nofun) | @redR _ n _ _ ha hp ih => match c', n, ht with | red, _, _ => cases hc rfl rfl - | black, _, ⟨_, rfl, hb⟩ => exact ih ((ha.balRight hb).of_false (fun.)) (fun.) + | black, _, ⟨_, rfl, hb⟩ => exact ih ((ha.balRight hb).of_false (nofun)) (nofun) | @blackL _ _ n _ _ _ hb hp ih => match c', n, ht with - | red, _, ⟨_, ha⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ (fun.) - | black, _, ⟨_, rfl, ha⟩ => exact ih ⟨_, rfl, (hb.balLeft ha).imp fun _ => ⟨⟩⟩ (fun.) + | red, _, ⟨_, ha⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ (nofun) + | black, _, ⟨_, rfl, ha⟩ => exact ih ⟨_, rfl, (hb.balLeft ha).imp fun _ => ⟨⟩⟩ (nofun) | @blackR _ _ n _ _ _ ha hp ih => match c', n, ht with - | red, _, ⟨_, hb⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ (fun.) - | black, _, ⟨_, rfl, hb⟩ => exact ih ⟨_, rfl, (ha.balRight hb).imp fun _ => ⟨⟩⟩ (fun.) + | red, _, ⟨_, hb⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ (nofun) + | black, _, ⟨_, rfl, hb⟩ => exact ih ⟨_, rfl, (ha.balRight hb).imp fun _ => ⟨⟩⟩ (nofun) /-- Asserts that `p` holds on all elements to the left of the hole. -/ def AllL (p : α → Prop) : Path α → Prop @@ -370,8 +370,8 @@ protected theorem Balanced.alter {t : RBNode α} have ⟨_, _, h, hp⟩ := h.zoom .root eq split · match h with - | .red ha hb => exact ⟨_, hp.del ((ha.append hb).of_false (· rfl rfl)) (fun.)⟩ - | .black ha hb => exact ⟨_, hp.del ⟨_, rfl, (ha.append hb).imp fun _ => ⟨⟩⟩ (fun.)⟩ + | .red ha hb => exact ⟨_, hp.del ((ha.append hb).of_false (· rfl rfl)) (nofun)⟩ + | .black ha hb => exact ⟨_, hp.del ⟨_, rfl, (ha.append hb).imp fun _ => ⟨⟩⟩ (nofun)⟩ · match h with | .red ha hb => exact ⟨_, _, hp.fill (.red ha hb)⟩ | .black ha hb => exact ⟨_, _, hp.fill (.black ha hb)⟩ diff --git a/Std/Data/RBMap/Lemmas.lean b/Std/Data/RBMap/Lemmas.lean index f9a00ab6e7..c5d5ca36ce 100644 --- a/Std/Data/RBMap/Lemmas.lean +++ b/Std/Data/RBMap/Lemmas.lean @@ -258,7 +258,7 @@ theorem lowerBound?_le' {t : RBNode α} (H : ∀ {x}, x ∈ lb → cut x ≠ .lt /-- The value `x` returned by `lowerBound?` is less or equal to the `cut`. -/ theorem lowerBound?_le {t : RBNode α} : t.lowerBound? cut none = some x → cut x ≠ .lt := - lowerBound?_le' (fun.) + lowerBound?_le' (nofun) theorem All.lowerBound?_lb {t : RBNode α} (hp : t.All p) (H : ∀ {x}, x ∈ lb → p x) : t.lowerBound? cut lb = some x → p x := by @@ -271,14 +271,14 @@ theorem All.lowerBound?_lb {t : RBNode α} (hp : t.All p) (H : ∀ {x}, x ∈ lb · exact fun | rfl => hp.1 theorem All.lowerBound? {t : RBNode α} (hp : t.All p) : t.lowerBound? cut none = some x → p x := - hp.lowerBound?_lb (fun.) + hp.lowerBound?_lb (nofun) theorem lowerBound?_mem_lb {t : RBNode α} (h : t.lowerBound? cut lb = some x) : x ∈ t ∨ x ∈ lb := All.lowerBound?_lb (p := fun x => x ∈ t ∨ x ∈ lb) (All_def.2 fun _ => .inl) Or.inr h theorem lowerBound?_mem {t : RBNode α} (h : t.lowerBound? cut none = some x) : x ∈ t := - (lowerBound?_mem_lb h).resolve_right (fun.) + (lowerBound?_mem_lb h).resolve_right (nofun) theorem lowerBound?_of_some {t : RBNode α} : ∃ x, t.lowerBound? cut (some y) = some x := by induction t generalizing y <;> simp [lowerBound?]; split <;> simp [*] @@ -328,7 +328,7 @@ strictly greater than the cut (so there is no exact match, and nothing closer to theorem Ordered.lowerBound?_least [@TransCmp α cmp] [IsCut cmp cut] (ht : Ordered cmp t) (H : t.lowerBound? cut none = some x) (hy : y ∈ t) (xy : cmp x y = .lt) (hx : cut x = .gt) : cut y = .lt := - ht.lowerBound?_least_lb (by exact fun.) H hy hx xy + ht.lowerBound?_least_lb (by exact nofun) H hy hx xy theorem Ordered.memP_iff_lowerBound? [@TransCmp α cmp] [IsCut cmp cut] (ht : Ordered cmp t) : t.MemP cut ↔ ∃ x, t.lowerBound? cut none = some x ∧ cut x = .eq := by diff --git a/Std/Data/RBMap/WF.lean b/Std/Data/RBMap/WF.lean index c786122429..fc0a0aa031 100644 --- a/Std/Data/RBMap/WF.lean +++ b/Std/Data/RBMap/WF.lean @@ -178,12 +178,12 @@ protected theorem RedRed.balance2 {l : RBNode α} {v : α} {r : RBNode α} /-- The `balance1` function does nothing if the first argument is already balanced. -/ theorem balance1_eq {l : RBNode α} {v : α} {r : RBNode α} (hl : l.Balanced c n) : balance1 l v r = node black l v r := by - unfold balance1; split <;> first | rfl | match hl with. + unfold balance1; split <;> first | rfl | nomatch hl /-- The `balance2` function does nothing if the second argument is already balanced. -/ theorem balance2_eq {l : RBNode α} {v : α} {r : RBNode α} (hr : r.Balanced c n) : balance2 l v r = node black l v r := by - unfold balance2; split <;> first | rfl | match hr with. + unfold balance2; split <;> first | rfl | nomatch hr /-! ## insert -/ @@ -356,10 +356,10 @@ protected theorem Balanced.append {l r : RBNode α} have ⟨_, IH⟩ := (hb.append hc).of_false (· rfl rfl); split · next e => have .red hb' hc' := e ▸ IH - exact .redred (fun.) (.red ha hb') (.red hc' hd) + exact .redred (nofun) (.red ha hb') (.red hc' hd) · next bcc _ H => match bcc, append b c, IH, H with - | black, _, IH, _ => exact .redred (fun.) ha (.red IH hd) + | black, _, IH, _ => exact .redred (nofun) ha (.red IH hd) | red, _, .red .., H => cases H _ _ _ rfl · next b c _ _ => have .black ha hb := hl; have .black hc hd := hr @@ -377,10 +377,10 @@ protected theorem Balanced.append {l r : RBNode α} | _, .redred .., H => cases H _ _ _ rfl · have .red hc hd := hr; have IH := hl.append hc have .black ha hb := hl; have ⟨c, IH⟩ := IH.of_false (· rfl rfl) - exact .redred (fun.) IH hd + exact .redred (nofun) IH hd · have .red ha hb := hl; have IH := hb.append hr have .black hc hd := hr; have ⟨c, IH⟩ := IH.of_false (· rfl rfl) - exact .redred (fun.) ha IH + exact .redred (nofun) ha IH termination_by l.size + r.size /-! ## erase -/ @@ -448,10 +448,10 @@ protected theorem Balanced.del {t : RBNode α} (h : t.Balanced c n) : unfold del; split · exact match a, n, iha with | .nil, _, _ => ⟨_, .red ha hb⟩ - | .node black .., _, ⟨n, rfl, ha⟩ => (hb.balLeft ha).of_false (fun.) + | .node black .., _, ⟨n, rfl, ha⟩ => (hb.balLeft ha).of_false nofun · exact match b, n, ihb with | .nil, _, _ => ⟨_, .red ha hb⟩ - | .node black .., _, ⟨n, rfl, hb⟩ => (ha.balRight hb).of_false (fun.) + | .node black .., _, ⟨n, rfl, hb⟩ => (ha.balRight hb).of_false nofun · exact (ha.append hb).of_false (· rfl rfl) /-- The `erase` function preserves the ordering invariants. -/ diff --git a/Std/Data/Rat/Basic.lean b/Std/Data/Rat/Basic.lean index db58c98f64..2aaaacccf7 100644 --- a/Std/Data/Rat/Basic.lean +++ b/Std/Data/Rat/Basic.lean @@ -97,7 +97,7 @@ instance : OfNat Rat n := ⟨n⟩ /-- Form the quotient `n / d` where `n d : Int`. -/ def divInt : Int → Int → Rat | n, .ofNat d => inline (mkRat n d) - | n, .negSucc d => normalize (-n) d.succ (fun.) + | n, .negSucc d => normalize (-n) d.succ (nofun) @[inherit_doc] scoped infixl:70 " /. " => Rat.divInt diff --git a/Std/Data/Sum/Basic.lean b/Std/Data/Sum/Basic.lean index ff585c1335..2d60f9ea1c 100644 --- a/Std/Data/Sum/Basic.lean +++ b/Std/Data/Sum/Basic.lean @@ -128,9 +128,9 @@ inductive LiftRel (r : α → γ → Prop) (s : β → δ → Prop) : α ⊕ β @[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) := fun. +@[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) := fun. +@[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⟩ @@ -165,7 +165,7 @@ attribute [simp] Lex.sep @[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) := fun. +@[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 diff --git a/Std/Data/Sum/Lemmas.lean b/Std/Data/Sum/Lemmas.lean index 81acc3cfda..2491660b1a 100644 --- a/Std/Data/Sum/Lemmas.lean +++ b/Std/Data/Sum/Lemmas.lean @@ -90,9 +90,9 @@ theorem inl.inj_iff : (inl a : α ⊕ β) = inl b ↔ a = b := ⟨inl.inj, congr theorem inr.inj_iff : (inr a : α ⊕ β) = inr b ↔ a = b := ⟨inr.inj, congrArg _⟩ -theorem inl_ne_inr : inl a ≠ inr b := fun. +theorem inl_ne_inr : inl a ≠ inr b := nofun -theorem inr_ne_inl : inr b ≠ inl a := fun. +theorem inr_ne_inl : inr b ≠ inl a := nofun /-! ### `Sum.elim` -/ diff --git a/Std/Logic.lean b/Std/Logic.lean index 049743a8b8..aa08fb3f0e 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn, Mario Carneiro -/ import Std.Tactic.Init -import Std.Tactic.NoMatch import Std.Tactic.Alias import Std.Tactic.Lint.Misc @@ -874,14 +873,14 @@ theorem ite_some_none_eq_none [Decidable P] : attribute [simp] inline /-- Ex falso, the nondependent eliminator for the `Empty` type. -/ -def Empty.elim : Empty → C := fun. +def Empty.elim : Empty → C := nofun instance : Subsingleton Empty := ⟨fun a => a.elim⟩ instance : DecidableEq Empty := fun a => a.elim /-- Ex falso, the nondependent eliminator for the `PEmpty` type. -/ -def PEmpty.elim : PEmpty → C := fun. +def PEmpty.elim : PEmpty → C := nofun instance : Subsingleton PEmpty := ⟨fun a => a.elim⟩ diff --git a/Std/Tactic/Basic.lean b/Std/Tactic/Basic.lean index cd6dfff0bd..0b21cf03f2 100644 --- a/Std/Tactic/Basic.lean +++ b/Std/Tactic/Basic.lean @@ -1,7 +1,6 @@ import Lean.Elab.Tactic.ElabTerm import Std.Linter import Std.Tactic.Init -import Std.Tactic.NoMatch import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm import Std.Tactic.SimpTrace diff --git a/Std/Tactic/NoMatch.lean b/Std/Tactic/NoMatch.lean deleted file mode 100644 index e168a2f560..0000000000 --- a/Std/Tactic/NoMatch.lean +++ /dev/null @@ -1,65 +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 --/ -import Std.Tactic.OpenPrivate -import Lean.Elab.Match -import Lean.Elab.ElabRules - -/-! -This adds support for the alternative syntax `match x with.` instead of `nomatch x`. It is more -powerful because it supports pattern matching on multiple discriminants, like regular `match`, and -simply has no alternatives in the match. - -Along the same lines, `fun.` is a nullary pattern matching function; it is equivalent to -`fun x y z => match x, y, z with.` where all variables are introduced in order to find an -impossible pattern. The `match x with.` and `intro.` tactics do the same thing but in tactic mode. --/ -namespace Std.Tactic -open Lean Elab Term Parser.Term - -/-- -The syntax `match x with.` is a variant of `nomatch x` which supports pattern matching on multiple -discriminants, like regular `match`, and simply has no alternatives in the match. --/ -syntax:lead (name := noMatch) "match " matchDiscr,* " with" "." : term - -open private elabMatchAux waitExpectedType from Lean.Elab.Match in -/-- Elaborator for `match x with.` -/ -@[term_elab noMatch] def elabNoMatch' : TermElab -| `(match $discrs,* with.), expectedType? => do - let discrs := discrs.getElems - for h : i in [0:discrs.size] do - have h : i < discrs.size := h.2 - let `(matchDiscr| $[$n :]? $discr:term) := discrs[i] | throwUnsupportedSyntax - if ← isAtomicDiscr discr then - tryPostponeIfMVar (← Meta.inferType (← elabTerm discr none)) - else - let discrs := discrs.set ⟨i, h⟩ (← `(matchDiscr| $[$n :]? ?x)) - return ← elabTerm (← `(let_mvar% ?x := $discr; match $discrs,* with.)) expectedType? - let expectedType ← waitExpectedType expectedType? - elabMatchAux none discrs #[] mkNullNode expectedType -| _, _ => throwUnsupportedSyntax - -/-- -The syntax `fun.` or `λ.` (dot required) is shorthand for an empty pattern match function, -i.e. `fun x y z => match x, y, z with.` for an appropriate number of arguments. --/ -elab (name := noFun) tk:"fun" "." : term <= expectedType => do - let (binders, discrs) ← (·.unzip) <$> - Meta.forallTelescopeReducing expectedType fun args _ => - args.mapM fun _ => withFreshMacroScope do - return ((⟨← `(a)⟩ : Ident), ← `(matchDiscr| a)) - elabTerm (← `(@fun%$tk $binders:ident* => match%$tk $discrs:matchDiscr,* with.)) expectedType - -@[inherit_doc noFun] macro tk:"λ" "." : term => `(fun%$tk .) - -@[inherit_doc noMatch] macro "match " discrs:matchDiscr,* " with" "." : tactic => - `(tactic| exact match $discrs,* with.) - -/-- -The tactic `intro.` is shorthand for `exact fun.`: it introduces the assumptions, then performs an -empty pattern match, closing the goal if the introduced pattern is impossible. --/ -macro "intro" "." : tactic => `(tactic| exact fun.) From fb427688ddd8f4796c157dc3a9f620672e6164f1 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 10 Feb 2024 12:47:35 +1100 Subject: [PATCH 013/213] chore: update for nightly-2024-02-08 (#605) Co-authored-by: Alex Keizer --- Std.lean | 2 -- Std/Data/Json.lean | 80 ----------------------------------------- Std/Lean/Format.lean | 19 ---------- Std/Lean/Name.lean | 14 +------- Std/Lean/Syntax.lean | 9 ----- Std/Tactic/TryThis.lean | 4 +-- lean-toolchain | 2 +- test/json.lean | 4 +-- 8 files changed, 4 insertions(+), 130 deletions(-) delete mode 100644 Std/Data/Json.lean delete mode 100644 Std/Lean/Format.lean diff --git a/Std.lean b/Std.lean index 2ce78fd8f3..07b67c34e4 100644 --- a/Std.lean +++ b/Std.lean @@ -26,7 +26,6 @@ import Std.Data.DList import Std.Data.Fin import Std.Data.HashMap import Std.Data.Int -import Std.Data.Json import Std.Data.List import Std.Data.MLList import Std.Data.Nat @@ -48,7 +47,6 @@ import Std.Lean.Elab.Tactic import Std.Lean.Except import Std.Lean.Expr import Std.Lean.Float -import Std.Lean.Format import Std.Lean.HashMap import Std.Lean.HashSet import Std.Lean.IO.Process diff --git a/Std/Data/Json.lean b/Std/Data/Json.lean deleted file mode 100644 index 95486cd148..0000000000 --- a/Std/Data/Json.lean +++ /dev/null @@ -1,80 +0,0 @@ -/- - Copyright (c) 2022 E.W.Ayers. All rights reserved. - Released under Apache 2.0 license as described in the file LICENSE. - Authors: E.W.Ayers, Wojciech Nawrocki --/ -import Lean.Data.Json.FromToJson -import Lean.Syntax - -/-! -# JSON-like syntax for Lean. - -Now you can write - -```lean -open Std.Json - -#eval json% { - hello : "world", - cheese : ["edam", "cheddar", {kind : "spicy", rank : 100.2}], - lemonCount : 100e30, - isCool : true, - isBug : null, - lookACalc: $(23 + 54 * 2) -} -``` --/ - -namespace Std.Json -open Lean - -/-- Json syntactic category -/ -declare_syntax_cat jso (behavior := symbol) -/-- Json null value syntax. -/ -syntax "null" : jso -/-- Json true value syntax. -/ -syntax "true" : jso -/-- Json false value syntax. -/ -syntax "false" : jso -/-- Json string syntax. -/ -syntax str : jso -/-- Json number negation syntax for ordinary numbers. -/ -syntax "-"? num : jso -/-- Json number negation syntax for scientific numbers. -/ -syntax "-"? scientific : jso -/-- Json array syntax. -/ -syntax "[" jso,* "]" : jso -/-- Json identifier syntax. -/ -syntax jsoIdent := ident <|> str -/-- Json key/value syntax. -/ -syntax jsoField := jsoIdent ": " jso -/-- Json object syntax. -/ -syntax "{" jsoField,* "}" : jso -/-- Allows to use Json syntax in a Lean file. -/ -syntax "json% " jso : term - - -macro_rules - | `(json% null) => `(Lean.Json.null) - | `(json% true) => `(Lean.Json.bool Bool.true) - | `(json% false) => `(Lean.Json.bool Bool.false) - | `(json% $n:str) => `(Lean.Json.str $n) - | `(json% $n:num) => `(Lean.Json.num $n) - | `(json% $n:scientific) => `(Lean.Json.num $n) - | `(json% -$n:num) => `(Lean.Json.num (-$n)) - | `(json% -$n:scientific) => `(Lean.Json.num (-$n)) - | `(json% [$[$xs],*]) => `(Lean.Json.arr #[$[json% $xs],*]) - | `(json% {$[$ks:jsoIdent : $vs:jso],*}) => do - let ks : Array (TSyntax `term) ← ks.mapM fun - | `(jsoIdent| $k:ident) => pure (k.getId |> toString |> quote) - | `(jsoIdent| $k:str) => pure k - | _ => Macro.throwUnsupported - `(Lean.Json.mkObj [$[($ks, json% $vs)],*]) - | `(json% $stx) => - if stx.raw.isAntiquot then - let stx := ⟨stx.raw.getAntiquotTerm⟩ - `(Lean.toJson $stx) - else - Macro.throwUnsupported - -end Std.Json diff --git a/Std/Lean/Format.lean b/Std/Lean/Format.lean deleted file mode 100644 index 3f23b01d72..0000000000 --- a/Std/Lean/Format.lean +++ /dev/null @@ -1,19 +0,0 @@ -/- -Copyright (c) 2023 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro --/ -import Std.Tactic.OpenPrivate - -namespace Std.Format - -open private State State.mk State.out from Init.Data.Format.Basic in -/-- -Renders a `Format` to a string. Similar to `Format.pretty`, but with additional options: -* `w`: the total width -* `indent`: the initial indentation -* `column`: the initial column for the first line --/ -def prettyExtra (f : Format) (w : Nat := defWidth) (indent : Nat := 0) (column := 0) : String := - let act : StateM State Unit := prettyM f w indent - State.out <| act (State.mk "" column) |>.snd diff --git a/Std/Lean/Name.lean b/Std/Lean/Name.lean index 3427a8ab8e..b3705e6a2e 100644 --- a/Std/Lean/Name.lean +++ b/Std/Lean/Name.lean @@ -3,22 +3,10 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ +import Lean.Data.Name namespace Lean.Name -/-- Returns true if the name has any numeric components. -/ -def hasNum : Name → Bool - | .anonymous => false - | .str p _ => p.hasNum - | .num _ _ => true - -/-- The frontend does not allow user declarations to start with `_` in any of its parts. - We use name parts starting with `_` internally to create auxiliary names (e.g., `_private`). -/ -def isInternalOrNum : Name → Bool - | .str p s => s.get 0 == '_' || isInternalOrNum p - | .num _ _ => true - | _ => false - /-- Returns true if this a part of name that is internal or dynamically generated so that it may easily be changed. diff --git a/Std/Lean/Syntax.lean b/Std/Lean/Syntax.lean index 5fa6e341b0..ab91bfe64c 100644 --- a/Std/Lean/Syntax.lean +++ b/Std/Lean/Syntax.lean @@ -19,12 +19,3 @@ Like `Syntax.replaceM` but for typed syntax. -/ def TSyntax.replaceM [Monad M] (f : Syntax → M (Option Syntax)) (stx : TSyntax k) : M (TSyntax k) := .mk <$> stx.1.replaceM f - -/-- -Constructs a typed separated array from elements. -The given array does not include the separators. - -Like `Syntax.SepArray.ofElems` but for typed syntax. --/ -def Syntax.TSepArray.ofElems {sep} (elems : Array (TSyntax k)) : TSepArray k sep := - .mk (SepArray.ofElems (sep := sep) elems).1 diff --git a/Std/Tactic/TryThis.lean b/Std/Tactic/TryThis.lean index 752a9e3d02..865aaea851 100644 --- a/Std/Tactic/TryThis.lean +++ b/Std/Tactic/TryThis.lean @@ -6,9 +6,7 @@ Authors: Gabriel Ebner, Mario Carneiro, Thomas Murrills import Lean.Server.CodeActions import Lean.Widget.UserWidget import Std.Lean.Name -import Std.Lean.Format import Std.Lean.Position -import Std.Data.Json import Std.Lean.Syntax /-! @@ -207,7 +205,7 @@ def prettyExtra (s : SuggestionText) (w : Option Nat := none) match s with | .tsyntax (kind := kind) stx => do let w ← match w with | none => do pure <| getInputWidth (← getOptions) | some n => pure n - return (← ppCategory kind stx).prettyExtra w indent column + return (← ppCategory kind stx).pretty w indent column | .string text => return text end SuggestionText diff --git a/lean-toolchain b/lean-toolchain index e862a0b958..c23b3e7191 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-07 +leanprover/lean4:nightly-2024-02-08 diff --git a/test/json.lean b/test/json.lean index a08834e437..63df684c34 100644 --- a/test/json.lean +++ b/test/json.lean @@ -1,7 +1,5 @@ import Std.Tactic.GuardMsgs -import Std.Data.Json - -open scoped Std.Json +import Lean.Data.Json.Elab /-- info: {"lookACalc": 131, "lemonCount": 100000000000000000000000000000000, From a94007f5a0f04e81e76f9396968bd739cbeaaf65 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 10 Feb 2024 09:13:51 +0000 Subject: [PATCH 014/213] chore: bump to nightly-2024-02-10 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 4d2a3908d0..5b26253bfe 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-09 +leanprover/lean4:nightly-2024-02-10 From bf7c1dc419ce1362124af6b99601be1baf14c144 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 10 Feb 2024 21:57:08 +1100 Subject: [PATCH 015/213] fixes for nightly-2024-02-10 --- Std.lean | 2 - Std/CodeAction/Attr.lean | 1 - Std/Data/Char.lean | 1 - Std/Data/Int/Order.lean | 1 - Std/Data/Nat/Bitwise.lean | 1 - Std/Data/Nat/Gcd.lean | 1 - Std/Data/Prod/Lex.lean | 1 - Std/Lean/Position.lean | 21 - Std/Tactic/Congr.lean | 1 - Std/Tactic/Ext.lean | 1 - Std/Tactic/Ext/Attr.lean | 1 - Std/Tactic/GuardExpr.lean | 1 - Std/Tactic/Lint/Basic.lean | 4 +- Std/Tactic/Lint/Frontend.lean | 1 + Std/Tactic/Lint/Misc.lean | 1 + Std/Tactic/Lint/TypeClass.lean | 1 + Std/Tactic/Omega/Constraint.lean | 1 - Std/Tactic/RCases.lean | 760 ------------------------------- Std/Tactic/RunCmd.lean | 2 +- Std/Util/Pickle.lean | 1 - Std/Util/TermUnsafe.lean | 61 --- test/rcases.lean | 1 - test/solve_by_elim.lean | 1 - test/symm.lean | 1 - test/tryThis.lean | 1 - 25 files changed, 7 insertions(+), 862 deletions(-) delete mode 100644 Std/Tactic/RCases.lean delete mode 100644 Std/Util/TermUnsafe.lean diff --git a/Std.lean b/Std.lean index 925a4d2f27..7fed219674 100644 --- a/Std.lean +++ b/Std.lean @@ -122,7 +122,6 @@ import Std.Tactic.OpenPrivate import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix -import Std.Tactic.RCases import Std.Tactic.Relation.Rfl import Std.Tactic.Relation.Symm import Std.Tactic.Replace @@ -144,5 +143,4 @@ import Std.Util.ExtendedBinder import Std.Util.LibraryNote import Std.Util.Pickle import Std.Util.ProofWanted -import Std.Util.TermUnsafe import Std.WF diff --git a/Std/CodeAction/Attr.lean b/Std/CodeAction/Attr.lean index 81ac756076..42c6742404 100644 --- a/Std/CodeAction/Attr.lean +++ b/Std/CodeAction/Attr.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Lean.Server.CodeActions -import Std.Util.TermUnsafe /-! # Initial setup for code action attributes diff --git a/Std/Data/Char.lean b/Std/Data/Char.lean index ed40840832..2c3be7cd13 100644 --- a/Std/Data/Char.lean +++ b/Std/Data/Char.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ import Std.Tactic.Ext.Attr -import Std.Tactic.RCases @[ext] theorem Char.ext : {a b : Char} → a.val = b.val → a = b | ⟨_,_⟩, ⟨_,_⟩, rfl => rfl diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 2e4420d991..6b57f46db6 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -5,7 +5,6 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Data.Int.Lemmas import Std.Data.Option.Basic -import Std.Tactic.RCases /-! # Results about the order properties of the integers, and the integers as an ordered ring. diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean index a3fc3a7a13..ad1322dd01 100644 --- a/Std/Data/Nat/Bitwise.lean +++ b/Std/Data/Nat/Bitwise.lean @@ -12,7 +12,6 @@ It is primarily intended to support the bitvector library. -/ import Std.Data.Bool import Std.Data.Nat.Lemmas -import Std.Tactic.RCases import Std.Tactic.Simpa namespace Nat diff --git a/Std/Data/Nat/Gcd.lean b/Std/Data/Nat/Gcd.lean index e430e3a5a3..063b34b284 100644 --- a/Std/Data/Nat/Gcd.lean +++ b/Std/Data/Nat/Gcd.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro -/ import Std.Data.Nat.Lemmas -import Std.Tactic.RCases /-! # Definitions and properties of `gcd`, `lcm`, and `coprime` diff --git a/Std/Data/Prod/Lex.lean b/Std/Data/Prod/Lex.lean index 1fad8987df..7fd404bdfd 100644 --- a/Std/Data/Prod/Lex.lean +++ b/Std/Data/Prod/Lex.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ import Std.Tactic.LeftRight -import Std.Tactic.RCases namespace Prod diff --git a/Std/Lean/Position.lean b/Std/Lean/Position.lean index 6b8946efac..000436d3a6 100644 --- a/Std/Lean/Position.lean +++ b/Std/Lean/Position.lean @@ -14,17 +14,6 @@ def Lean.FileMap.utf8RangeToLspRange (text : FileMap) (range : String.Range) : L def Lean.FileMap.rangeOfStx? (text : FileMap) (stx : Syntax) : Option Lsp.Range := text.utf8RangeToLspRange <$> stx.getRange? -/-- Convert a `Lean.Position` to a `String.Pos`. -/ -def Lean.FileMap.ofPosition (text : FileMap) (pos : Position) : String.Pos := - let colPos := - if h : pos.line - 1 < text.positions.size then - text.positions.get ⟨pos.line - 1, h⟩ - else if text.positions.isEmpty then - 0 - else - text.positions.back - String.Iterator.nextn ⟨text.source, colPos⟩ pos.column |>.pos - /-- Return the beginning of the line contatining character `pos`. -/ def Lean.findLineStart (s : String) (pos : String.Pos) : String.Pos := match s.revFindAux (· = '\n') pos with @@ -39,13 +28,3 @@ def Lean.findIndentAndIsStart (s : String) (pos : String.Pos) : Nat × Bool := let start := findLineStart s pos let body := s.findAux (· ≠ ' ') pos start ((body - start).1, body == pos) - -/-- Returns a synthetic Syntax which has the specified `String.Range`. -/ -def Lean.Syntax.ofRange (range : String.Range) (canonical := true) : Lean.Syntax := - .atom (.synthetic range.start range.stop canonical) "" - -/-- Returns the position of the start of (1-based) line `line`. -/ -def Lean.FileMap.lineStart (map : FileMap) (line : Nat) : String.Pos := - if h : line - 1 < map.positions.size then - map.positions.get ⟨line - 1, h⟩ - else map.positions.back?.getD 0 diff --git a/Std/Tactic/Congr.lean b/Std/Tactic/Congr.lean index 7a784feb95..ebdaf0488d 100644 --- a/Std/Tactic/Congr.lean +++ b/Std/Tactic/Congr.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro, Miyahara Kō -/ import Lean.Meta.Tactic.Congr import Lean.Elab.Tactic.Config -import Std.Tactic.RCases import Std.Tactic.Ext /-! # `congr with` tactic, `rcongr` tactic -/ diff --git a/Std/Tactic/Ext.lean b/Std/Tactic/Ext.lean index c4629e65af..24228d1ff4 100644 --- a/Std/Tactic/Ext.lean +++ b/Std/Tactic/Ext.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Gabriel Ebner. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Mario Carneiro -/ -import Std.Tactic.RCases import Std.Tactic.Ext.Attr namespace Std.Tactic.Ext diff --git a/Std/Tactic/Ext/Attr.lean b/Std/Tactic/Ext/Attr.lean index e7b19480ef..141b970e72 100644 --- a/Std/Tactic/Ext/Attr.lean +++ b/Std/Tactic/Ext/Attr.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Gabriel Ebner. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Mario Carneiro -/ -import Std.Tactic.RCases import Std.Lean.Command import Std.Lean.Meta.DiscrTree diff --git a/Std/Tactic/GuardExpr.lean b/Std/Tactic/GuardExpr.lean index c795674282..ef56aeff6d 100644 --- a/Std/Tactic/GuardExpr.lean +++ b/Std/Tactic/GuardExpr.lean @@ -7,7 +7,6 @@ import Lean.Elab.Command import Lean.Elab.Tactic.Conv.Basic import Lean.Meta.Basic import Lean.Meta.Eval -import Std.Util.TermUnsafe namespace Std.Tactic.GuardExpr open Lean Meta Elab Tactic diff --git a/Std/Tactic/Lint/Basic.lean b/Std/Tactic/Lint/Basic.lean index 16f89daf29..e7c72e80ab 100644 --- a/Std/Tactic/Lint/Basic.lean +++ b/Std/Tactic/Lint/Basic.lean @@ -3,7 +3,9 @@ Copyright (c) 2020 Floris van Doorn. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Robert Y. Lewis, Gabriel Ebner -/ -import Std.Util.TermUnsafe +import Lean.Structure +import Lean.Elab.InfoTree.Main +import Lean.Elab.Exception open Lean Meta diff --git a/Std/Tactic/Lint/Frontend.lean b/Std/Tactic/Lint/Frontend.lean index 41ad25a647..2d75b87c7e 100644 --- a/Std/Tactic/Lint/Frontend.lean +++ b/Std/Tactic/Lint/Frontend.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Robert Y. Lewis, Gabriel Ebner -/ import Lean.Util.Paths +import Lean.Elab.Command import Std.Tactic.Lint.Basic /-! diff --git a/Std/Tactic/Lint/Misc.lean b/Std/Tactic/Lint/Misc.lean index 8eb2bbce9a..84dd401ae8 100644 --- a/Std/Tactic/Lint/Misc.lean +++ b/Std/Tactic/Lint/Misc.lean @@ -5,6 +5,7 @@ Authors: Floris van Doorn, Robert Y. Lewis, Arthur Paulino, Gabriel Ebner -/ import Lean.Util.CollectLevelParams import Lean.Meta.ForEachExpr +import Lean.Util.Recognizers import Std.Tactic.Lint.Basic open Lean Meta diff --git a/Std/Tactic/Lint/TypeClass.lean b/Std/Tactic/Lint/TypeClass.lean index c6a92cd36c..a3fb2b3d66 100644 --- a/Std/Tactic/Lint/TypeClass.lean +++ b/Std/Tactic/Lint/TypeClass.lean @@ -3,6 +3,7 @@ Copyright (c) 2022 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner -/ +import Lean.Meta.Instances import Std.Tactic.Lint.Basic namespace Std.Tactic.Lint diff --git a/Std/Tactic/Omega/Constraint.lean b/Std/Tactic/Omega/Constraint.lean index a4834d0936..129fc20a4b 100644 --- a/Std/Tactic/Omega/Constraint.lean +++ b/Std/Tactic/Omega/Constraint.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Classes.Order -import Std.Tactic.RCases import Std.Tactic.NormCast import Std.Tactic.Omega.Coeffs.IntList diff --git a/Std/Tactic/RCases.lean b/Std/Tactic/RCases.lean deleted file mode 100644 index 68c8cf75cb..0000000000 --- a/Std/Tactic/RCases.lean +++ /dev/null @@ -1,760 +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, Jacob von Raumer --/ -import Lean.Elab.Tactic.Induction - -/-! - -# Recursive cases (`rcases`) tactic and related tactics - -`rcases` is a tactic that will perform `cases` recursively, according to a pattern. It is used to -destructure hypotheses or expressions composed of inductive types like `h1 : a ∧ b ∧ c ∨ d` or -`h2 : ∃ x y, trans_rel R x y`. Usual usage might be `rcases h1 with ⟨ha, hb, hc⟩ | hd` or -`rcases h2 with ⟨x, y, _ | ⟨z, hxz, hzy⟩⟩` for these examples. - -Each element of an `rcases` pattern is matched against a particular local hypothesis (most of which -are generated during the execution of `rcases` and represent individual elements destructured from -the input expression). An `rcases` pattern has the following grammar: - -* A name like `x`, which names the active hypothesis as `x`. -* A blank `_`, which does nothing (letting the automatic naming system used by `cases` name the - hypothesis). -* A hyphen `-`, which clears the active hypothesis and any dependents. -* The keyword `rfl`, which expects the hypothesis to be `h : a = b`, and calls `subst` on the - hypothesis (which has the effect of replacing `b` with `a` everywhere or vice versa). -* A type ascription `p : ty`, which sets the type of the hypothesis to `ty` and then matches it - against `p`. (Of course, `ty` must unify with the actual type of `h` for this to work.) -* A tuple pattern `⟨p1, p2, p3⟩`, which matches a constructor with many arguments, or a series - of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`, - then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b` - and so on. -* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor, - while leaving the `@` off will only use the patterns on the explicit arguments. -* An alternation pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors, - or a nested disjunction like `a ∨ b ∨ c`. - -The patterns are fairly liberal about the exact shape of the constructors, and will insert -additional alternation branches and tuple arguments if there are not enough arguments provided, and -reuse the tail for further matches if there are too many arguments provided to alternation and -tuple patterns. - -This file also contains the `obtain` and `rintro` tactics, which use the same syntax of `rcases` -patterns but with a slightly different use case: - -* `rintro` (or `rintros`) is used like `rintro x ⟨y, z⟩` and is the same as `intros` followed by - `rcases` on the newly introduced arguments. -* `obtain` is the same as `rcases` but with a syntax styled after `have` rather than `cases`. - `obtain ⟨hx, hy⟩ | hz := foo` is equivalent to `rcases foo with ⟨hx, hy⟩ | hz`. Unlike `rcases`, - `obtain` also allows one to omit `:= foo`, although a type must be provided in this case, - as in `obtain ⟨hx, hy⟩ | hz : a ∧ b ∨ c`, in which case it produces a subgoal for proving - `a ∧ b ∨ c` in addition to the subgoals `hx : a, hy : b |- goal` and `hz : c |- goal`. - -## Tags - -rcases, rintro, obtain, destructuring, cases, pattern matching, match --/ - -/-- -Constructs a substitution consisting of `s` followed by `t`. -This satisfies `(s.append t).apply e = t.apply (s.apply e)` --/ -def Lean.Meta.FVarSubst.append (s t : FVarSubst) : FVarSubst := - s.1.foldl (fun s' k v => s'.insert k (t.apply v)) t - -namespace Std.Tactic.RCases -open Lean Meta - -/-- -Enables the 'unused rcases pattern' linter. This will warn when a pattern is ignored by -`rcases`, `rintro`, `ext` and similar tactics. --/ -register_option linter.unusedRCasesPattern : Bool := { - defValue := true - descr := "enable the 'unused rcases pattern' linter" -} - -/-- The syntax category of `rcases` patterns. -/ -declare_syntax_cat rcasesPat -/-- A medium precedence `rcases` pattern is a list of `rcasesPat` separated by `|` -/ -syntax rcasesPatMed := sepBy1(rcasesPat, " | ") -/-- A low precedence `rcases` pattern is a `rcasesPatMed` optionally followed by `: ty` -/ -syntax rcasesPatLo := rcasesPatMed (" : " term)? -/-- `x` is a pattern which binds `x` -/ -syntax (name := rcasesPat.one) ident : rcasesPat -/-- `_` is a pattern which ignores the value and gives it an inaccessible name -/ -syntax (name := rcasesPat.ignore) "_" : rcasesPat -/-- `-` is a pattern which removes the value from the context -/ -syntax (name := rcasesPat.clear) "-" : rcasesPat -/-- -A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor, -while leaving the `@` off will only use the patterns on the explicit arguments. --/ -syntax (name := rcasesPat.explicit) "@" noWs rcasesPat : rcasesPat -/-- -`⟨pat, ...⟩` is a pattern which matches on a tuple-like constructor -or multi-argument inductive constructor --/ -syntax (name := rcasesPat.tuple) "⟨" rcasesPatLo,* "⟩" : rcasesPat -/-- `(pat)` is a pattern which resets the precedence to low -/ -syntax (name := rcasesPat.paren) "(" rcasesPatLo ")" : rcasesPat - -/-- The syntax category of `rintro` patterns. -/ -declare_syntax_cat rintroPat -/-- An `rcases` pattern is an `rintro` pattern -/ -syntax (name := rintroPat.one) rcasesPat : rintroPat -/-- -A multi argument binder `(pat1 pat2 : ty)` binds a list of patterns and gives them all type `ty`. --/ -syntax(name := rintroPat.binder) (priority := default+1) -- to override rcasesPat.paren - "(" rintroPat+ (" : " term)? ")" : rintroPat - -instance : Coe Ident (TSyntax `rcasesPat) where - coe stx := Unhygienic.run `(rcasesPat| $stx:ident) -instance : Coe (TSyntax `rcasesPat) (TSyntax ``rcasesPatMed) where - coe stx := Unhygienic.run `(rcasesPatMed| $stx:rcasesPat) -instance : Coe (TSyntax ``rcasesPatMed) (TSyntax ``rcasesPatLo) where - coe stx := Unhygienic.run `(rcasesPatLo| $stx:rcasesPatMed) -instance : Coe (TSyntax `rcasesPat) (TSyntax `rintroPat) where - coe stx := Unhygienic.run `(rintroPat| $stx:rcasesPat) - -/-- A list, with a disjunctive meaning (like a list of inductive constructors, or subgoals) -/ -local notation "ListΣ" => List - -/-- A list, with a conjunctive meaning (like a list of constructor arguments, or hypotheses) -/ -local notation "ListΠ" => List - -/-- -An `rcases` pattern can be one of the following, in a nested combination: - -* A name like `foo` -* The special keyword `rfl` (for pattern matching on equality using `subst`) -* A hyphen `-`, which clears the active hypothesis and any dependents. -* A type ascription like `pat : ty` (parentheses are optional) -* A tuple constructor like `⟨p1, p2, p3⟩` -* An alternation / variant pattern `p1 | p2 | p3` - -Parentheses can be used for grouping; alternation is higher precedence than type ascription, so -`p1 | p2 | p3 : ty` means `(p1 | p2 | p3) : ty`. - -N-ary alternations are treated as a group, so `p1 | p2 | p3` is not the same as `p1 | (p2 | p3)`, -and similarly for tuples. However, note that an n-ary alternation or tuple can match an n-ary -conjunction or disjunction, because if the number of patterns exceeds the number of constructors in -the type being destructed, the extra patterns will match on the last element, meaning that -`p1 | p2 | p3` will act like `p1 | (p2 | p3)` when matching `a1 ∨ a2 ∨ a3`. If matching against a -type with 3 constructors, `p1 | (p2 | p3)` will act like `p1 | (p2 | p3) | _` instead. --/ -inductive RCasesPatt : Type - /-- A parenthesized expression, used for hovers -/ - | paren (ref : Syntax) : RCasesPatt → RCasesPatt - /-- A named pattern like `foo` -/ - | one (ref : Syntax) : Name → RCasesPatt - /-- A hyphen `-`, which clears the active hypothesis and any dependents. -/ - | clear (ref : Syntax) : RCasesPatt - /-- An explicit pattern `@pat`. -/ - | explicit (ref : Syntax) : RCasesPatt → RCasesPatt - /-- A type ascription like `pat : ty` (parentheses are optional) -/ - | typed (ref : Syntax) : RCasesPatt → Term → RCasesPatt - /-- A tuple constructor like `⟨p1, p2, p3⟩` -/ - | tuple (ref : Syntax) : ListΠ RCasesPatt → RCasesPatt - /-- An alternation / variant pattern `p1 | p2 | p3` -/ - | alts (ref : Syntax) : ListΣ RCasesPatt → RCasesPatt - deriving Repr - -namespace RCasesPatt - -instance : Inhabited RCasesPatt := ⟨RCasesPatt.one Syntax.missing `_⟩ - -/-- Get the name from a pattern, if provided -/ -partial def name? : RCasesPatt → Option Name - | one _ `_ => none - | one _ `rfl => none - | one _ n => n - | paren _ p - | typed _ p _ - | alts _ [p] => p.name? - | _ => none - -/-- Get the syntax node from which this pattern was parsed. Used for error messages -/ -def ref : RCasesPatt → Syntax - | paren ref _ - | one ref _ - | clear ref - | explicit ref _ - | typed ref _ _ - | tuple ref _ - | alts ref _ => ref - -/-- -Interpret an rcases pattern as a tuple, where `p` becomes `⟨p⟩` if `p` is not already a tuple. --/ -def asTuple : RCasesPatt → Bool × ListΠ RCasesPatt - | paren _ p => p.asTuple - | explicit _ p => (true, p.asTuple.2) - | tuple _ ps => (false, ps) - | p => (false, [p]) - -/-- -Interpret an rcases pattern as an alternation, where non-alternations are treated as one -alternative. --/ -def asAlts : RCasesPatt → ListΣ RCasesPatt - | paren _ p => p.asAlts - | alts _ ps => ps - | p => [p] - -/-- Convert a list of patterns to a tuple pattern, but mapping `[p]` to `p` instead of `⟨p⟩`. -/ -def typed? (ref : Syntax) : RCasesPatt → Option Term → RCasesPatt - | p, none => p - | p, some ty => typed ref p ty - -/-- Convert a list of patterns to a tuple pattern, but mapping `[p]` to `p` instead of `⟨p⟩`. -/ -def tuple' : ListΠ RCasesPatt → RCasesPatt - | [p] => p - | ps => tuple (ps.head?.map (·.ref) |>.getD .missing) ps - -/-- -Convert a list of patterns to an alternation pattern, but mapping `[p]` to `p` instead of -a unary alternation `|p`. --/ -def alts' (ref : Syntax) : ListΣ RCasesPatt → RCasesPatt - | [p] => p - | ps => alts ref ps - -/-- -This function is used for producing rcases patterns based on a case tree. Suppose that we have -a list of patterns `ps` that will match correctly against the branches of the case tree for one -constructor. This function will merge tuples at the end of the list, so that `[a, b, ⟨c, d⟩]` -becomes `⟨a, b, c, d⟩` instead of `⟨a, b, ⟨c, d⟩⟩`. - -We must be careful to turn `[a, ⟨⟩]` into `⟨a, ⟨⟩⟩` instead of `⟨a⟩` (which will not perform the -nested match). --/ -def tuple₁Core : ListΠ RCasesPatt → ListΠ RCasesPatt - | [] => [] - | [tuple ref []] => [tuple ref []] - | [tuple _ ps] => ps - | p :: ps => p :: tuple₁Core ps - -/-- -This function is used for producing rcases patterns based on a case tree. This is like -`tuple₁Core` but it produces a pattern instead of a tuple pattern list, converting `[n]` to `n` -instead of `⟨n⟩` and `[]` to `_`, and otherwise just converting `[a, b, c]` to `⟨a, b, c⟩`. --/ -def tuple₁ : ListΠ RCasesPatt → RCasesPatt - | [] => default - | [one ref n] => one ref n - | ps => tuple ps.head!.ref $ tuple₁Core ps - -/-- -This function is used for producing rcases patterns based on a case tree. Here we are given -the list of patterns to apply to each argument of each constructor after the main case, and must -produce a list of alternatives with the same effect. This function calls `tuple₁` to make the -individual alternatives, and handles merging `[a, b, c | d]` to `a | b | c | d` instead of -`a | b | (c | d)`. --/ -def alts₁Core : ListΣ (ListΠ RCasesPatt) → ListΣ RCasesPatt - | [] => [] - | [[alts _ ps]] => ps - | p :: ps => tuple₁ p :: alts₁Core ps - -/-- -This function is used for producing rcases patterns based on a case tree. This is like -`alts₁Core`, but it produces a cases pattern directly instead of a list of alternatives. We -specially translate the empty alternation to `⟨⟩`, and translate `|(a | b)` to `⟨a | b⟩` (because we -don't have any syntax for unary alternation). Otherwise we can use the regular merging of -alternations at the last argument so that `a | b | (c | d)` becomes `a | b | c | d`. --/ -def alts₁ (ref : Syntax) : ListΣ (ListΠ RCasesPatt) → RCasesPatt - | [[]] => tuple .missing [] - | [[alts ref ps]] => tuple ref ps - | ps => alts' ref $ alts₁Core ps - -open MessageData in -partial instance : ToMessageData RCasesPatt := ⟨fmt 0⟩ where - /-- parenthesize the message if the precedence is above `tgt` -/ - parenAbove (tgt p : Nat) (m : MessageData) : MessageData := - if tgt < p then m.paren else m - /-- format an `RCasesPatt` with the given precedence: 0 = lo, 1 = med, 2 = hi -/ - fmt : Nat → RCasesPatt → MessageData - | p, paren _ pat => fmt p pat - | _, one _ n => n - | _, clear _ => "-" - | _, explicit _ pat => m!"@{fmt 2 pat}" - | p, typed _ pat ty => parenAbove 0 p m!"{fmt 1 pat}: {ty}" - | _, tuple _ pats => bracket "⟨" (joinSep (pats.map (fmt 0)) ("," ++ Format.line)) "⟩" - | p, alts _ pats => parenAbove 1 p (joinSep (pats.map (fmt 2)) " | ") - -end RCasesPatt - -/-- -Takes the number of fields of a single constructor and patterns to match its fields against -(not necessarily the same number). The returned lists each contain one element per field of the -constructor. The `name` is the name which will be used in the top-level `cases` tactic, and the -`rcases_patt` is the pattern which the field will be matched against by subsequent `cases` -tactics. --/ -def processConstructor (ref : Syntax) (info : Array ParamInfo) - (explicit : Bool) (idx : Nat) (ps : ListΠ RCasesPatt) : ListΠ Name × ListΠ RCasesPatt := - if _ : idx < info.size then - if !explicit && info[idx].binderInfo != .default then - let (ns, tl) := processConstructor ref info explicit (idx+1) ps - (`_ :: ns, default :: tl) - else if idx+1 < info.size then - let p := ps.headD default - let (ns, tl) := processConstructor ref info explicit (idx+1) (ps.tailD []) - (p.name?.getD `_ :: ns, p :: tl) - else match ps with - | [] => ([`_], [default]) - | [p] => ([p.name?.getD `_], [p]) - | ps => ([`_], [(bif explicit then .explicit ref else id) (.tuple ref ps)]) - else ([], []) -termination_by info.size - idx - -/-- -Takes a list of constructor names, and an (alternation) list of patterns, and matches each -pattern against its constructor. It returns the list of names that will be passed to `cases`, -and the list of `(constructor name, patterns)` for each constructor, where `patterns` is the -(conjunctive) list of patterns to apply to each constructor argument. --/ -def processConstructors (ref : Syntax) (params : Nat) (altVarNames : Array AltVarNames := #[]) : - ListΣ Name → ListΣ RCasesPatt → MetaM (Array AltVarNames × ListΣ (Name × ListΠ RCasesPatt)) - | [], _ => pure (altVarNames, []) - | c :: cs, ps => do - let info := (← getFunInfo (← mkConstWithLevelParams c)).paramInfo - let p := ps.headD default - let t := ps.tailD [] - let ((explicit, h), t) := match cs, t with - | [], _ :: _ => ((false, [RCasesPatt.alts ref ps]), []) - | _, _ => (p.asTuple, t) - let (ns, ps) := processConstructor p.ref info explicit params h - let (altVarNames, r) ← processConstructors ref params (altVarNames.push ⟨true, ns⟩) cs t - pure (altVarNames, (c, ps) :: r) - -open Elab Tactic - --- TODO(Mario): this belongs in core -/-- Like `Lean.Meta.subst`, but preserves the `FVarSubst`. -/ -def subst' (goal : MVarId) (hFVarId : FVarId) - (fvarSubst : FVarSubst := {}) : MetaM (FVarSubst × MVarId) := do - let hLocalDecl ← hFVarId.getDecl - let error {α} _ : MetaM α := throwTacticEx `subst goal - m!"invalid equality proof, it is not of the form (x = t) or (t = x){indentExpr hLocalDecl.type}" - let some (_, lhs, rhs) ← matchEq? hLocalDecl.type | error () - let substReduced (newType : Expr) (symm : Bool) : MetaM (FVarSubst × MVarId) := do - let goal ← goal.assert hLocalDecl.userName newType (mkFVar hFVarId) - let (hFVarId', goal) ← goal.intro1P - let goal ← goal.clear hFVarId - substCore goal hFVarId' (symm := symm) (tryToSkip := true) (fvarSubst := fvarSubst) - let rhs' ← whnf rhs - if rhs'.isFVar then - if rhs != rhs' then - substReduced (← mkEq lhs rhs') true - else - substCore goal hFVarId (symm := true) (tryToSkip := true) (fvarSubst := fvarSubst) - else - let lhs' ← whnf lhs - if lhs'.isFVar then - if lhs != lhs' then - substReduced (← mkEq lhs' rhs) false - else - substCore goal hFVarId (symm := false) (tryToSkip := true) (fvarSubst := fvarSubst) - else error () - -mutual - -/-- -This will match a pattern `pat` against a local hypothesis `e`. -* `g`: The initial subgoal -* `fs`: A running variable substitution, the result of `cases` operations upstream. - The variable `e` must be run through this map before locating it in the context of `g`, - and the output variable substitutions will be end extensions of this one. -* `clears`: The list of variables to clear in all subgoals generated from this point on. - We defer clear operations because clearing too early can cause `cases` to fail. - The actual clearing happens in `RCases.finish`. -* `e`: a local hypothesis, the scrutinee to match against. -* `a`: opaque "user data" which is passed through all the goal calls at the end. -* `pat`: the pattern to match against -* `cont`: A continuation. This is called on every goal generated by the result of the pattern - match, with updated values for `g` , `fs`, `clears`, and `a`. --/ -partial def rcasesCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (e : Expr) (a : α) - (pat : RCasesPatt) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : - TermElabM α := do - let asFVar : Expr → MetaM _ - | .fvar e => pure e - | e => throwError "rcases tactic failed: {e} is not a fvar" - withRef pat.ref <| g.withContext do match pat with - | .one ref `rfl => - Term.synthesizeSyntheticMVarsNoPostponing - -- Note: the mdata prevents the span from getting highlighted like a variable - Term.addTermInfo' ref (.mdata {} e) - let (fs, g) ← subst' g (← asFVar (fs.apply e)) fs - cont g fs clears a - | .one ref _ => - if e.isFVar then - Term.addLocalVarInfo ref e - cont g fs clears a - | .clear ref => - Term.addTermInfo' ref (.mdata {} e) - cont g fs (if let .fvar e := e then clears.push e else clears) a - | .typed ref pat ty => - Term.addTermInfo' ref (.mdata {} e) - let expected ← Term.elabType ty - let e := fs.apply e - let etype ← inferType e - unless ← isDefEq etype expected do - Term.throwTypeMismatchError "rcases: scrutinee" expected etype e - let g ← if let .fvar e := e then g.replaceLocalDeclDefEq e expected else pure g - rcasesCore g fs clears e a pat cont - | .paren ref p - | .alts ref [p] => - Term.addTermInfo' ref (.mdata {} e) - rcasesCore g fs clears e a p cont - | _ => - Term.addTermInfo' pat.ref (.mdata {} e) - let e := fs.apply e - let _ ← asFVar e - Term.synthesizeSyntheticMVarsNoPostponing - let type ← whnfD (← inferType e) - let failK {α} _ : TermElabM α := - throwError "rcases tactic failed: {e} : {type} is not an inductive datatype" - let (r, subgoals) ← matchConst type.getAppFn failK fun - | ConstantInfo.quotInfo info, _ => do - unless info.kind matches QuotKind.type do failK () - let pat := pat.asAlts.headD default - let (explicit, pat₁) := pat.asTuple - let ([x], ps) := processConstructor pat.ref #[{}] explicit 0 pat₁ | unreachable! - let (vars, g) ← g.revert (← getFVarsToGeneralize #[e]) - g.withContext do - let elimInfo ← getElimInfo `Quot.ind - let res ← ElimApp.mkElimApp elimInfo #[e] (← g.getTag) - let elimArgs := res.elimApp.getAppArgs - ElimApp.setMotiveArg g elimArgs[elimInfo.motivePos]!.mvarId! #[e.fvarId!] - g.assign res.elimApp - let #[{ name := n, mvarId := g, .. }] := res.alts | unreachable! - let (v, g) ← g.intro x - let (varsOut, g) ← g.introNP vars.size - let fs' := (vars.zip varsOut).foldl (init := fs) fun fs (v, w) => fs.insert v (mkFVar w) - pure ([(n, ps)], #[⟨⟨g, #[mkFVar v], fs'⟩, n⟩]) - | ConstantInfo.inductInfo info, _ => do - let (altVarNames, r) ← processConstructors pat.ref info.numParams #[] info.ctors pat.asAlts - (r, ·) <$> g.cases e.fvarId! altVarNames - | _, _ => failK () - (·.2) <$> subgoals.foldlM (init := (r, a)) fun (r, a) ⟨goal, ctorName⟩ => do - let rec - /-- Runs `rcasesContinue` on the first pattern in `r` with a matching `ctorName`. - The unprocessed patterns (subsequent to the matching pattern) are returned. -/ - align : ListΠ (Name × ListΠ RCasesPatt) → TermElabM (ListΠ (Name × ListΠ RCasesPatt) × α) - | [] => pure ([], a) - | (tgt, ps) :: as => do - if tgt == ctorName then - let fs := fs.append goal.subst - (as, ·) <$> rcasesContinue goal.mvarId fs clears a (ps.zip goal.fields.toList) cont - else - align as - align r - -/-- -This will match a list of patterns against a list of hypotheses `e`. The arguments are similar -to `rcasesCore`, but the patterns and local variables are in `pats`. Because the calls are all -nested in continuations, later arguments can be matched many times, once per goal produced by -earlier arguments. For example `⟨a | b, ⟨c, d⟩⟩` performs the `⟨c, d⟩` match twice, once on the -`a` branch and once on `b`. --/ -partial def rcasesContinue (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a : α) - (pats : ListΠ (RCasesPatt × Expr)) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : - TermElabM α := - match pats with - | [] => cont g fs clears a - | ((pat, e) :: ps) => - rcasesCore g fs clears e a pat fun g fs clears a => - rcasesContinue g fs clears a ps cont - -end - -/-- Like `tryClearMany`, but also clears dependent hypotheses if possible -/ -def tryClearMany' (goal : MVarId) (fvarIds : Array FVarId) : MetaM MVarId := do - let mut toErase := fvarIds - for localDecl in (← goal.getDecl).lctx do - if ← findLocalDeclDependsOn localDecl toErase.contains then - toErase := toErase.push localDecl.fvarId - goal.tryClearMany toErase - -/-- -The terminating continuation used in `rcasesCore` and `rcasesContinue`. We specialize the type -`α` to `Array MVarId` to collect the list of goals, and given the list of `clears`, it attempts to -clear them from the goal and adds the goal to the list. --/ -def finish (toTag : Array (Ident × FVarId) := #[]) - (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) - (gs : Array MVarId) : TermElabM (Array MVarId) := do - let cs : Array Expr := (clears.map fs.get).filter Expr.isFVar - let g ← tryClearMany' g (cs.map Expr.fvarId!) - g.withContext do - for (stx, fvar) in toTag do - Term.addLocalVarInfo stx (fs.get fvar) - return gs.push g - -open Elab - -/-- Parses a `Syntax` into the `RCasesPatt` type used by the `RCases` tactic. -/ -partial def RCasesPatt.parse (stx : Syntax) : MetaM RCasesPatt := - match stx with - | `(rcasesPatMed| $ps:rcasesPat|*) => return .alts' stx (← ps.getElems.toList.mapM (parse ·.raw)) - | `(rcasesPatLo| $pat:rcasesPatMed : $t:term) => return .typed stx (← parse pat) t - | `(rcasesPatLo| $pat:rcasesPatMed) => parse pat - | `(rcasesPat| _) => return .one stx `_ - | `(rcasesPat| $h:ident) => return .one h h.getId - | `(rcasesPat| -) => return .clear stx - | `(rcasesPat| @$pat) => return .explicit stx (← parse pat) - | `(rcasesPat| ⟨$ps,*⟩) => return .tuple stx (← ps.getElems.toList.mapM (parse ·.raw)) - | `(rcasesPat| ($pat)) => return .paren stx (← parse pat) - | _ => throwUnsupportedSyntax - --- extracted from elabCasesTargets -/-- Generalize all the arguments as specified in `args` to fvars if they aren't already -/ -def generalizeExceptFVar (goal : MVarId) (args : Array GeneralizeArg) : - MetaM (Array Expr × Array FVarId × MVarId) := do - let argsToGeneralize := args.filter fun arg => !(arg.expr.isFVar && arg.hName?.isNone) - let (fvarIdsNew, goal) ← goal.generalize argsToGeneralize - let mut result := #[] - let mut j := 0 - for arg in args do - if arg.expr.isFVar && arg.hName?.isNone then - result := result.push arg.expr - else - result := result.push (mkFVar fvarIdsNew[j]!) - j := j+1 - pure (result, fvarIdsNew[j:], goal) - -/-- -Given a list of targets of the form `e` or `h : e`, and a pattern, match all the targets -against the pattern. Returns the list of produced subgoals. --/ -def rcases (tgts : Array (Option Ident × Syntax)) - (pat : RCasesPatt) (g : MVarId) : TermElabM (List MVarId) := Term.withSynthesize do - let pats ← match tgts.size with - | 0 => return [g] - | 1 => pure [pat] - | _ => pure (processConstructor pat.ref (tgts.map fun _ => {}) false 0 pat.asTuple.2).2 - let (pats, args) := Array.unzip <|← (tgts.zip pats.toArray).mapM fun ((hName?, tgt), pat) => do - let (pat, ty) ← match pat with - | .typed ref pat ty => withRef ref do - let ty ← Term.elabType ty - pure (.typed ref pat (← Term.exprToSyntax ty), some ty) - | _ => pure (pat, none) - let expr ← Term.ensureHasType ty (← Term.elabTerm tgt ty) - pure (pat, { expr, xName? := pat.name?, hName? := hName?.map (·.getId) : GeneralizeArg }) - let (vs, hs, g) ← generalizeExceptFVar g args - let toTag := tgts.filterMap (·.1) |>.zip hs - let gs ← rcasesContinue g {} #[] #[] (pats.zip vs).toList (finish (toTag := toTag)) - pure gs.toList - -/-- -The `obtain` tactic in the no-target case. Given a type `T`, create a goal `|- T` and -and pattern match `T` against the given pattern. Returns the list of goals, with the assumed goal -first followed by the goals produced by the pattern match. --/ -def obtainNone (pat : RCasesPatt) (ty : Syntax) (g : MVarId) : TermElabM (List MVarId) := - Term.withSynthesize do - let ty ← Term.elabType ty - let g₁ ← mkFreshExprMVar (some ty) - let (v, g₂) ← (← g.assert (pat.name?.getD default) ty g₁).intro1 - let gs ← rcasesCore g₂ {} #[] (.fvar v) #[] pat finish - pure (g₁.mvarId! :: gs.toList) - -mutual -variable [Monad m] [MonadQuotation m] - -/-- Expand a `rintroPat` into an equivalent list of `rcasesPat` patterns. -/ -partial def expandRIntroPat (pat : TSyntax `rintroPat) - (acc : Array (TSyntax `rcasesPat) := #[]) (ty? : Option Term := none) : - Array (TSyntax `rcasesPat) := - match pat with - | `(rintroPat| $p:rcasesPat) => match ty? with - | some ty => acc.push <| Unhygienic.run <| withRef p `(rcasesPat| ($p:rcasesPat : $ty)) - | none => acc.push p - | `(rintroPat| ($(pats)* $[: $ty?']?)) => expandRIntroPats pats acc (ty?' <|> ty?) - | _ => acc - -/-- Expand a list of `rintroPat` into an equivalent list of `rcasesPat` patterns. -/ -partial def expandRIntroPats (pats : Array (TSyntax `rintroPat)) - (acc : Array (TSyntax `rcasesPat) := #[]) (ty? : Option Term := none) : - Array (TSyntax `rcasesPat) := - pats.foldl (fun acc p => expandRIntroPat p acc ty?) acc - -end - -mutual - -/-- -This introduces the pattern `pat`. It has the same arguments as `rcasesCore`, plus: -* `ty?`: the nearest enclosing type ascription on the current pattern --/ -partial def rintroCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a : α) - (ref : Syntax) (pat : TSyntax `rintroPat) (ty? : Option Term) - (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : TermElabM α := do - match pat with - | `(rintroPat| $pat:rcasesPat) => - let pat := (← RCasesPatt.parse pat).typed? ref ty? - let (v, g) ← g.intro (pat.name?.getD `_) - rcasesCore g fs clears (.fvar v) a pat cont - | `(rintroPat| ($(pats)* $[: $ty?']?)) => - let ref := if pats.size == 1 then pat.raw else .missing - rintroContinue g fs clears ref pats (ty?' <|> ty?) a cont - | _ => throwUnsupportedSyntax - -/-- -This introduces the list of patterns `pats`. It has the same arguments as `rcasesCore`, plus: -* `ty?`: the nearest enclosing type ascription on the current pattern --/ -partial def rintroContinue (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) - (ref : Syntax) (pats : TSyntaxArray `rintroPat) (ty? : Option Term) (a : α) - (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : TermElabM α := do - g.withContext (loop 0 g fs clears a) -where - /-- Runs `rintroContinue` on `pats[i:]` -/ - loop i g fs clears a := do - if h : i < pats.size then - rintroCore g fs clears a ref (pats.get ⟨i, h⟩) ty? (loop (i+1)) - else cont g fs clears a - -end - -/-- -The implementation of the `rintro` tactic. It takes a list of patterns `pats` and -an optional type ascription `ty?` and introduces the patterns, resulting in zero or more goals. --/ -def rintro (pats : TSyntaxArray `rintroPat) (ty? : Option Term) - (g : MVarId) : TermElabM (List MVarId) := Term.withSynthesize do - (·.toList) <$> rintroContinue g {} #[] .missing pats ty? #[] finish - -end RCases - -open Lean Elab Elab.Tactic Meta RCases Parser.Tactic - -/- TODO -/-- -`rcases? e` will perform case splits on `e` in the same way as `rcases e`, -but rather than accepting a pattern, it does a maximal cases and prints the -pattern that would produce this case splitting. The default maximum depth is 5, -but this can be modified with `rcases? e : n`. --/ -elab (name := rcases?) "rcases?" _tgts:casesTarget,* _num:(" : " num)? : tactic => - throwError "unimplemented" --/ - -/-- -`rcases` is a tactic that will perform `cases` recursively, according to a pattern. It is used to -destructure hypotheses or expressions composed of inductive types like `h1 : a ∧ b ∧ c ∨ d` or -`h2 : ∃ x y, trans_rel R x y`. Usual usage might be `rcases h1 with ⟨ha, hb, hc⟩ | hd` or -`rcases h2 with ⟨x, y, _ | ⟨z, hxz, hzy⟩⟩` for these examples. - -Each element of an `rcases` pattern is matched against a particular local hypothesis (most of which -are generated during the execution of `rcases` and represent individual elements destructured from -the input expression). An `rcases` pattern has the following grammar: - -* A name like `x`, which names the active hypothesis as `x`. -* A blank `_`, which does nothing (letting the automatic naming system used by `cases` name the - hypothesis). -* A hyphen `-`, which clears the active hypothesis and any dependents. -* The keyword `rfl`, which expects the hypothesis to be `h : a = b`, and calls `subst` on the - hypothesis (which has the effect of replacing `b` with `a` everywhere or vice versa). -* A type ascription `p : ty`, which sets the type of the hypothesis to `ty` and then matches it - against `p`. (Of course, `ty` must unify with the actual type of `h` for this to work.) -* A tuple pattern `⟨p1, p2, p3⟩`, which matches a constructor with many arguments, or a series - of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`, - then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b` - and so on. -* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor, - while leaving the `@` off will only use the patterns on the explicit arguments. -* An alteration pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors, - or a nested disjunction like `a ∨ b ∨ c`. - -A pattern like `⟨a, b, c⟩ | ⟨d, e⟩` will do a split over the inductive datatype, -naming the first three parameters of the first constructor as `a,b,c` and the -first two of the second constructor `d,e`. If the list is not as long as the -number of arguments to the constructor or the number of constructors, the -remaining variables will be automatically named. If there are nested brackets -such as `⟨⟨a⟩, b | c⟩ | d` then these will cause more case splits as necessary. -If there are too many arguments, such as `⟨a, b, c⟩` for splitting on -`∃ x, ∃ y, p x`, then it will be treated as `⟨a, ⟨b, c⟩⟩`, splitting the last -parameter as necessary. - -`rcases` also has special support for quotient types: quotient induction into Prop works like -matching on the constructor `quot.mk`. - -`rcases h : e with PAT` will do the same as `rcases e with PAT` with the exception that an -assumption `h : e = PAT` will be added to the context. --/ -elab (name := rcases) tk:"rcases" tgts:casesTarget,* pat:((" with " rcasesPatLo)?) : tactic => do - let pat ← match pat.raw.getArgs with - | #[_, pat] => RCasesPatt.parse pat - | #[] => pure $ RCasesPatt.tuple tk [] - | _ => throwUnsupportedSyntax - let tgts := tgts.getElems.map fun tgt => - (if tgt.raw[0].isNone then none else some ⟨tgt.raw[0][0]⟩, tgt.raw[1]) - let g ← getMainGoal - g.withContext do replaceMainGoal (← RCases.rcases tgts pat g) - -/-- -The `obtain` tactic is a combination of `have` and `rcases`. See `rcases` for -a description of supported patterns. - -```lean -obtain ⟨patt⟩ : type := proof -``` -is equivalent to -```lean -have h : type := proof -rcases h with ⟨patt⟩ -``` - -If `⟨patt⟩` is omitted, `rcases` will try to infer the pattern. - -If `type` is omitted, `:= proof` is required. --/ -elab (name := obtain) tk:"obtain" - pat:(ppSpace rcasesPatMed)? ty:((" : " term)?) val:((" := " term,+)?) : tactic => do - let pat ← liftM $ pat.mapM RCasesPatt.parse - if val.raw.isNone then - if ty.raw.isNone then throwError "\ - `obtain` requires either an expected type or a value.\n\ - usage: `obtain ⟨patt⟩? : type (:= val)?` or `obtain ⟨patt⟩? (: type)? := val`" - let pat := pat.getD (RCasesPatt.one tk `this) - let g ← getMainGoal - g.withContext do replaceMainGoal (← RCases.obtainNone pat ty.raw[1] g) - else - let pat := pat.getD (RCasesPatt.one tk `_) - let pat := pat.typed? tk $ if ty.raw.isNone then none else some ⟨ty.raw[1]⟩ - let tgts := val.raw[1].getSepArgs.map fun val => (none, val) - let g ← getMainGoal - g.withContext do replaceMainGoal (← RCases.rcases tgts pat g) - -/- TODO -/-- -`rintro?` will introduce and case split on variables in the same way as -`rintro`, but will also print the `rintro` invocation that would have the same -result. Like `rcases?`, `rintro? : n` allows for modifying the -depth of splitting; the default is 5. --/ -elab (name := rintro?) "rintro?" (" : " num)? : tactic => - throwError "unimplemented" --/ - -/-- -The `rintro` tactic is a combination of the `intros` tactic with `rcases` to -allow for destructuring patterns while introducing variables. See `rcases` for -a description of supported patterns. For example, `rintro (a | ⟨b, c⟩) ⟨d, e⟩` -will introduce two variables, and then do case splits on both of them producing -two subgoals, one with variables `a d e` and the other with `b c d e`. - -`rintro`, unlike `rcases`, also supports the form `(x y : ty)` for introducing -and type-ascripting multiple variables at once, similar to binders. --/ -elab (name := rintro) "rintro" pats:(ppSpace colGt rintroPat)+ ty:((" : " term)?) : tactic => do - let ty? := if ty.raw.isNone then none else some ⟨ty.raw[1]⟩ - let g ← getMainGoal - g.withContext do replaceMainGoal (← RCases.rintro pats ty? g) diff --git a/Std/Tactic/RunCmd.lean b/Std/Tactic/RunCmd.lean index 6896b6626f..9c8eb39389 100644 --- a/Std/Tactic/RunCmd.lean +++ b/Std/Tactic/RunCmd.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Sebastian Ullrich, Mario Carneiro -/ import Lean.Elab.Eval -import Std.Util.TermUnsafe +import Lean.Elab.Command /-! Defines commands to compile and execute a command / term / tactic on the spot: diff --git a/Std/Util/Pickle.lean b/Std/Util/Pickle.lean index 8219dd49e0..e9c4ad78d7 100644 --- a/Std/Util/Pickle.lean +++ b/Std/Util/Pickle.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Util.TermUnsafe /-! # Pickling and unpickling objects diff --git a/Std/Util/TermUnsafe.lean b/Std/Util/TermUnsafe.lean deleted file mode 100644 index fcfa9c2aeb..0000000000 --- a/Std/Util/TermUnsafe.lean +++ /dev/null @@ -1,61 +0,0 @@ -/- -Copyright (c) 2021 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ -import Lean.Elab.ElabRules -import Lean.Meta.Closure -import Lean.Compiler.ImplementedByAttr - -/-! -Defines term syntax to call unsafe functions. - -``` -def cool := - unsafe (unsafeCast () : Nat) - -#eval cool -``` --/ - -namespace Std.TermUnsafe -open Lean Meta Elab Term - -/-- Construct an auxiliary name based on the current declaration name and the given `hint` base. -/ -def mkAuxName (hint : Name) : TermElabM Name := - withFreshMacroScope do - let name := (← getDeclName?).getD Name.anonymous ++ hint - pure $ addMacroScope (← getMainModule) name (← getCurrMacroScope) - -/-- -`unsafe t : α` is an expression constructor which allows using unsafe declarations inside the -body of `t : α`, by creating an auxiliary definition containing `t` and using `implementedBy` to -wrap it in a safe interface. It is required that `α` is nonempty for this to be sound, -but even beyond that, an `unsafe` block should be carefully inspected for memory safety because -the compiler is unable to guarantee the safety of the operation. - -For example, the `evalExpr` function is unsafe, because the compiler cannot guarantee that when -you call ```evalExpr Foo ``Foo e``` that the type `Foo` corresponds to the name `Foo`, but in a -particular use case, we can ensure this, so `unsafe (evalExpr Foo ``Foo e)` is a correct usage. --/ -elab "unsafe " t:term : term <= expectedType => do - let mut t ← elabTerm t expectedType - t ← instantiateMVars t - if t.hasExprMVar then - synthesizeSyntheticMVarsNoPostponing - t ← instantiateMVars t - if ← logUnassignedUsingErrorInfos (← getMVars t) then throwAbortTerm - t ← mkAuxDefinitionFor (← mkAuxName `unsafe) t - let Expr.const unsafeFn unsafeLvls .. := t.getAppFn | unreachable! - let ConstantInfo.defnInfo unsafeDefn ← getConstInfo unsafeFn | unreachable! - let implName ← mkAuxName `impl - addDecl <| Declaration.defnDecl { - name := implName - type := unsafeDefn.type - levelParams := unsafeDefn.levelParams - value := ← mkOfNonempty unsafeDefn.type - hints := ReducibilityHints.opaque - safety := DefinitionSafety.safe - } - setImplementedBy implName unsafeFn - pure $ mkAppN (mkConst implName unsafeLvls) t.getAppArgs diff --git a/test/rcases.lean b/test/rcases.lean index f1c4039205..1b6eff9985 100644 --- a/test/rcases.lean +++ b/test/rcases.lean @@ -1,6 +1,5 @@ import Std.Tactic.Basic import Std.Tactic.GuardExpr -import Std.Tactic.RCases set_option linter.missingDocs false diff --git a/test/solve_by_elim.lean b/test/solve_by_elim.lean index 779a971c3b..545218077c 100644 --- a/test/solve_by_elim.lean +++ b/test/solve_by_elim.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Std.Tactic.RCases import Std.Tactic.SolveByElim import Std.Tactic.PermuteGoals import Std.Test.Internal.DummyLabelAttr diff --git a/test/symm.lean b/test/symm.lean index 636aa60994..653630d209 100644 --- a/test/symm.lean +++ b/test/symm.lean @@ -1,5 +1,4 @@ import Std.Tactic.Relation.Symm -import Std.Tactic.RCases set_option autoImplicit true set_option linter.missingDocs false diff --git a/test/tryThis.lean b/test/tryThis.lean index b1f8066c36..861de6eb07 100644 --- a/test/tryThis.lean +++ b/test/tryThis.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Murrills -/ import Std.Tactic.TryThis -import Std.Util.TermUnsafe import Std.Tactic.GuardMsgs open Std.Tactic.TryThis From d8eb81387c2c3d5ca41341d97942a2174a1fd574 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 10 Feb 2024 22:00:25 +1100 Subject: [PATCH 016/213] fixes --- Std/Tactic/Lint/Misc.lean | 3 +++ Std/Util/Pickle.lean | 1 + 2 files changed, 4 insertions(+) diff --git a/Std/Tactic/Lint/Misc.lean b/Std/Tactic/Lint/Misc.lean index 84dd401ae8..ef169b60cc 100644 --- a/Std/Tactic/Lint/Misc.lean +++ b/Std/Tactic/Lint/Misc.lean @@ -5,7 +5,10 @@ Authors: Floris van Doorn, Robert Y. Lewis, Arthur Paulino, Gabriel Ebner -/ import Lean.Util.CollectLevelParams import Lean.Meta.ForEachExpr +import Lean.Meta.GlobalInstances +import Lean.Meta.Check import Lean.Util.Recognizers +import Lean.DocString import Std.Tactic.Lint.Basic open Lean Meta diff --git a/Std/Util/Pickle.lean b/Std/Util/Pickle.lean index e9c4ad78d7..e3a4c9e71f 100644 --- a/Std/Util/Pickle.lean +++ b/Std/Util/Pickle.lean @@ -3,6 +3,7 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ +import Lean.Environment /-! # Pickling and unpickling objects From 0ebc6ef9f08609ec8a848b420e5e28157bc84622 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 10 Feb 2024 22:06:44 +1100 Subject: [PATCH 017/213] fixes --- Std/Data/RBMap/Lemmas.lean | 4 ++-- Std/Tactic/Ext.lean | 1 + Std/Tactic/Lint/Misc.lean | 1 + 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/Std/Data/RBMap/Lemmas.lean b/Std/Data/RBMap/Lemmas.lean index c5d5ca36ce..7b1dad82e3 100644 --- a/Std/Data/RBMap/Lemmas.lean +++ b/Std/Data/RBMap/Lemmas.lean @@ -302,7 +302,7 @@ theorem Ordered.lowerBound?_least_lb [@TransCmp α cmp] [IsCut cmp cut] (h : Ord (hlb : ∀ {x}, lb = some x → t.All (cmpLT cmp x ·)) : t.lowerBound? cut lb = some x → y ∈ t → cut x = .gt → cmp x y = .lt → cut y = .lt := by induction t generalizing lb with - | nil => intro. + | nil => nofun | node _ _ _ _ ihl ihr => simp [lowerBound?]; split <;> rename_i hv <;> rintro h₁ (rfl | hy' | hy') hx h₂ · exact hv @@ -598,7 +598,7 @@ theorem mem_insert [@TransCmp α cmp] {t : RBNode α} (ht : Balanced t c n) (ht simp [← mem_toList, h₂] at h; rw [← or_assoc, or_right_comm] at h refine h.imp_left fun h => ?_ simp [← mem_toList, h₁, h] - rw [find?_eq_zoom, e]; intro. + rw [find?_eq_zoom, e]; nofun | (node .., p) => let ⟨_, _, h₁, h₂⟩ := exists_insert_toList_zoom_node ht e simp [← mem_toList, h₂] at h; simp [← mem_toList, h₁]; rw [or_left_comm] at h ⊢ diff --git a/Std/Tactic/Ext.lean b/Std/Tactic/Ext.lean index 24228d1ff4..623128e16e 100644 --- a/Std/Tactic/Ext.lean +++ b/Std/Tactic/Ext.lean @@ -3,6 +3,7 @@ Copyright (c) 2021 Gabriel Ebner. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Mario Carneiro -/ +import Lean.Elab.Tactic.RCases import Std.Tactic.Ext.Attr namespace Std.Tactic.Ext diff --git a/Std/Tactic/Lint/Misc.lean b/Std/Tactic/Lint/Misc.lean index ef169b60cc..adade058de 100644 --- a/Std/Tactic/Lint/Misc.lean +++ b/Std/Tactic/Lint/Misc.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Robert Y. Lewis, Arthur Paulino, Gabriel Ebner -/ import Lean.Util.CollectLevelParams +import Lean.Util.ForEachExpr import Lean.Meta.ForEachExpr import Lean.Meta.GlobalInstances import Lean.Meta.Check From 4bbd3586d5c417101508ffd2af099f04798f866f Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 10 Feb 2024 22:14:35 +1100 Subject: [PATCH 018/213] fix proof --- Std/Data/Array/Lemmas.lean | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index fc7047fb89..a2d5be5870 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -314,10 +314,9 @@ theorem size_eq_length_data (as : Array α) : as.size = as.data.length := rfl @[simp] theorem size_range {n : Nat} : (range n).size = n := by unfold range - sorry - -- induction n with - -- | zero => simp only [Nat.fold, size_toArray, List.length_nil, Nat.zero_eq] - -- | succ k ih => simp only [Nat.fold, flip, size_push, ih] + induction n with + | zero => simp [Nat.fold] + | succ k ih => rw [Nat.fold, flip]; simpa theorem size_modifyM [Monad m] [LawfulMonad m] (a : Array α) (i : Nat) (f : α → m α) : SatisfiesM (·.size = a.size) (a.modifyM i f) := by From 3fc81095bbdc1662be2f7b949c19faccff0016b1 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 12 Feb 2024 13:17:18 +1100 Subject: [PATCH 019/213] chore: adaptations for nightly-2024-02-10 (#615) * chore: adaptations for nightly-2024-02-10 * fix proof * add back NoMatch.lean with deprecations * parenthesising * Update Std/Data/RBMap/Lemmas.lean Co-authored-by: Mario Carneiro * add docBlame exception for declarations created by the unsafe term elaborator * put unsafe_ in isAutoDecl --------- Co-authored-by: Mario Carneiro --- Std.lean | 7 - Std/Classes/Cast.lean | 1 - Std/Classes/Dvd.lean | 12 - Std/Classes/LawfulMonad.lean | 2 +- Std/CodeAction/Attr.lean | 1 - Std/Data/Array.lean | 1 - Std/Data/Array/Basic.lean | 1 - Std/Data/Array/Init/Basic.lean | 40 -- Std/Data/Array/Init/Lemmas.lean | 5 +- Std/Data/Array/Lemmas.lean | 10 +- Std/Data/Array/Match.lean | 2 +- Std/Data/Char.lean | 1 - Std/Data/Fin/Lemmas.lean | 4 +- Std/Data/HashMap/WF.lean | 4 +- Std/Data/Int/Basic.lean | 1 - Std/Data/Int/Lemmas.lean | 6 +- Std/Data/Int/Order.lean | 4 +- Std/Data/List/Basic.lean | 5 +- Std/Data/List/Init/Lemmas.lean | 4 +- Std/Data/List/Lemmas.lean | 12 +- Std/Data/Nat/Basic.lean | 1 - Std/Data/Nat/Bitwise.lean | 1 - Std/Data/Nat/Gcd.lean | 1 - Std/Data/Nat/Lemmas.lean | 4 +- Std/Data/Option/Basic.lean | 3 +- Std/Data/Option/Lemmas.lean | 6 +- Std/Data/PairingHeap.lean | 2 +- Std/Data/Prod/Lex.lean | 1 - Std/Data/RBMap/Alter.lean | 16 +- Std/Data/RBMap/Lemmas.lean | 12 +- Std/Data/RBMap/WF.lean | 16 +- Std/Data/Range/Lemmas.lean | 1 - Std/Data/Rat/Basic.lean | 2 +- Std/Data/Sum/Basic.lean | 6 +- Std/Data/Sum/Lemmas.lean | 4 +- Std/Lean/LocalContext.lean | 49 -- Std/Lean/Meta/Basic.lean | 93 ---- Std/Lean/Position.lean | 21 - Std/Lean/Tactic.lean | 17 - Std/Logic.lean | 6 +- Std/Tactic/Basic.lean | 2 - Std/Tactic/ByCases.lean | 83 ---- Std/Tactic/CoeExt.lean | 144 ------ Std/Tactic/Congr.lean | 1 - Std/Tactic/Ext.lean | 2 +- Std/Tactic/Ext/Attr.lean | 1 - Std/Tactic/GuardExpr.lean | 1 - Std/Tactic/Init.lean | 1 - Std/Tactic/Lint/Basic.lean | 6 +- Std/Tactic/Lint/Frontend.lean | 1 + Std/Tactic/Lint/Misc.lean | 6 +- Std/Tactic/Lint/TypeClass.lean | 2 +- Std/Tactic/NoMatch.lean | 71 +-- Std/Tactic/NormCast.lean | 2 - Std/Tactic/NormCast/Ext.lean | 3 +- Std/Tactic/Omega/Constraint.lean | 1 - Std/Tactic/RCases.lean | 760 ------------------------------- Std/Tactic/RunCmd.lean | 2 +- Std/Tactic/Simpa.lean | 1 - Std/Util/Pickle.lean | 2 +- Std/Util/TermUnsafe.lean | 61 --- lean-toolchain | 2 +- test/by_cases.lean | 11 - test/coe.lean | 5 +- test/rcases.lean | 1 - test/solve_by_elim.lean | 1 - test/symm.lean | 1 - test/tryThis.lean | 1 - 68 files changed, 105 insertions(+), 1455 deletions(-) delete mode 100644 Std/Classes/Dvd.lean delete mode 100644 Std/Data/Array/Init/Basic.lean delete mode 100644 Std/Lean/LocalContext.lean delete mode 100644 Std/Lean/Tactic.lean delete mode 100644 Std/Tactic/ByCases.lean delete mode 100644 Std/Tactic/CoeExt.lean delete mode 100644 Std/Tactic/RCases.lean delete mode 100644 Std/Util/TermUnsafe.lean delete mode 100644 test/by_cases.lean diff --git a/Std.lean b/Std.lean index 07b67c34e4..a11354b4e1 100644 --- a/Std.lean +++ b/Std.lean @@ -1,6 +1,5 @@ import Std.Classes.BEq import Std.Classes.Cast -import Std.Classes.Dvd import Std.Classes.LawfulMonad import Std.Classes.Order import Std.Classes.RatCast @@ -51,7 +50,6 @@ import Std.Lean.HashMap import Std.Lean.HashSet import Std.Lean.IO.Process import Std.Lean.Json -import Std.Lean.LocalContext import Std.Lean.Meta.AssertHypotheses import Std.Lean.Meta.Basic import Std.Lean.Meta.Clear @@ -74,7 +72,6 @@ import Std.Lean.Position import Std.Lean.SMap import Std.Lean.Syntax import Std.Lean.System.IO -import Std.Lean.Tactic import Std.Lean.TagAttribute import Std.Lean.Util.EnvSearch import Std.Lean.Util.Path @@ -84,11 +81,9 @@ import Std.Linter.UnreachableTactic import Std.Logic import Std.Tactic.Alias import Std.Tactic.Basic -import Std.Tactic.ByCases import Std.Tactic.Case import Std.Tactic.Change import Std.Tactic.Classical -import Std.Tactic.CoeExt import Std.Tactic.Congr import Std.Tactic.Exact import Std.Tactic.Ext @@ -128,7 +123,6 @@ import Std.Tactic.OpenPrivate import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix -import Std.Tactic.RCases import Std.Tactic.Relation.Rfl import Std.Tactic.Relation.Symm import Std.Tactic.Replace @@ -150,5 +144,4 @@ import Std.Util.ExtendedBinder import Std.Util.LibraryNote import Std.Util.Pickle import Std.Util.ProofWanted -import Std.Util.TermUnsafe import Std.WF diff --git a/Std/Classes/Cast.lean b/Std/Classes/Cast.lean index 3404fbc488..9adeb6ebe0 100644 --- a/Std/Classes/Cast.lean +++ b/Std/Classes/Cast.lean @@ -3,7 +3,6 @@ Copyright (c) 2014 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Gabriel Ebner -/ -import Std.Tactic.CoeExt import Std.Util.LibraryNote /-- Type class for the canonical homomorphism `Nat → R`. -/ diff --git a/Std/Classes/Dvd.lean b/Std/Classes/Dvd.lean deleted file mode 100644 index cbbcd72247..0000000000 --- a/Std/Classes/Dvd.lean +++ /dev/null @@ -1,12 +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 --/ - -/-- Notation typeclass for the `∣` operation (typed as `\|`), which represents divisibility. -/ -class Dvd (α : Type _) where - /-- Divisibility. `a ∣ b` (typed as `\|`) means that there is some `c` such that `b = a * c`. -/ - dvd : α → α → Prop - -@[inherit_doc] infix:50 " ∣ " => Dvd.dvd diff --git a/Std/Classes/LawfulMonad.lean b/Std/Classes/LawfulMonad.lean index ca1a603e24..fa45dd7988 100644 --- a/Std/Classes/LawfulMonad.lean +++ b/Std/Classes/LawfulMonad.lean @@ -224,7 +224,7 @@ theorem SatisfiesM_StateRefT_eq [Monad m] : @[simp] theorem SatisfiesM_ExceptT_eq [Monad m] [LawfulMonad m] : SatisfiesM (m := ExceptT ρ m) (α := α) p x ↔ SatisfiesM (m := m) (∀ a, · = .ok a → p a) x := by refine ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, eq⟩ => eq ▸ ?_⟩ - · exists (fun | .ok ⟨a, h⟩ => ⟨.ok a, fun | _, rfl => h⟩ | .error e => ⟨.error e, fun.⟩) <$> f + · exists (fun | .ok ⟨a, h⟩ => ⟨.ok a, fun | _, rfl => h⟩ | .error e => ⟨.error e, nofun⟩) <$> f show _ = _ >>= _; rw [← comp_map, map_eq_pure_bind]; congr; funext a; cases a <;> rfl · exists ((fun | ⟨.ok a, h⟩ => .ok ⟨a, h _ rfl⟩ | ⟨.error e, _⟩ => .error e) <$> f : m _) show _ >>= _ = _; simp [← comp_map, map_eq_pure_bind]; congr; funext ⟨a, h⟩; cases a <;> rfl diff --git a/Std/CodeAction/Attr.lean b/Std/CodeAction/Attr.lean index 81ac756076..42c6742404 100644 --- a/Std/CodeAction/Attr.lean +++ b/Std/CodeAction/Attr.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Lean.Server.CodeActions -import Std.Util.TermUnsafe /-! # Initial setup for code action attributes diff --git a/Std/Data/Array.lean b/Std/Data/Array.lean index f32f416e07..4d95900523 100644 --- a/Std/Data/Array.lean +++ b/Std/Data/Array.lean @@ -1,5 +1,4 @@ import Std.Data.Array.Basic -import Std.Data.Array.Init.Basic import Std.Data.Array.Init.Lemmas import Std.Data.Array.Lemmas import Std.Data.Array.Match diff --git a/Std/Data/Array/Basic.lean b/Std/Data/Array/Basic.lean index 04975b66a2..c52d77d949 100644 --- a/Std/Data/Array/Basic.lean +++ b/Std/Data/Array/Basic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Floris van Doorn, Jannis Limperg -/ import Std.Data.List.Init.Attach -import Std.Data.Array.Init.Basic import Std.Data.Ord /-! diff --git a/Std/Data/Array/Init/Basic.lean b/Std/Data/Array/Init/Basic.lean deleted file mode 100644 index 5b44d9227d..0000000000 --- a/Std/Data/Array/Init/Basic.lean +++ /dev/null @@ -1,40 +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 --/ - -/-! -## Bootstrapping definitions about arrays - -This file contains some definitions in `Array` needed for `Std.List.Basic`. --/ - -namespace Array - -/-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/ -def zipWithIndex (arr : Array α) : Array (α × Nat) := - arr.mapIdx fun i a => (a, i) - -/-- Like `as.toList ++ l`, but in a single pass. -/ -@[inline] def toListAppend (as : Array α) (l : List α) : List α := - as.foldr List.cons l - -/-- -`ofFn f` with `f : Fin n → α` returns the list whose ith element is `f i`. -``` -ofFn f = #[f 0, f 1, ... , f(n - 1)] -``` -/ -def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where - /-- Auxiliary for `ofFn`. `ofFn.go f i acc = acc ++ #[f i, ..., f(n - 1)]` -/ - go (i : Nat) (acc : Array α) : Array α := - if h : i < n then go (i+1) (acc.push (f ⟨i, h⟩)) else acc -termination_by n - i - -/-- The array `#[0, 1, ..., n - 1]`. -/ -def range (n : Nat) : Array Nat := - n.fold (flip Array.push) #[] - -/-- Turns `#[#[a₁, a₂, ⋯], #[b₁, b₂, ⋯], ⋯]` into `#[a₁, a₂, ⋯, b₁, b₂, ⋯]` -/ -def flatten (arr : Array (Array α)) : Array α := - arr.foldl (init := #[]) fun acc a => acc.append a diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index 01d6358ccc..5833f80ea3 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -3,14 +3,11 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.NoMatch import Std.Tactic.HaveI -import Std.Tactic.ByCases import Std.Classes.LawfulMonad import Std.Data.Fin.Init.Lemmas import Std.Data.Nat.Init.Lemmas import Std.Data.List.Init.Lemmas -import Std.Data.Array.Init.Basic /-! ## Bootstrapping theorems about arrays @@ -166,7 +163,7 @@ theorem SatisfiesM_mapM [Monad m] [LawfulMonad m] (as : Array α) (f : α → m refine SatisfiesM_foldlM (m := m) (β := Array β) (motive := fun i arr => motive i ∧ arr.size = i ∧ ∀ i h2, p i (arr[i.1]'h2)) ?z ?s |>.imp fun ⟨h₁, eq, h₂⟩ => ⟨h₁, eq, fun _ _ => h₂ ..⟩ - · case z => exact ⟨h0, rfl, fun.⟩ + · case z => exact ⟨h0, rfl, nofun⟩ · case s => intro ⟨i, hi⟩ arr ⟨ih₁, eq, ih₂⟩ refine (hs _ ih₁).map fun ⟨h₁, h₂⟩ => ⟨h₂, by simp [eq], fun j hj => ?_⟩ diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 101a85889d..3d8d68f897 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -46,7 +46,7 @@ attribute [simp] isEmpty uget theorem mem_data {a : α} {l : Array α} : a ∈ l.data ↔ a ∈ l := (mem_def _ _).symm -theorem not_mem_nil (a : α) : ¬ a ∈ #[] := fun. +theorem not_mem_nil (a : α) : ¬ a ∈ #[] := nofun /-- # set -/ @@ -271,7 +271,7 @@ theorem SatisfiesM_mapIdxM [Monad m] [LawfulMonad m] (as : Array α) (f : Fin as simp at hi'; simp [get_push]; split · next h => exact h₂ _ _ h · next h => cases h₁.symm ▸ (Nat.le_or_eq_of_le_succ hi').resolve_left h; exact hb.1 - simp [mapIdxM]; exact go rfl (fun.) h0 + simp [mapIdxM]; exact go rfl nofun h0 theorem mapIdx_induction (as : Array α) (f : Fin as.size → α → β) (motive : Nat → Prop) (h0 : motive 0) @@ -315,8 +315,8 @@ theorem size_eq_length_data (as : Array α) : as.size = as.data.length := rfl @[simp] theorem size_range {n : Nat} : (range n).size = n := by unfold range induction n with - | zero => simp only [Nat.fold, size_toArray, List.length_nil, Nat.zero_eq] - | succ k ih => simp only [Nat.fold, flip, size_push, ih] + | zero => simp [Nat.fold] + | succ k ih => rw [Nat.fold, flip]; simpa theorem size_modifyM [Monad m] [LawfulMonad m] (a : Array α) (i : Nat) (f : α → m α) : SatisfiesM (·.size = a.size) (a.modifyM i f) := by @@ -400,7 +400,7 @@ termination_by n - i @[simp] theorem getElem_ofFn (f : Fin n → α) (i : Nat) (h) : (ofFn f)[i] = f ⟨i, size_ofFn f ▸ h⟩ := - getElem_ofFn_go _ _ _ (by simp) (by simp) fun. + getElem_ofFn_go _ _ _ (by simp) (by simp) nofun theorem forIn_eq_data_forIn [Monad m] (as : Array α) (b : β) (f : α → β → m (ForInStep β)) : diff --git a/Std/Data/Array/Match.lean b/Std/Data/Array/Match.lean index f5ff981777..5a2962d44a 100644 --- a/Std/Data/Array/Match.lean +++ b/Std/Data/Array/Match.lean @@ -18,7 +18,7 @@ structure PrefixTable (α : Type _) extends Array (α × Nat) where valid : (h : i < toArray.size) → toArray[i].2 ≤ i instance : Inhabited (PrefixTable α) where - default := ⟨#[], fun.⟩ + default := ⟨#[], nofun⟩ /-- Returns the size of the prefix table -/ abbrev PrefixTable.size (t : PrefixTable α) := t.toArray.size diff --git a/Std/Data/Char.lean b/Std/Data/Char.lean index ed40840832..2c3be7cd13 100644 --- a/Std/Data/Char.lean +++ b/Std/Data/Char.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ import Std.Tactic.Ext.Attr -import Std.Tactic.RCases @[ext] theorem Char.ext : {a b : Char} → a.val = b.val → a = b | ⟨_,_⟩, ⟨_,_⟩, rfl => rfl diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 51b30c152d..ac766e07c5 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -116,7 +116,7 @@ theorem mk_le_of_le_val {b : Fin n} {a : Nat} (h : a ≤ b) : theorem zero_lt_one : (0 : Fin (n + 2)) < 1 := Nat.zero_lt_one -@[simp] theorem not_lt_zero (a : Fin (n + 1)) : ¬a < 0 := fun. +@[simp] theorem not_lt_zero (a : Fin (n + 1)) : ¬a < 0 := nofun theorem pos_iff_ne_zero {a : Fin (n + 1)} : 0 < a ↔ a ≠ 0 := by rw [lt_def, val_zero, Nat.pos_iff_ne_zero, ← val_ne_iff]; rfl @@ -174,7 +174,7 @@ theorem val_lt_last {i : Fin (n + 1)} : i ≠ last n → (i : Nat) < n := theorem subsingleton_iff_le_one : Subsingleton (Fin n) ↔ n ≤ 1 := by (match n with | 0 | 1 | n+2 => ?_) <;> try simp - · exact ⟨fun.⟩ + · exact ⟨nofun⟩ · exact ⟨fun ⟨0, _⟩ ⟨0, _⟩ => rfl⟩ · exact iff_of_false (fun h => Fin.ne_of_lt zero_lt_one (h.elim ..)) (of_decide_eq_false rfl) diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index 82f1f9758e..06378b19da 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -80,7 +80,7 @@ theorem expand_size [Hashable α] {buckets : Buckets α β} : (expand sz buckets).buckets.size = buckets.size := by rw [expand, go] · rw [Buckets.mk_size]; simp [Buckets.size] - · intro. + · nofun where go (i source) (target : Buckets α β) (hs : ∀ j < i, source.data.getD j .nil = .nil) : (expand.go i source target).size = @@ -159,7 +159,7 @@ where | .inl hl => exact hs₁ _ hl | .inr e => exact e ▸ .nil · simp [Array.getElem_eq_data_get, List.get_set]; split - · intro. + · nofun · exact hs₂ _ (by simp_all) · let rank (k : α) := ((hash k).toUSize % source.size).toNat have := expand_WF.foldl rank ?_ (hs₂ _ H) ht.1 (fun _ h₁ _ h₂ => ?_) diff --git a/Std/Data/Int/Basic.lean b/Std/Data/Int/Basic.lean index ee38a18e55..c483dd63c6 100644 --- a/Std/Data/Int/Basic.lean +++ b/Std/Data/Int/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Classes.Dvd import Lean.ToExpr open Nat diff --git a/Std/Data/Int/Lemmas.lean b/Std/Data/Int/Lemmas.lean index 6ef85425f9..e4faa67afa 100644 --- a/Std/Data/Int/Lemmas.lean +++ b/Std/Data/Int/Lemmas.lean @@ -22,7 +22,7 @@ theorem ofNat_two : ((2 : Nat) : Int) = 2 := rfl @[simp] theorem default_eq_zero : default = (0 : Int) := rfl -protected theorem zero_ne_one : (0 : Int) ≠ 1 := fun. +protected theorem zero_ne_one : (0 : Int) ≠ 1 := nofun /- ## Definitions of basic functions -/ @@ -75,9 +75,9 @@ theorem negSucc_inj : negSucc m = negSucc n ↔ m = n := ⟨negSucc.inj, fun H = theorem negSucc_eq (n : Nat) : -[n+1] = -((n : Int) + 1) := rfl -@[simp] theorem negSucc_ne_zero (n : Nat) : -[n+1] ≠ 0 := fun. +@[simp] theorem negSucc_ne_zero (n : Nat) : -[n+1] ≠ 0 := nofun -@[simp] theorem zero_ne_negSucc (n : Nat) : 0 ≠ -[n+1] := fun. +@[simp] theorem zero_ne_negSucc (n : Nat) : 0 ≠ -[n+1] := nofun @[simp, norm_cast] theorem Nat.cast_ofNat_Int : (Nat.cast (no_index (OfNat.ofNat n)) : Int) = OfNat.ofNat n := rfl diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index e2534e641e..6b57f46db6 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -5,8 +5,6 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Data.Int.Lemmas import Std.Data.Option.Basic -import Std.Tactic.RCases -import Std.Tactic.ByCases /-! # Results about the order properties of the integers, and the integers as an ordered ring. @@ -995,7 +993,7 @@ theorem toNat_add_nat {a : Int} (ha : 0 ≤ a) (n : Nat) : (a + n).toNat = a.toN theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm - | -[m+1], n => by constructor <;> intro. + | -[m+1], n => by constructor <;> nofun @[simp] theorem toNat_neg_nat : ∀ n : Nat, (-(n : Int)).toNat = 0 | 0 => rfl diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index 42c32c7955..37bd012a46 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ import Std.Classes.SetNotation -import Std.Tactic.NoMatch import Std.Data.Option.Init.Lemmas import Std.Data.Array.Init.Lemmas @@ -265,7 +264,7 @@ instance : HasSubset (List α) := ⟨List.Subset⟩ instance decidableBEx (p : α → Prop) [DecidablePred p] : ∀ l : List α, Decidable (∃ x ∈ l, p x) - | [] => isFalse fun. + | [] => isFalse nofun | x :: xs => if h₁ : p x then isTrue ⟨x, .head .., h₁⟩ else match decidableBEx p xs with @@ -276,7 +275,7 @@ instance decidableBEx (p : α → Prop) [DecidablePred p] : instance decidableBAll (p : α → Prop) [DecidablePred p] : ∀ l : List α, Decidable (∀ x ∈ l, p x) - | [] => isTrue fun. + | [] => isTrue nofun | x :: xs => if h₁ : p x then match decidableBAll p xs with diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean index c78b28ee90..e651829492 100644 --- a/Std/Data/List/Init/Lemmas.lean +++ b/Std/Data/List/Init/Lemmas.lean @@ -55,7 +55,7 @@ theorem length_eq_zero : length l = 0 ↔ l = [] := /-! ### mem -/ -@[simp] theorem not_mem_nil (a : α) : ¬ a ∈ [] := fun. +@[simp] theorem not_mem_nil (a : α) : ¬ a ∈ [] := nofun @[simp] theorem mem_cons : a ∈ (b :: l) ↔ a = b ∨ a ∈ l := ⟨fun h => by cases h <;> simp [Membership.mem, *], @@ -223,7 +223,7 @@ theorem getLast?_eq_getLast : ∀ l h, @getLast? α l = some (getLast l h) theorem getLast?_eq_get? : ∀ (l : List α), getLast? l = l.get? (l.length - 1) | [] => rfl - | a::l => by rw [getLast?_eq_getLast (a::l) fun., getLast_eq_get, get?_eq_get] + | a::l => by rw [getLast?_eq_getLast (a::l) nofun, getLast_eq_get, get?_eq_get] @[simp] theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by simp [getLast?_eq_get?, Nat.succ_sub_succ] diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 67a776074f..3271ecd1ef 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -18,7 +18,7 @@ open Nat /-! # Basic properties of Lists -/ -theorem cons_ne_nil (a : α) (l : List α) : a :: l ≠ [] := fun. +theorem cons_ne_nil (a : α) (l : List α) : a :: l ≠ [] := nofun theorem cons_ne_self (a : α) (l : List α) : a :: l ≠ l := mt (congrArg length) (Nat.succ_ne_self _) @@ -75,7 +75,7 @@ theorem mem_of_mem_cons_of_mem : ∀ {a b : α} {l : List α}, a ∈ b :: l → theorem eq_or_ne_mem_of_mem {a b : α} {l : List α} (h' : a ∈ b :: l) : a = b ∨ (a ≠ b ∧ a ∈ l) := (Classical.em _).imp_right fun h => ⟨h, (mem_cons.1 h').resolve_left h⟩ -theorem ne_nil_of_mem {a : α} {l : List α} (h : a ∈ l) : l ≠ [] := by cases h <;> intro. +theorem ne_nil_of_mem {a : α} {l : List α} (h : a ∈ l) : l ≠ [] := by cases h <;> nofun theorem append_of_mem {a : α} {l : List α} : a ∈ l → ∃ s t : List α, l = s ++ a :: t | .head l => ⟨[], l, rfl⟩ @@ -355,9 +355,9 @@ theorem bind_map (f : β → γ) (g : α → List β) : /-! ### bounded quantifiers over Lists -/ -theorem exists_mem_nil (p : α → Prop) : ¬∃ x ∈ @nil α, p x := fun. +theorem exists_mem_nil (p : α → Prop) : ¬∃ x ∈ @nil α, p x := nofun -theorem forall_mem_nil (p : α → Prop) : ∀ x ∈ @nil α, p x := fun. +theorem forall_mem_nil (p : α → Prop) : ∀ x ∈ @nil α, p x := nofun theorem exists_mem_cons {p : α → Prop} {a : α} {l : List α} : (∃ x ∈ a :: l, p x) ↔ p a ∨ ∃ x ∈ l, p x := by simp @@ -373,7 +373,7 @@ theorem forall_mem_append {p : α → Prop} {l₁ l₂ : List α} : theorem subset_def {l₁ l₂ : List α} : l₁ ⊆ l₂ ↔ ∀ {a : α}, a ∈ l₁ → a ∈ l₂ := .rfl -@[simp] theorem nil_subset (l : List α) : [] ⊆ l := fun. +@[simp] theorem nil_subset (l : List α) : [] ⊆ l := nofun @[simp] theorem Subset.refl (l : List α) : l ⊆ l := fun _ i => i @@ -414,7 +414,7 @@ fun s => Subset.trans s <| subset_append_right _ _ l₁ ++ l₂ ⊆ l ↔ l₁ ⊆ l ∧ l₂ ⊆ l := by simp [subset_def, or_imp, forall_and] theorem subset_nil {l : List α} : l ⊆ [] ↔ l = [] := - ⟨fun h => match l with | [] => rfl | _::_ => nomatch h (.head ..), fun | rfl => Subset.refl _⟩ + ⟨fun h => match l with | [] => rfl | _::_ => (nomatch h (.head ..)), fun | rfl => Subset.refl _⟩ theorem map_subset {l₁ l₂ : List α} (f : α → β) (H : l₁ ⊆ l₂) : map f l₁ ⊆ map f l₂ := fun x => by simp only [mem_map]; exact .imp fun a => .imp_left (@H _) diff --git a/Std/Data/Nat/Basic.lean b/Std/Data/Nat/Basic.lean index 9a861fdf18..f72796e1b9 100644 --- a/Std/Data/Nat/Basic.lean +++ b/Std/Data/Nat/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ -import Std.Classes.Dvd namespace Nat diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean index a3fc3a7a13..ad1322dd01 100644 --- a/Std/Data/Nat/Bitwise.lean +++ b/Std/Data/Nat/Bitwise.lean @@ -12,7 +12,6 @@ It is primarily intended to support the bitvector library. -/ import Std.Data.Bool import Std.Data.Nat.Lemmas -import Std.Tactic.RCases import Std.Tactic.Simpa namespace Nat diff --git a/Std/Data/Nat/Gcd.lean b/Std/Data/Nat/Gcd.lean index e430e3a5a3..063b34b284 100644 --- a/Std/Data/Nat/Gcd.lean +++ b/Std/Data/Nat/Gcd.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro -/ import Std.Data.Nat.Lemmas -import Std.Tactic.RCases /-! # Definitions and properties of `gcd`, `lcm`, and `coprime` diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index 05819a2dee..30121f1a7f 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -329,7 +329,7 @@ theorem le_succ_of_pred_le : pred n ≤ m → n ≤ succ m := pred_le_iff_le_suc theorem pred_le_of_le_succ : n ≤ succ m → pred n ≤ m := pred_le_iff_le_succ.2 theorem lt_pred_iff_succ_lt : ∀ {n m}, n < pred m ↔ succ n < m - | _, 0 => ⟨fun ., fun .⟩ + | _, 0 => ⟨nofun, nofun⟩ | _, _+1 => Nat.succ_lt_succ_iff.symm theorem succ_lt_of_lt_pred : n < pred m → succ n < m := lt_pred_iff_succ_lt.1 @@ -770,7 +770,7 @@ protected theorem two_mul (n) : 2 * n = n + n := by rw [Nat.succ_mul, Nat.one_mu theorem mul_eq_zero : ∀ {m n}, n * m = 0 ↔ n = 0 ∨ m = 0 | 0, _ => ⟨fun _ => .inr rfl, fun _ => rfl⟩ | _, 0 => ⟨fun _ => .inl rfl, fun _ => Nat.zero_mul ..⟩ - | _+1, _+1 => ⟨fun., fun.⟩ + | _+1, _+1 => ⟨nofun, nofun⟩ protected theorem mul_ne_zero_iff : n * m ≠ 0 ↔ n ≠ 0 ∧ m ≠ 0 := by rw [ne_eq, mul_eq_zero, not_or] diff --git a/Std/Data/Option/Basic.lean b/Std/Data/Option/Basic.lean index 92ea519057..644e2bcd61 100644 --- a/Std/Data/Option/Basic.lean +++ b/Std/Data/Option/Basic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Classes.SetNotation -import Std.Tactic.NoMatch namespace Option @@ -40,7 +39,7 @@ instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (∀ else isFalse <| mt (· _ rfl) h instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (∃ a ∈ o, p a) -| none => isFalse fun. +| none => isFalse nofun | some a => if h : p a then isTrue ⟨_, rfl, h⟩ else isFalse fun ⟨_, ⟨rfl, hn⟩⟩ => h hn /-- Extracts the value `a` from an option that is known to be `some a` for some `a`. -/ diff --git a/Std/Data/Option/Lemmas.lean b/Std/Data/Option/Lemmas.lean index 65eda678c7..fea0a04c28 100644 --- a/Std/Data/Option/Lemmas.lean +++ b/Std/Data/Option/Lemmas.lean @@ -12,7 +12,7 @@ namespace Option theorem mem_iff {a : α} {b : Option α} : a ∈ b ↔ b = a := .rfl -theorem some_ne_none (x : α) : some x ≠ none := fun. +theorem some_ne_none (x : α) : some x ≠ none := nofun protected theorem «forall» {p : Option α → Prop} : (∀ x, p x) ↔ p none ∧ ∀ x, p (some x) := ⟨fun h => ⟨h _, fun _ => h _⟩, fun h x => Option.casesOn x h.1 h.2⟩ @@ -27,7 +27,7 @@ theorem get_mem : ∀ {o : Option α} (h : isSome o), o.get h ∈ o theorem get_of_mem : ∀ {o : Option α} (h : isSome o), a ∈ o → o.get h = a | _, _, rfl => rfl -theorem not_mem_none (a : α) : a ∉ (none : Option α) := fun. +theorem not_mem_none (a : α) : a ∉ (none : Option α) := nofun @[simp] theorem some_get : ∀ {x : Option α} (h : isSome x), some (x.get h) = x | some _, _ => rfl @@ -65,7 +65,7 @@ theorem isSome_iff_exists : isSome x ↔ ∃ a, x = some a := by cases x <;> sim cases a <;> simp theorem eq_some_iff_get_eq : o = some a ↔ ∃ h : o.isSome, o.get h = a := by - cases o <;> simp; intro. + cases o <;> simp; nofun theorem eq_some_of_isSome : ∀ {o : Option α} (h : o.isSome), o = some (o.get h) | some _, _ => rfl diff --git a/Std/Data/PairingHeap.lean b/Std/Data/PairingHeap.lean index fbcdcdcb7f..312b9e3f59 100644 --- a/Std/Data/PairingHeap.lean +++ b/Std/Data/PairingHeap.lean @@ -86,7 +86,7 @@ instance : Decidable (Heap.NoSibling s) := match s with | .nil => isTrue .nil | .node a c .nil => isTrue (.node a c) - | .node _ _ (.node _ _ _) => isFalse fun. + | .node _ _ (.node _ _ _) => isFalse nofun theorem Heap.noSibling_merge (le) (s₁ s₂ : Heap α) : (s₁.merge le s₂).NoSibling := by diff --git a/Std/Data/Prod/Lex.lean b/Std/Data/Prod/Lex.lean index 1fad8987df..7fd404bdfd 100644 --- a/Std/Data/Prod/Lex.lean +++ b/Std/Data/Prod/Lex.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ import Std.Tactic.LeftRight -import Std.Tactic.RCases namespace Prod diff --git a/Std/Data/RBMap/Alter.lean b/Std/Data/RBMap/Alter.lean index 2a13a8c5d8..2d9609ad72 100644 --- a/Std/Data/RBMap/Alter.lean +++ b/Std/Data/RBMap/Alter.lean @@ -183,16 +183,16 @@ protected theorem Balanced.del {path : Path α} | red, ⟨_, h⟩ | black, ⟨_, _, h⟩ => exact h.setBlack | @redL _ n _ _ hb hp ih => match c', n, ht with | red, _, _ => cases hc rfl rfl - | black, _, ⟨_, rfl, ha⟩ => exact ih ((hb.balLeft ha).of_false (fun.)) (fun.) + | black, _, ⟨_, rfl, ha⟩ => exact ih ((hb.balLeft ha).of_false nofun) nofun | @redR _ n _ _ ha hp ih => match c', n, ht with | red, _, _ => cases hc rfl rfl - | black, _, ⟨_, rfl, hb⟩ => exact ih ((ha.balRight hb).of_false (fun.)) (fun.) + | black, _, ⟨_, rfl, hb⟩ => exact ih ((ha.balRight hb).of_false nofun) nofun | @blackL _ _ n _ _ _ hb hp ih => match c', n, ht with - | red, _, ⟨_, ha⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ (fun.) - | black, _, ⟨_, rfl, ha⟩ => exact ih ⟨_, rfl, (hb.balLeft ha).imp fun _ => ⟨⟩⟩ (fun.) + | red, _, ⟨_, ha⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ nofun + | black, _, ⟨_, rfl, ha⟩ => exact ih ⟨_, rfl, (hb.balLeft ha).imp fun _ => ⟨⟩⟩ nofun | @blackR _ _ n _ _ _ ha hp ih => match c', n, ht with - | red, _, ⟨_, hb⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ (fun.) - | black, _, ⟨_, rfl, hb⟩ => exact ih ⟨_, rfl, (ha.balRight hb).imp fun _ => ⟨⟩⟩ (fun.) + | red, _, ⟨_, hb⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ nofun + | black, _, ⟨_, rfl, hb⟩ => exact ih ⟨_, rfl, (ha.balRight hb).imp fun _ => ⟨⟩⟩ nofun /-- Asserts that `p` holds on all elements to the left of the hole. -/ def AllL (p : α → Prop) : Path α → Prop @@ -370,8 +370,8 @@ protected theorem Balanced.alter {t : RBNode α} have ⟨_, _, h, hp⟩ := h.zoom .root eq split · match h with - | .red ha hb => exact ⟨_, hp.del ((ha.append hb).of_false (· rfl rfl)) (fun.)⟩ - | .black ha hb => exact ⟨_, hp.del ⟨_, rfl, (ha.append hb).imp fun _ => ⟨⟩⟩ (fun.)⟩ + | .red ha hb => exact ⟨_, hp.del ((ha.append hb).of_false (· rfl rfl)) nofun⟩ + | .black ha hb => exact ⟨_, hp.del ⟨_, rfl, (ha.append hb).imp fun _ => ⟨⟩⟩ nofun⟩ · match h with | .red ha hb => exact ⟨_, _, hp.fill (.red ha hb)⟩ | .black ha hb => exact ⟨_, _, hp.fill (.black ha hb)⟩ diff --git a/Std/Data/RBMap/Lemmas.lean b/Std/Data/RBMap/Lemmas.lean index f9a00ab6e7..884472710e 100644 --- a/Std/Data/RBMap/Lemmas.lean +++ b/Std/Data/RBMap/Lemmas.lean @@ -258,7 +258,7 @@ theorem lowerBound?_le' {t : RBNode α} (H : ∀ {x}, x ∈ lb → cut x ≠ .lt /-- The value `x` returned by `lowerBound?` is less or equal to the `cut`. -/ theorem lowerBound?_le {t : RBNode α} : t.lowerBound? cut none = some x → cut x ≠ .lt := - lowerBound?_le' (fun.) + lowerBound?_le' nofun theorem All.lowerBound?_lb {t : RBNode α} (hp : t.All p) (H : ∀ {x}, x ∈ lb → p x) : t.lowerBound? cut lb = some x → p x := by @@ -271,14 +271,14 @@ theorem All.lowerBound?_lb {t : RBNode α} (hp : t.All p) (H : ∀ {x}, x ∈ lb · exact fun | rfl => hp.1 theorem All.lowerBound? {t : RBNode α} (hp : t.All p) : t.lowerBound? cut none = some x → p x := - hp.lowerBound?_lb (fun.) + hp.lowerBound?_lb nofun theorem lowerBound?_mem_lb {t : RBNode α} (h : t.lowerBound? cut lb = some x) : x ∈ t ∨ x ∈ lb := All.lowerBound?_lb (p := fun x => x ∈ t ∨ x ∈ lb) (All_def.2 fun _ => .inl) Or.inr h theorem lowerBound?_mem {t : RBNode α} (h : t.lowerBound? cut none = some x) : x ∈ t := - (lowerBound?_mem_lb h).resolve_right (fun.) + (lowerBound?_mem_lb h).resolve_right nofun theorem lowerBound?_of_some {t : RBNode α} : ∃ x, t.lowerBound? cut (some y) = some x := by induction t generalizing y <;> simp [lowerBound?]; split <;> simp [*] @@ -302,7 +302,7 @@ theorem Ordered.lowerBound?_least_lb [@TransCmp α cmp] [IsCut cmp cut] (h : Ord (hlb : ∀ {x}, lb = some x → t.All (cmpLT cmp x ·)) : t.lowerBound? cut lb = some x → y ∈ t → cut x = .gt → cmp x y = .lt → cut y = .lt := by induction t generalizing lb with - | nil => intro. + | nil => nofun | node _ _ _ _ ihl ihr => simp [lowerBound?]; split <;> rename_i hv <;> rintro h₁ (rfl | hy' | hy') hx h₂ · exact hv @@ -328,7 +328,7 @@ strictly greater than the cut (so there is no exact match, and nothing closer to theorem Ordered.lowerBound?_least [@TransCmp α cmp] [IsCut cmp cut] (ht : Ordered cmp t) (H : t.lowerBound? cut none = some x) (hy : y ∈ t) (xy : cmp x y = .lt) (hx : cut x = .gt) : cut y = .lt := - ht.lowerBound?_least_lb (by exact fun.) H hy hx xy + ht.lowerBound?_least_lb (by nofun) H hy hx xy theorem Ordered.memP_iff_lowerBound? [@TransCmp α cmp] [IsCut cmp cut] (ht : Ordered cmp t) : t.MemP cut ↔ ∃ x, t.lowerBound? cut none = some x ∧ cut x = .eq := by @@ -598,7 +598,7 @@ theorem mem_insert [@TransCmp α cmp] {t : RBNode α} (ht : Balanced t c n) (ht simp [← mem_toList, h₂] at h; rw [← or_assoc, or_right_comm] at h refine h.imp_left fun h => ?_ simp [← mem_toList, h₁, h] - rw [find?_eq_zoom, e]; intro. + rw [find?_eq_zoom, e]; nofun | (node .., p) => let ⟨_, _, h₁, h₂⟩ := exists_insert_toList_zoom_node ht e simp [← mem_toList, h₂] at h; simp [← mem_toList, h₁]; rw [or_left_comm] at h ⊢ diff --git a/Std/Data/RBMap/WF.lean b/Std/Data/RBMap/WF.lean index c786122429..7c8bd18775 100644 --- a/Std/Data/RBMap/WF.lean +++ b/Std/Data/RBMap/WF.lean @@ -178,12 +178,12 @@ protected theorem RedRed.balance2 {l : RBNode α} {v : α} {r : RBNode α} /-- The `balance1` function does nothing if the first argument is already balanced. -/ theorem balance1_eq {l : RBNode α} {v : α} {r : RBNode α} (hl : l.Balanced c n) : balance1 l v r = node black l v r := by - unfold balance1; split <;> first | rfl | match hl with. + unfold balance1; split <;> first | rfl | nomatch hl /-- The `balance2` function does nothing if the second argument is already balanced. -/ theorem balance2_eq {l : RBNode α} {v : α} {r : RBNode α} (hr : r.Balanced c n) : balance2 l v r = node black l v r := by - unfold balance2; split <;> first | rfl | match hr with. + unfold balance2; split <;> first | rfl | nomatch hr /-! ## insert -/ @@ -356,10 +356,10 @@ protected theorem Balanced.append {l r : RBNode α} have ⟨_, IH⟩ := (hb.append hc).of_false (· rfl rfl); split · next e => have .red hb' hc' := e ▸ IH - exact .redred (fun.) (.red ha hb') (.red hc' hd) + exact .redred nofun (.red ha hb') (.red hc' hd) · next bcc _ H => match bcc, append b c, IH, H with - | black, _, IH, _ => exact .redred (fun.) ha (.red IH hd) + | black, _, IH, _ => exact .redred nofun ha (.red IH hd) | red, _, .red .., H => cases H _ _ _ rfl · next b c _ _ => have .black ha hb := hl; have .black hc hd := hr @@ -377,10 +377,10 @@ protected theorem Balanced.append {l r : RBNode α} | _, .redred .., H => cases H _ _ _ rfl · have .red hc hd := hr; have IH := hl.append hc have .black ha hb := hl; have ⟨c, IH⟩ := IH.of_false (· rfl rfl) - exact .redred (fun.) IH hd + exact .redred nofun IH hd · have .red ha hb := hl; have IH := hb.append hr have .black hc hd := hr; have ⟨c, IH⟩ := IH.of_false (· rfl rfl) - exact .redred (fun.) ha IH + exact .redred nofun ha IH termination_by l.size + r.size /-! ## erase -/ @@ -448,10 +448,10 @@ protected theorem Balanced.del {t : RBNode α} (h : t.Balanced c n) : unfold del; split · exact match a, n, iha with | .nil, _, _ => ⟨_, .red ha hb⟩ - | .node black .., _, ⟨n, rfl, ha⟩ => (hb.balLeft ha).of_false (fun.) + | .node black .., _, ⟨n, rfl, ha⟩ => (hb.balLeft ha).of_false nofun · exact match b, n, ihb with | .nil, _, _ => ⟨_, .red ha hb⟩ - | .node black .., _, ⟨n, rfl, hb⟩ => (ha.balRight hb).of_false (fun.) + | .node black .., _, ⟨n, rfl, hb⟩ => (ha.balRight hb).of_false nofun · exact (ha.append hb).of_false (· rfl rfl) /-- The `erase` function preserves the ordering invariants. -/ diff --git a/Std/Data/Range/Lemmas.lean b/Std/Data/Range/Lemmas.lean index 958d074a6d..76bc082c3c 100644 --- a/Std/Data/Range/Lemmas.lean +++ b/Std/Data/Range/Lemmas.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.ByCases import Std.Tactic.SeqFocus import Std.Data.List.Lemmas import Std.Data.List.Init.Attach diff --git a/Std/Data/Rat/Basic.lean b/Std/Data/Rat/Basic.lean index db58c98f64..002855654f 100644 --- a/Std/Data/Rat/Basic.lean +++ b/Std/Data/Rat/Basic.lean @@ -97,7 +97,7 @@ instance : OfNat Rat n := ⟨n⟩ /-- Form the quotient `n / d` where `n d : Int`. -/ def divInt : Int → Int → Rat | n, .ofNat d => inline (mkRat n d) - | n, .negSucc d => normalize (-n) d.succ (fun.) + | n, .negSucc d => normalize (-n) d.succ nofun @[inherit_doc] scoped infixl:70 " /. " => Rat.divInt diff --git a/Std/Data/Sum/Basic.lean b/Std/Data/Sum/Basic.lean index ff585c1335..2d60f9ea1c 100644 --- a/Std/Data/Sum/Basic.lean +++ b/Std/Data/Sum/Basic.lean @@ -128,9 +128,9 @@ inductive LiftRel (r : α → γ → Prop) (s : β → δ → Prop) : α ⊕ β @[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) := fun. +@[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) := fun. +@[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⟩ @@ -165,7 +165,7 @@ attribute [simp] Lex.sep @[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) := fun. +@[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 diff --git a/Std/Data/Sum/Lemmas.lean b/Std/Data/Sum/Lemmas.lean index 81acc3cfda..2491660b1a 100644 --- a/Std/Data/Sum/Lemmas.lean +++ b/Std/Data/Sum/Lemmas.lean @@ -90,9 +90,9 @@ theorem inl.inj_iff : (inl a : α ⊕ β) = inl b ↔ a = b := ⟨inl.inj, congr theorem inr.inj_iff : (inr a : α ⊕ β) = inr b ↔ a = b := ⟨inr.inj, congrArg _⟩ -theorem inl_ne_inr : inl a ≠ inr b := fun. +theorem inl_ne_inr : inl a ≠ inr b := nofun -theorem inr_ne_inl : inr b ≠ inl a := fun. +theorem inr_ne_inl : inr b ≠ inl a := nofun /-! ### `Sum.elim` -/ diff --git a/Std/Lean/LocalContext.lean b/Std/Lean/LocalContext.lean deleted file mode 100644 index 94f8781306..0000000000 --- a/Std/Lean/LocalContext.lean +++ /dev/null @@ -1,49 +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, Jannis Limperg --/ -import Lean.LocalContext - -namespace Lean - -/-- -Set the kind of a `LocalDecl`. --/ -def LocalDecl.setKind : LocalDecl → LocalDeclKind → LocalDecl - | cdecl index fvarId userName type bi _, kind => - cdecl index fvarId userName type bi kind - | ldecl index fvarId userName type value nonDep _, kind => - ldecl index fvarId userName type value nonDep kind - -namespace LocalContext - -/-- -Given an `FVarId`, this function returns the corresponding user name, -but only if the name can be used to recover the original FVarId. --/ -def getRoundtrippingUserName? (lctx : LocalContext) (fvarId : FVarId) : Option Name := do - let ldecl₁ ← lctx.find? fvarId - let ldecl₂ ← lctx.findFromUserName? ldecl₁.userName - guard <| ldecl₁.fvarId == ldecl₂.fvarId - some ldecl₁.userName - -/-- -Set the kind of the given fvar. --/ -def setKind (lctx : LocalContext) (fvarId : FVarId) - (kind : LocalDeclKind) : LocalContext := - lctx.modifyLocalDecl fvarId (·.setKind kind) - -/-- -Sort the given `FVarId`s by the order in which they appear in `lctx`. If any of -the `FVarId`s do not appear in `lctx`, the result is unspecified. --/ -def sortFVarsByContextOrder (lctx : LocalContext) (hyps : Array FVarId) : Array FVarId := - let hyps := hyps.map fun fvarId => - match lctx.fvarIdToDecl.find? fvarId with - | none => (0, fvarId) - | some ldecl => (ldecl.index, fvarId) - hyps.qsort (fun h i => h.fst < i.fst) |>.map (·.snd) - -end LocalContext diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index b594d2099c..b24de4566c 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -6,7 +6,6 @@ Authors: Mario Carneiro, Jannis Limperg import Lean.Elab.Term import Lean.Meta.Tactic.Apply import Lean.Meta.Tactic.Replace -import Std.Lean.LocalContext open Lean Lean.Meta @@ -77,49 +76,6 @@ def eraseExprMVarAssignment (mctx : MetavarContext) (mvarId : MVarId) : eAssignment := mctx.eAssignment.erase mvarId dAssignment := mctx.dAssignment.erase mvarId } -/-- -Modify the declaration of a metavariable. If the metavariable is not declared, -the `MetavarContext` is returned unchanged. - -You must ensure that the modification is legal. In particular, expressions may -only be replaced with defeq expressions. --/ -def modifyExprMVarDecl (mctx : MetavarContext) (mvarId : MVarId) - (f : MetavarDecl → MetavarDecl) : MetavarContext := - if let some mdecl := mctx.decls.find? mvarId then - { mctx with decls := mctx.decls.insert mvarId (f mdecl) } - else - mctx - -/-- -Modify the local context of a metavariable. If the metavariable is not declared, -the `MetavarContext` is returned unchanged. - -You must ensure that the modification is legal. In particular, expressions may -only be replaced with defeq expressions. --/ -def modifyExprMVarLCtx (mctx : MetavarContext) (mvarId : MVarId) - (f : LocalContext → LocalContext) : MetavarContext := - mctx.modifyExprMVarDecl mvarId fun mdecl => { mdecl with lctx := f mdecl.lctx } - -/-- -Set the kind of an fvar. If the given metavariable is not declared or the -given fvar doesn't exist in its context, the `MetavarContext` is returned -unchanged. --/ -def setFVarKind (mctx : MetavarContext) (mvarId : MVarId) (fvarId : FVarId) - (kind : LocalDeclKind) : MetavarContext := - mctx.modifyExprMVarLCtx mvarId (·.setKind fvarId kind) - -/-- -Set the `BinderInfo` of an fvar. If the given metavariable is not declared or -the given fvar doesn't exist in its context, the `MetavarContext` is returned -unchanged. --/ -def setFVarBinderInfo (mctx : MetavarContext) (mvarId : MVarId) - (fvarId : FVarId) (bi : BinderInfo) : MetavarContext := - mctx.modifyExprMVarLCtx mvarId (·.setBinderInfo fvarId bi) - /-- Obtain all unassigned metavariables from the given `MetavarContext`. If `includeDelayed` is `true`, delayed-assigned metavariables are considered @@ -139,17 +95,6 @@ end MetavarContext namespace MVarId -/-- -Check whether a metavariable is assigned or delayed-assigned. A -delayed-assigned metavariable is already 'solved' but the solution cannot be -substituted yet because we have to wait for some other metavariables to be -assigned first. So in most situations you want to treat a delayed-assigned -metavariable as assigned. --/ -def isAssignedOrDelayedAssigned [Monad m] [MonadMCtx m] (mvarId : MVarId) : - m Bool := - return (← getMCtx).isExprMVarAssignedOrDelayedAssigned mvarId - /-- Check whether a metavariable is declared. -/ @@ -170,44 +115,6 @@ Erase any assignment or delayed assignment of the given metavariable. def eraseAssignment [MonadMCtx m] (mvarId : MVarId) : m Unit := modifyMCtx (·.eraseExprMVarAssignment mvarId) -/-- -Modify the declaration of a metavariable. If the metavariable is not declared, -nothing happens. - -You must ensure that the modification is legal. In particular, expressions may -only be replaced with defeq expressions. --/ -def modifyDecl [MonadMCtx m] (mvarId : MVarId) - (f : MetavarDecl → MetavarDecl) : m Unit := - modifyMCtx (·.modifyExprMVarDecl mvarId f) - -/-- -Modify the local context of a metavariable. If the metavariable is not declared, -nothing happens. - -You must ensure that the modification is legal. In particular, expressions may -only be replaced with defeq expressions. --/ -def modifyLCtx [MonadMCtx m] (mvarId : MVarId) - (f : LocalContext → LocalContext) : m Unit := - modifyMCtx (·.modifyExprMVarLCtx mvarId f) - -/-- -Set the kind of an fvar. If the given metavariable is not declared or the -given fvar doesn't exist in its context, nothing happens. --/ -def setFVarKind [MonadMCtx m] (mvarId : MVarId) (fvarId : FVarId) - (kind : LocalDeclKind) : m Unit := - modifyMCtx (·.setFVarKind mvarId fvarId kind) - -/-- -Set the `BinderInfo` of an fvar. If the given metavariable is not declared or -the given fvar doesn't exist in its context, nothing happens. --/ -def setFVarBinderInfo [MonadMCtx m] (mvarId : MVarId) (fvarId : FVarId) - (bi : BinderInfo) : m Unit := - modifyMCtx (·.setFVarBinderInfo mvarId fvarId bi) - /-- Collect the metavariables which `mvarId` depends on. These are the metavariables which appear in the type and local context of `mvarId`, as well as the diff --git a/Std/Lean/Position.lean b/Std/Lean/Position.lean index 6b8946efac..000436d3a6 100644 --- a/Std/Lean/Position.lean +++ b/Std/Lean/Position.lean @@ -14,17 +14,6 @@ def Lean.FileMap.utf8RangeToLspRange (text : FileMap) (range : String.Range) : L def Lean.FileMap.rangeOfStx? (text : FileMap) (stx : Syntax) : Option Lsp.Range := text.utf8RangeToLspRange <$> stx.getRange? -/-- Convert a `Lean.Position` to a `String.Pos`. -/ -def Lean.FileMap.ofPosition (text : FileMap) (pos : Position) : String.Pos := - let colPos := - if h : pos.line - 1 < text.positions.size then - text.positions.get ⟨pos.line - 1, h⟩ - else if text.positions.isEmpty then - 0 - else - text.positions.back - String.Iterator.nextn ⟨text.source, colPos⟩ pos.column |>.pos - /-- Return the beginning of the line contatining character `pos`. -/ def Lean.findLineStart (s : String) (pos : String.Pos) : String.Pos := match s.revFindAux (· = '\n') pos with @@ -39,13 +28,3 @@ def Lean.findIndentAndIsStart (s : String) (pos : String.Pos) : Nat × Bool := let start := findLineStart s pos let body := s.findAux (· ≠ ' ') pos start ((body - start).1, body == pos) - -/-- Returns a synthetic Syntax which has the specified `String.Range`. -/ -def Lean.Syntax.ofRange (range : String.Range) (canonical := true) : Lean.Syntax := - .atom (.synthetic range.start range.stop canonical) "" - -/-- Returns the position of the start of (1-based) line `line`. -/ -def Lean.FileMap.lineStart (map : FileMap) (line : Nat) : String.Pos := - if h : line - 1 < map.positions.size then - map.positions.get ⟨line - 1, h⟩ - else map.positions.back?.getD 0 diff --git a/Std/Lean/Tactic.lean b/Std/Lean/Tactic.lean deleted file mode 100644 index a6f7d8f895..0000000000 --- a/Std/Lean/Tactic.lean +++ /dev/null @@ -1,17 +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 --/ -import Lean.Elab.Tactic.Basic - -namespace Lean.Elab.Tactic - -/-- -Like `evalTacticAt`, but without restoring the goal list or pruning solved goals. -Useful when these tasks are already being done in an outer loop. --/ -def evalTacticAtRaw (tac : Syntax) (mvarId : MVarId) : TacticM (List MVarId) := do - setGoals [mvarId] - evalTactic tac - getGoals diff --git a/Std/Logic.lean b/Std/Logic.lean index 4759fdec94..1d6f50171f 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -4,10 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn, Mario Carneiro -/ import Std.Tactic.Init -import Std.Tactic.NoMatch import Std.Tactic.Alias import Std.Tactic.Lint.Misc -import Std.Tactic.ByCases instance {f : α → β} [DecidablePred p] : DecidablePred (p ∘ f) := inferInstanceAs <| DecidablePred fun x => p (f x) @@ -884,14 +882,14 @@ theorem ite_some_none_eq_none [Decidable P] : attribute [simp] inline /-- Ex falso, the nondependent eliminator for the `Empty` type. -/ -def Empty.elim : Empty → C := fun. +def Empty.elim : Empty → C := nofun instance : Subsingleton Empty := ⟨fun a => a.elim⟩ instance : DecidableEq Empty := fun a => a.elim /-- Ex falso, the nondependent eliminator for the `PEmpty` type. -/ -def PEmpty.elim : PEmpty → C := fun. +def PEmpty.elim : PEmpty → C := nofun instance : Subsingleton PEmpty := ⟨fun a => a.elim⟩ diff --git a/Std/Tactic/Basic.lean b/Std/Tactic/Basic.lean index 9872a7361d..0b21cf03f2 100644 --- a/Std/Tactic/Basic.lean +++ b/Std/Tactic/Basic.lean @@ -1,8 +1,6 @@ import Lean.Elab.Tactic.ElabTerm import Std.Linter -import Std.Tactic.ByCases import Std.Tactic.Init -import Std.Tactic.NoMatch import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm import Std.Tactic.SimpTrace diff --git a/Std/Tactic/ByCases.lean b/Std/Tactic/ByCases.lean deleted file mode 100644 index 1fb5495e36..0000000000 --- a/Std/Tactic/ByCases.lean +++ /dev/null @@ -1,83 +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 --/ -import Lean.Parser.Tactic - -/-! -# `by_cases` and `if then else` tactics - -This implements the `if` tactic, which is a structured proof version of `by_cases`. -It allows writing `if h : t then tac1 else tac2` for case analysis on `h : t`, --/ -open Lean Parser.Tactic - --- This is an improved version of `by_cases` from core that uses `Decidable` if possible -macro_rules | `(tactic| by_cases $e) => `(tactic| by_cases h : $e) -macro_rules - | `(tactic| by_cases $h : $e) => - `(tactic| open Classical in refine if $h:ident : $e then ?pos else ?neg) - -private def expandIfThenElse - (ifTk thenTk elseTk pos neg : Syntax) - (mkIf : Term → Term → MacroM Term) : MacroM (TSyntax `tactic) := do - let mkCase tk holeOrTacticSeq mkName : MacroM (Term × Array (TSyntax `tactic)) := do - if holeOrTacticSeq.isOfKind ``Parser.Term.syntheticHole then - pure (⟨holeOrTacticSeq⟩, #[]) - else if holeOrTacticSeq.isOfKind ``Parser.Term.hole then - pure (← mkName, #[]) - else - let hole ← withFreshMacroScope mkName - let holeId := hole.raw[1] - let case ← (open TSyntax.Compat in `(tactic| - case $holeId:ident =>%$tk - -- annotate `then/else` with state after `case` - with_annotate_state $tk skip - $holeOrTacticSeq)) - pure (hole, #[case]) - let (posHole, posCase) ← mkCase thenTk pos `(?pos) - let (negHole, negCase) ← mkCase elseTk neg `(?neg) - `(tactic| (open Classical in refine%$ifTk $(← mkIf posHole negHole); $[$(posCase ++ negCase)]*)) - -/-- -In tactic mode, `if h : t then tac1 else tac2` can be used as alternative syntax for: -``` -by_cases h : t -· tac1 -· tac2 -``` -It performs case distinction on `h : t` or `h : ¬t` and `tac1` and `tac2` are the subproofs. - -You can use `?_` or `_` for either subproof to delay the goal to after the tactic, but -if a tactic sequence is provided for `tac1` or `tac2` then it will require the goal to be closed -by the end of the block. --/ -syntax (name := tacDepIfThenElse) - ppRealGroup(ppRealFill(ppIndent("if " binderIdent " : " term " then") ppSpace matchRhs) - ppDedent(ppSpace) ppRealFill("else " matchRhs)) : tactic - -/-- -In tactic mode, `if t then tac1 else tac2` is alternative syntax for: -``` -by_cases t -· tac1 -· tac2 -``` -It performs case distinction on `h† : t` or `h† : ¬t`, where `h†` is an anonymous -hypothesis, and `tac1` and `tac2` are the subproofs. (It doesn't actually use -nondependent `if`, since this wouldn't add anything to the context and hence would be -useless for proving theorems. To actually insert an `ite` application use -`refine if t then ?_ else ?_`.) --/ -syntax (name := tacIfThenElse) - ppRealGroup(ppRealFill(ppIndent("if " term " then") ppSpace matchRhs) - ppDedent(ppSpace) ppRealFill("else " matchRhs)) : tactic - -macro_rules - | `(tactic| if%$tk $h : $c then%$ttk $pos else%$etk $neg) => - expandIfThenElse tk ttk etk pos neg fun pos neg => `(if $h : $c then $pos else $neg) - -macro_rules - | `(tactic| if%$tk $c then%$ttk $pos else%$etk $neg) => - expandIfThenElse tk ttk etk pos neg fun pos neg => `(if h : $c then $pos else $neg) diff --git a/Std/Tactic/CoeExt.lean b/Std/Tactic/CoeExt.lean deleted file mode 100644 index 8f5508f617..0000000000 --- a/Std/Tactic/CoeExt.lean +++ /dev/null @@ -1,144 +0,0 @@ -/- -Copyright (c) 2022 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro --/ -import Lean.PrettyPrinter.Delaborator.Builtins - -open Lean Elab.Term Meta Std - -/-! -# The `@[coe]` attribute, used to delaborate coercion functions as `↑` - -When writing a coercion, if the pattern -``` -@[coe] -def A.toB (a : A) : B := sorry - -instance : Coe A B where coe := A.toB -``` -is used, then `A.toB a` will be pretty-printed as `↑a`. - -This file also provides `⇑f` and `↥t` notation, which are syntax for `Lean.Meta.coerceToFunction?` -and `Lean.Meta.coerceToSort?` respectively. --/ - -namespace Std.Tactic.Coe - -/-- `⇑ t` coerces `t` to a function. -/ --- the precendence matches that of `coeNotation` -elab:1024 (name := coeFunNotation) "⇑" m:term:1024 : term => do - let x ← elabTerm m none - if let some ty ← coerceToFunction? x then - return ty - else - throwError "cannot coerce to function{indentExpr x}" - -/-- `↥ t` coerces `t` to a type. -/ -elab:1024 (name := coeSortNotation) "↥" t:term:1024 : term => do - let x ← elabTerm t none - if let some ty ← coerceToSort? x then - return ty - else - throwError "cannot coerce to sort{indentExpr x}" - -/-- The different types of coercions that are supported by the `coe` attribute. -/ -inductive CoeFnType - /-- The basic coercion `↑x`, see `CoeT.coe` -/ - | coe - /-- The coercion to a function type, see `CoeFun.coe` -/ - | coeFun - /-- The coercion to a type, see `CoeSort.coe` -/ - | coeSort - deriving Inhabited, Repr, DecidableEq - -instance : ToExpr CoeFnType where - toTypeExpr := mkConst ``CoeFnType - toExpr := open CoeFnType in fun - | coe => mkConst ``coe - | coeFun => mkConst ``coeFun - | coeSort => mkConst ``coeSort - -/-- Information associated to a coercion function to enable sensible delaboration. -/ -structure CoeFnInfo where - /-- The number of arguments to the coercion function -/ - numArgs : Nat - /-- The argument index that represents the value being coerced -/ - coercee : Nat - /-- The type of coercion -/ - type : CoeFnType - deriving Inhabited, Repr - -instance : ToExpr CoeFnInfo where - toTypeExpr := mkConst ``CoeFnInfo - toExpr | ⟨a, b, c⟩ => mkApp3 (mkConst ``CoeFnInfo.mk) (toExpr a) (toExpr b) (toExpr c) - -/-- The environment extension for tracking coercion functions for delaboration -/ -initialize coeExt : SimpleScopedEnvExtension (Name × CoeFnInfo) (NameMap CoeFnInfo) ← - registerSimpleScopedEnvExtension { - addEntry := fun st (n, i) => st.insert n i - initial := {} - } - -/-- Lookup the coercion information for a given function -/ -def getCoeFnInfo? (fn : Name) : CoreM (Option CoeFnInfo) := - return (coeExt.getState (← getEnv)).find? fn - -open PrettyPrinter.Delaborator SubExpr - -/-- -This delaborator tries to elide functions which are known coercions. -For example, `Int.ofNat` is a coercion, so instead of printing `ofNat n` we just print `↑n`, -and when re-parsing this we can (usually) recover the specific coercion being used. --/ -def coeDelaborator (info : CoeFnInfo) : Delab := whenPPOption getPPCoercions do - let n := (← getExpr).getAppNumArgs - withOverApp info.numArgs do - match info.type with - | .coe => `(↑$(← withNaryArg info.coercee delab)) - | .coeFun => - if n = info.numArgs then - `(⇑$(← withNaryArg info.coercee delab)) - else - withNaryArg info.coercee delab - | .coeSort => `(↥$(← withNaryArg info.coercee delab)) - -/-- Add a coercion delaborator for the given function. -/ -def addCoeDelaborator (name : Name) (info : CoeFnInfo) : MetaM Unit := do - let delabName := name ++ `delaborator - addAndCompile <| Declaration.defnDecl { - name := delabName - levelParams := [] - type := mkConst ``Delab - value := mkApp (mkConst ``coeDelaborator) (toExpr info) - hints := .opaque - safety := .safe - } - let kind := `app ++ name - Attribute.add delabName `delab (Unhygienic.run `(attr| delab $(mkIdent kind):ident)) - -/-- Add `name` to the coercion extension and add a coercion delaborator for the function. -/ -def registerCoercion (name : Name) (info : Option CoeFnInfo := none) : MetaM Unit := do - let info ← match info with | some info => pure info | none => do - let fnInfo ← getFunInfo (← mkConstWithLevelParams name) - let some coercee := fnInfo.paramInfo.findIdx? (·.binderInfo.isExplicit) - | throwError "{name} has no explicit arguments" - pure { numArgs := coercee + 1, coercee, type := .coe } - modifyEnv (coeExt.addEntry · (name, info)) - addCoeDelaborator name info - -/-- -The `@[coe]` attribute on a function (which should also appear in a -`instance : Coe A B := ⟨myFn⟩` declaration) allows the delaborator to show -applications of this function as `↑` when printing expressions. --/ -syntax (name := Attr.coe) "coe" : attr - -initialize registerBuiltinAttribute { - name := `coe - descr := "Adds a definition as a coercion" - add := fun decl _stx kind => MetaM.run' do - unless kind == .global do - throwError "cannot add local or scoped coe attribute" - registerCoercion decl -} diff --git a/Std/Tactic/Congr.lean b/Std/Tactic/Congr.lean index 7a784feb95..ebdaf0488d 100644 --- a/Std/Tactic/Congr.lean +++ b/Std/Tactic/Congr.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro, Miyahara Kō -/ import Lean.Meta.Tactic.Congr import Lean.Elab.Tactic.Config -import Std.Tactic.RCases import Std.Tactic.Ext /-! # `congr with` tactic, `rcongr` tactic -/ diff --git a/Std/Tactic/Ext.lean b/Std/Tactic/Ext.lean index c4629e65af..623128e16e 100644 --- a/Std/Tactic/Ext.lean +++ b/Std/Tactic/Ext.lean @@ -3,7 +3,7 @@ Copyright (c) 2021 Gabriel Ebner. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Mario Carneiro -/ -import Std.Tactic.RCases +import Lean.Elab.Tactic.RCases import Std.Tactic.Ext.Attr namespace Std.Tactic.Ext diff --git a/Std/Tactic/Ext/Attr.lean b/Std/Tactic/Ext/Attr.lean index e7b19480ef..141b970e72 100644 --- a/Std/Tactic/Ext/Attr.lean +++ b/Std/Tactic/Ext/Attr.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Gabriel Ebner. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Mario Carneiro -/ -import Std.Tactic.RCases import Std.Lean.Command import Std.Lean.Meta.DiscrTree diff --git a/Std/Tactic/GuardExpr.lean b/Std/Tactic/GuardExpr.lean index c795674282..ef56aeff6d 100644 --- a/Std/Tactic/GuardExpr.lean +++ b/Std/Tactic/GuardExpr.lean @@ -7,7 +7,6 @@ import Lean.Elab.Command import Lean.Elab.Tactic.Conv.Basic import Lean.Meta.Basic import Lean.Meta.Eval -import Std.Util.TermUnsafe namespace Std.Tactic.GuardExpr open Lean Meta Elab Tactic diff --git a/Std/Tactic/Init.lean b/Std/Tactic/Init.lean index 075e179ed8..22101a7127 100644 --- a/Std/Tactic/Init.lean +++ b/Std/Tactic/Init.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Std.Tactic.GuardExpr import Std.Lean.Meta.Basic -import Std.Lean.Tactic /-! # Simple tactics that are used throughout Std. diff --git a/Std/Tactic/Lint/Basic.lean b/Std/Tactic/Lint/Basic.lean index 16f89daf29..a14cea4afd 100644 --- a/Std/Tactic/Lint/Basic.lean +++ b/Std/Tactic/Lint/Basic.lean @@ -3,7 +3,9 @@ Copyright (c) 2020 Floris van Doorn. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Robert Y. Lewis, Gabriel Ebner -/ -import Std.Util.TermUnsafe +import Lean.Structure +import Lean.Elab.InfoTree.Main +import Lean.Elab.Exception open Lean Meta @@ -33,7 +35,7 @@ def isAutoDecl (decl : Name) : CoreM Bool := do if decl.hasMacroScopes then return true if decl.isInternal then return true if let Name.str n s := decl then - if s.startsWith "proof_" || s.startsWith "match_" then return true + if s.startsWith "proof_" || s.startsWith "match_" || s.startsWith "unsafe_" then return true if (← getEnv).isConstructor n && ["injEq", "inj", "sizeOf_spec"].any (· == s) then return true if let ConstantInfo.inductInfo _ := (← getEnv).find? n then diff --git a/Std/Tactic/Lint/Frontend.lean b/Std/Tactic/Lint/Frontend.lean index 41ad25a647..2d75b87c7e 100644 --- a/Std/Tactic/Lint/Frontend.lean +++ b/Std/Tactic/Lint/Frontend.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Robert Y. Lewis, Gabriel Ebner -/ import Lean.Util.Paths +import Lean.Elab.Command import Std.Tactic.Lint.Basic /-! diff --git a/Std/Tactic/Lint/Misc.lean b/Std/Tactic/Lint/Misc.lean index 77773eb5a7..adade058de 100644 --- a/Std/Tactic/Lint/Misc.lean +++ b/Std/Tactic/Lint/Misc.lean @@ -4,9 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Robert Y. Lewis, Arthur Paulino, Gabriel Ebner -/ import Lean.Util.CollectLevelParams +import Lean.Util.ForEachExpr import Lean.Meta.ForEachExpr +import Lean.Meta.GlobalInstances +import Lean.Meta.Check +import Lean.Util.Recognizers +import Lean.DocString import Std.Tactic.Lint.Basic -import Std.Data.Array.Init.Basic open Lean Meta diff --git a/Std/Tactic/Lint/TypeClass.lean b/Std/Tactic/Lint/TypeClass.lean index 61fbca5ff8..a3fb2b3d66 100644 --- a/Std/Tactic/Lint/TypeClass.lean +++ b/Std/Tactic/Lint/TypeClass.lean @@ -3,8 +3,8 @@ Copyright (c) 2022 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner -/ +import Lean.Meta.Instances import Std.Tactic.Lint.Basic -import Std.Data.Array.Init.Basic namespace Std.Tactic.Lint open Lean Meta diff --git a/Std/Tactic/NoMatch.lean b/Std/Tactic/NoMatch.lean index e168a2f560..e72609b905 100644 --- a/Std/Tactic/NoMatch.lean +++ b/Std/Tactic/NoMatch.lean @@ -3,63 +3,40 @@ Copyright (c) 2021 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.OpenPrivate -import Lean.Elab.Match import Lean.Elab.ElabRules /-! -This adds support for the alternative syntax `match x with.` instead of `nomatch x`. It is more -powerful because it supports pattern matching on multiple discriminants, like regular `match`, and -simply has no alternatives in the match. - -Along the same lines, `fun.` is a nullary pattern matching function; it is equivalent to -`fun x y z => match x, y, z with.` where all variables are introduced in order to find an -impossible pattern. The `match x with.` and `intro.` tactics do the same thing but in tactic mode. +Deprecation warnings for `match ⋯ with.`, `fun.`, `λ.`, and `intro.`. -/ namespace Std.Tactic -open Lean Elab Term Parser.Term +open Lean Elab Term Tactic Parser.Term /-- -The syntax `match x with.` is a variant of `nomatch x` which supports pattern matching on multiple -discriminants, like regular `match`, and simply has no alternatives in the match. --/ -syntax:lead (name := noMatch) "match " matchDiscr,* " with" "." : term - -open private elabMatchAux waitExpectedType from Lean.Elab.Match in -/-- Elaborator for `match x with.` -/ -@[term_elab noMatch] def elabNoMatch' : TermElab -| `(match $discrs,* with.), expectedType? => do - let discrs := discrs.getElems - for h : i in [0:discrs.size] do - have h : i < discrs.size := h.2 - let `(matchDiscr| $[$n :]? $discr:term) := discrs[i] | throwUnsupportedSyntax - if ← isAtomicDiscr discr then - tryPostponeIfMVar (← Meta.inferType (← elabTerm discr none)) - else - let discrs := discrs.set ⟨i, h⟩ (← `(matchDiscr| $[$n :]? ?x)) - return ← elabTerm (← `(let_mvar% ?x := $discr; match $discrs,* with.)) expectedType? - let expectedType ← waitExpectedType expectedType? - elabMatchAux none discrs #[] mkNullNode expectedType -| _, _ => throwUnsupportedSyntax +The syntax `match ⋯ with.` has been deprecated in favor of `nomatch ⋯`. -/-- -The syntax `fun.` or `λ.` (dot required) is shorthand for an empty pattern match function, -i.e. `fun x y z => match x, y, z with.` for an appropriate number of arguments. +Both now support multiple discriminants. -/ -elab (name := noFun) tk:"fun" "." : term <= expectedType => do - let (binders, discrs) ← (·.unzip) <$> - Meta.forallTelescopeReducing expectedType fun args _ => - args.mapM fun _ => withFreshMacroScope do - return ((⟨← `(a)⟩ : Ident), ← `(matchDiscr| a)) - elabTerm (← `(@fun%$tk $binders:ident* => match%$tk $discrs:matchDiscr,* with.)) expectedType - -@[inherit_doc noFun] macro tk:"λ" "." : term => `(fun%$tk .) - -@[inherit_doc noMatch] macro "match " discrs:matchDiscr,* " with" "." : tactic => +elab (name := matchWithDot) tk:"match " t:term,* " with" "." : term <= expectedType? => do + logWarningAt tk (← findDocString? (← getEnv) ``matchWithDot).get! + elabTerm (← `(nomatch%$tk $[$t],*)) expectedType? + +/-- The syntax `fun.` has been deprecated in favor of `nofun`. -/ +elab (name := funDot) tk:"fun" "." : term <= expectedType? => do + logWarningAt tk (← findDocString? (← getEnv) ``funDot).get! + elabTerm (← `(nofun)) expectedType? + +/-- The syntax `λ.` has been deprecated in favor of `nofun`. -/ +elab (name := lambdaDot) tk:"fun" "." : term <= expectedType? => do + logWarningAt tk (← findDocString? (← getEnv) ``lambdaDot).get! + elabTerm (← `(nofun)) expectedType? + +@[inherit_doc matchWithDot] +macro "match " discrs:term,* " with" "." : tactic => `(tactic| exact match $discrs,* with.) /-- -The tactic `intro.` is shorthand for `exact fun.`: it introduces the assumptions, then performs an -empty pattern match, closing the goal if the introduced pattern is impossible. +The syntax `intro.` is deprecated in favor of `nofun`. -/ -macro "intro" "." : tactic => `(tactic| exact fun.) +elab (name := introDot) tk:"intro" "." : tactic => do + logWarningAt tk (← findDocString? (← getEnv) ``introDot).get! + evalTactic (← `(tactic| nofun)) diff --git a/Std/Tactic/NormCast.lean b/Std/Tactic/NormCast.lean index 0dafd4770a..e79a0971a6 100644 --- a/Std/Tactic/NormCast.lean +++ b/Std/Tactic/NormCast.lean @@ -6,7 +6,6 @@ Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner import Lean.Elab.Tactic.Conv.Simp import Std.Lean.Meta.Simp import Std.Tactic.NormCast.Ext -import Std.Tactic.CoeExt import Std.Classes.Cast /-! @@ -15,7 +14,6 @@ import Std.Classes.Cast open Lean Meta Simp open Std.Tactic.NormCast -open Std.Tactic.Coe namespace Std.Tactic.NormCast diff --git a/Std/Tactic/NormCast/Ext.lean b/Std/Tactic/NormCast/Ext.lean index d85f3f7745..b43ae5bad2 100644 --- a/Std/Tactic/NormCast/Ext.lean +++ b/Std/Tactic/NormCast/Ext.lean @@ -3,14 +3,13 @@ Copyright (c) 2019 Paul-Nicolas Madelaine. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner -/ +import Lean.Meta.CoeAttr import Lean.Meta.CongrTheorems import Lean.Meta.Tactic.Simp.SimpTheorems -import Std.Tactic.CoeExt open Lean Meta namespace Std.Tactic.NormCast -open Tactic.Coe /-- `Label` is a type used to classify `norm_cast` lemmas. diff --git a/Std/Tactic/Omega/Constraint.lean b/Std/Tactic/Omega/Constraint.lean index a4834d0936..129fc20a4b 100644 --- a/Std/Tactic/Omega/Constraint.lean +++ b/Std/Tactic/Omega/Constraint.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Classes.Order -import Std.Tactic.RCases import Std.Tactic.NormCast import Std.Tactic.Omega.Coeffs.IntList diff --git a/Std/Tactic/RCases.lean b/Std/Tactic/RCases.lean deleted file mode 100644 index 68c8cf75cb..0000000000 --- a/Std/Tactic/RCases.lean +++ /dev/null @@ -1,760 +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, Jacob von Raumer --/ -import Lean.Elab.Tactic.Induction - -/-! - -# Recursive cases (`rcases`) tactic and related tactics - -`rcases` is a tactic that will perform `cases` recursively, according to a pattern. It is used to -destructure hypotheses or expressions composed of inductive types like `h1 : a ∧ b ∧ c ∨ d` or -`h2 : ∃ x y, trans_rel R x y`. Usual usage might be `rcases h1 with ⟨ha, hb, hc⟩ | hd` or -`rcases h2 with ⟨x, y, _ | ⟨z, hxz, hzy⟩⟩` for these examples. - -Each element of an `rcases` pattern is matched against a particular local hypothesis (most of which -are generated during the execution of `rcases` and represent individual elements destructured from -the input expression). An `rcases` pattern has the following grammar: - -* A name like `x`, which names the active hypothesis as `x`. -* A blank `_`, which does nothing (letting the automatic naming system used by `cases` name the - hypothesis). -* A hyphen `-`, which clears the active hypothesis and any dependents. -* The keyword `rfl`, which expects the hypothesis to be `h : a = b`, and calls `subst` on the - hypothesis (which has the effect of replacing `b` with `a` everywhere or vice versa). -* A type ascription `p : ty`, which sets the type of the hypothesis to `ty` and then matches it - against `p`. (Of course, `ty` must unify with the actual type of `h` for this to work.) -* A tuple pattern `⟨p1, p2, p3⟩`, which matches a constructor with many arguments, or a series - of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`, - then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b` - and so on. -* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor, - while leaving the `@` off will only use the patterns on the explicit arguments. -* An alternation pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors, - or a nested disjunction like `a ∨ b ∨ c`. - -The patterns are fairly liberal about the exact shape of the constructors, and will insert -additional alternation branches and tuple arguments if there are not enough arguments provided, and -reuse the tail for further matches if there are too many arguments provided to alternation and -tuple patterns. - -This file also contains the `obtain` and `rintro` tactics, which use the same syntax of `rcases` -patterns but with a slightly different use case: - -* `rintro` (or `rintros`) is used like `rintro x ⟨y, z⟩` and is the same as `intros` followed by - `rcases` on the newly introduced arguments. -* `obtain` is the same as `rcases` but with a syntax styled after `have` rather than `cases`. - `obtain ⟨hx, hy⟩ | hz := foo` is equivalent to `rcases foo with ⟨hx, hy⟩ | hz`. Unlike `rcases`, - `obtain` also allows one to omit `:= foo`, although a type must be provided in this case, - as in `obtain ⟨hx, hy⟩ | hz : a ∧ b ∨ c`, in which case it produces a subgoal for proving - `a ∧ b ∨ c` in addition to the subgoals `hx : a, hy : b |- goal` and `hz : c |- goal`. - -## Tags - -rcases, rintro, obtain, destructuring, cases, pattern matching, match --/ - -/-- -Constructs a substitution consisting of `s` followed by `t`. -This satisfies `(s.append t).apply e = t.apply (s.apply e)` --/ -def Lean.Meta.FVarSubst.append (s t : FVarSubst) : FVarSubst := - s.1.foldl (fun s' k v => s'.insert k (t.apply v)) t - -namespace Std.Tactic.RCases -open Lean Meta - -/-- -Enables the 'unused rcases pattern' linter. This will warn when a pattern is ignored by -`rcases`, `rintro`, `ext` and similar tactics. --/ -register_option linter.unusedRCasesPattern : Bool := { - defValue := true - descr := "enable the 'unused rcases pattern' linter" -} - -/-- The syntax category of `rcases` patterns. -/ -declare_syntax_cat rcasesPat -/-- A medium precedence `rcases` pattern is a list of `rcasesPat` separated by `|` -/ -syntax rcasesPatMed := sepBy1(rcasesPat, " | ") -/-- A low precedence `rcases` pattern is a `rcasesPatMed` optionally followed by `: ty` -/ -syntax rcasesPatLo := rcasesPatMed (" : " term)? -/-- `x` is a pattern which binds `x` -/ -syntax (name := rcasesPat.one) ident : rcasesPat -/-- `_` is a pattern which ignores the value and gives it an inaccessible name -/ -syntax (name := rcasesPat.ignore) "_" : rcasesPat -/-- `-` is a pattern which removes the value from the context -/ -syntax (name := rcasesPat.clear) "-" : rcasesPat -/-- -A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor, -while leaving the `@` off will only use the patterns on the explicit arguments. --/ -syntax (name := rcasesPat.explicit) "@" noWs rcasesPat : rcasesPat -/-- -`⟨pat, ...⟩` is a pattern which matches on a tuple-like constructor -or multi-argument inductive constructor --/ -syntax (name := rcasesPat.tuple) "⟨" rcasesPatLo,* "⟩" : rcasesPat -/-- `(pat)` is a pattern which resets the precedence to low -/ -syntax (name := rcasesPat.paren) "(" rcasesPatLo ")" : rcasesPat - -/-- The syntax category of `rintro` patterns. -/ -declare_syntax_cat rintroPat -/-- An `rcases` pattern is an `rintro` pattern -/ -syntax (name := rintroPat.one) rcasesPat : rintroPat -/-- -A multi argument binder `(pat1 pat2 : ty)` binds a list of patterns and gives them all type `ty`. --/ -syntax(name := rintroPat.binder) (priority := default+1) -- to override rcasesPat.paren - "(" rintroPat+ (" : " term)? ")" : rintroPat - -instance : Coe Ident (TSyntax `rcasesPat) where - coe stx := Unhygienic.run `(rcasesPat| $stx:ident) -instance : Coe (TSyntax `rcasesPat) (TSyntax ``rcasesPatMed) where - coe stx := Unhygienic.run `(rcasesPatMed| $stx:rcasesPat) -instance : Coe (TSyntax ``rcasesPatMed) (TSyntax ``rcasesPatLo) where - coe stx := Unhygienic.run `(rcasesPatLo| $stx:rcasesPatMed) -instance : Coe (TSyntax `rcasesPat) (TSyntax `rintroPat) where - coe stx := Unhygienic.run `(rintroPat| $stx:rcasesPat) - -/-- A list, with a disjunctive meaning (like a list of inductive constructors, or subgoals) -/ -local notation "ListΣ" => List - -/-- A list, with a conjunctive meaning (like a list of constructor arguments, or hypotheses) -/ -local notation "ListΠ" => List - -/-- -An `rcases` pattern can be one of the following, in a nested combination: - -* A name like `foo` -* The special keyword `rfl` (for pattern matching on equality using `subst`) -* A hyphen `-`, which clears the active hypothesis and any dependents. -* A type ascription like `pat : ty` (parentheses are optional) -* A tuple constructor like `⟨p1, p2, p3⟩` -* An alternation / variant pattern `p1 | p2 | p3` - -Parentheses can be used for grouping; alternation is higher precedence than type ascription, so -`p1 | p2 | p3 : ty` means `(p1 | p2 | p3) : ty`. - -N-ary alternations are treated as a group, so `p1 | p2 | p3` is not the same as `p1 | (p2 | p3)`, -and similarly for tuples. However, note that an n-ary alternation or tuple can match an n-ary -conjunction or disjunction, because if the number of patterns exceeds the number of constructors in -the type being destructed, the extra patterns will match on the last element, meaning that -`p1 | p2 | p3` will act like `p1 | (p2 | p3)` when matching `a1 ∨ a2 ∨ a3`. If matching against a -type with 3 constructors, `p1 | (p2 | p3)` will act like `p1 | (p2 | p3) | _` instead. --/ -inductive RCasesPatt : Type - /-- A parenthesized expression, used for hovers -/ - | paren (ref : Syntax) : RCasesPatt → RCasesPatt - /-- A named pattern like `foo` -/ - | one (ref : Syntax) : Name → RCasesPatt - /-- A hyphen `-`, which clears the active hypothesis and any dependents. -/ - | clear (ref : Syntax) : RCasesPatt - /-- An explicit pattern `@pat`. -/ - | explicit (ref : Syntax) : RCasesPatt → RCasesPatt - /-- A type ascription like `pat : ty` (parentheses are optional) -/ - | typed (ref : Syntax) : RCasesPatt → Term → RCasesPatt - /-- A tuple constructor like `⟨p1, p2, p3⟩` -/ - | tuple (ref : Syntax) : ListΠ RCasesPatt → RCasesPatt - /-- An alternation / variant pattern `p1 | p2 | p3` -/ - | alts (ref : Syntax) : ListΣ RCasesPatt → RCasesPatt - deriving Repr - -namespace RCasesPatt - -instance : Inhabited RCasesPatt := ⟨RCasesPatt.one Syntax.missing `_⟩ - -/-- Get the name from a pattern, if provided -/ -partial def name? : RCasesPatt → Option Name - | one _ `_ => none - | one _ `rfl => none - | one _ n => n - | paren _ p - | typed _ p _ - | alts _ [p] => p.name? - | _ => none - -/-- Get the syntax node from which this pattern was parsed. Used for error messages -/ -def ref : RCasesPatt → Syntax - | paren ref _ - | one ref _ - | clear ref - | explicit ref _ - | typed ref _ _ - | tuple ref _ - | alts ref _ => ref - -/-- -Interpret an rcases pattern as a tuple, where `p` becomes `⟨p⟩` if `p` is not already a tuple. --/ -def asTuple : RCasesPatt → Bool × ListΠ RCasesPatt - | paren _ p => p.asTuple - | explicit _ p => (true, p.asTuple.2) - | tuple _ ps => (false, ps) - | p => (false, [p]) - -/-- -Interpret an rcases pattern as an alternation, where non-alternations are treated as one -alternative. --/ -def asAlts : RCasesPatt → ListΣ RCasesPatt - | paren _ p => p.asAlts - | alts _ ps => ps - | p => [p] - -/-- Convert a list of patterns to a tuple pattern, but mapping `[p]` to `p` instead of `⟨p⟩`. -/ -def typed? (ref : Syntax) : RCasesPatt → Option Term → RCasesPatt - | p, none => p - | p, some ty => typed ref p ty - -/-- Convert a list of patterns to a tuple pattern, but mapping `[p]` to `p` instead of `⟨p⟩`. -/ -def tuple' : ListΠ RCasesPatt → RCasesPatt - | [p] => p - | ps => tuple (ps.head?.map (·.ref) |>.getD .missing) ps - -/-- -Convert a list of patterns to an alternation pattern, but mapping `[p]` to `p` instead of -a unary alternation `|p`. --/ -def alts' (ref : Syntax) : ListΣ RCasesPatt → RCasesPatt - | [p] => p - | ps => alts ref ps - -/-- -This function is used for producing rcases patterns based on a case tree. Suppose that we have -a list of patterns `ps` that will match correctly against the branches of the case tree for one -constructor. This function will merge tuples at the end of the list, so that `[a, b, ⟨c, d⟩]` -becomes `⟨a, b, c, d⟩` instead of `⟨a, b, ⟨c, d⟩⟩`. - -We must be careful to turn `[a, ⟨⟩]` into `⟨a, ⟨⟩⟩` instead of `⟨a⟩` (which will not perform the -nested match). --/ -def tuple₁Core : ListΠ RCasesPatt → ListΠ RCasesPatt - | [] => [] - | [tuple ref []] => [tuple ref []] - | [tuple _ ps] => ps - | p :: ps => p :: tuple₁Core ps - -/-- -This function is used for producing rcases patterns based on a case tree. This is like -`tuple₁Core` but it produces a pattern instead of a tuple pattern list, converting `[n]` to `n` -instead of `⟨n⟩` and `[]` to `_`, and otherwise just converting `[a, b, c]` to `⟨a, b, c⟩`. --/ -def tuple₁ : ListΠ RCasesPatt → RCasesPatt - | [] => default - | [one ref n] => one ref n - | ps => tuple ps.head!.ref $ tuple₁Core ps - -/-- -This function is used for producing rcases patterns based on a case tree. Here we are given -the list of patterns to apply to each argument of each constructor after the main case, and must -produce a list of alternatives with the same effect. This function calls `tuple₁` to make the -individual alternatives, and handles merging `[a, b, c | d]` to `a | b | c | d` instead of -`a | b | (c | d)`. --/ -def alts₁Core : ListΣ (ListΠ RCasesPatt) → ListΣ RCasesPatt - | [] => [] - | [[alts _ ps]] => ps - | p :: ps => tuple₁ p :: alts₁Core ps - -/-- -This function is used for producing rcases patterns based on a case tree. This is like -`alts₁Core`, but it produces a cases pattern directly instead of a list of alternatives. We -specially translate the empty alternation to `⟨⟩`, and translate `|(a | b)` to `⟨a | b⟩` (because we -don't have any syntax for unary alternation). Otherwise we can use the regular merging of -alternations at the last argument so that `a | b | (c | d)` becomes `a | b | c | d`. --/ -def alts₁ (ref : Syntax) : ListΣ (ListΠ RCasesPatt) → RCasesPatt - | [[]] => tuple .missing [] - | [[alts ref ps]] => tuple ref ps - | ps => alts' ref $ alts₁Core ps - -open MessageData in -partial instance : ToMessageData RCasesPatt := ⟨fmt 0⟩ where - /-- parenthesize the message if the precedence is above `tgt` -/ - parenAbove (tgt p : Nat) (m : MessageData) : MessageData := - if tgt < p then m.paren else m - /-- format an `RCasesPatt` with the given precedence: 0 = lo, 1 = med, 2 = hi -/ - fmt : Nat → RCasesPatt → MessageData - | p, paren _ pat => fmt p pat - | _, one _ n => n - | _, clear _ => "-" - | _, explicit _ pat => m!"@{fmt 2 pat}" - | p, typed _ pat ty => parenAbove 0 p m!"{fmt 1 pat}: {ty}" - | _, tuple _ pats => bracket "⟨" (joinSep (pats.map (fmt 0)) ("," ++ Format.line)) "⟩" - | p, alts _ pats => parenAbove 1 p (joinSep (pats.map (fmt 2)) " | ") - -end RCasesPatt - -/-- -Takes the number of fields of a single constructor and patterns to match its fields against -(not necessarily the same number). The returned lists each contain one element per field of the -constructor. The `name` is the name which will be used in the top-level `cases` tactic, and the -`rcases_patt` is the pattern which the field will be matched against by subsequent `cases` -tactics. --/ -def processConstructor (ref : Syntax) (info : Array ParamInfo) - (explicit : Bool) (idx : Nat) (ps : ListΠ RCasesPatt) : ListΠ Name × ListΠ RCasesPatt := - if _ : idx < info.size then - if !explicit && info[idx].binderInfo != .default then - let (ns, tl) := processConstructor ref info explicit (idx+1) ps - (`_ :: ns, default :: tl) - else if idx+1 < info.size then - let p := ps.headD default - let (ns, tl) := processConstructor ref info explicit (idx+1) (ps.tailD []) - (p.name?.getD `_ :: ns, p :: tl) - else match ps with - | [] => ([`_], [default]) - | [p] => ([p.name?.getD `_], [p]) - | ps => ([`_], [(bif explicit then .explicit ref else id) (.tuple ref ps)]) - else ([], []) -termination_by info.size - idx - -/-- -Takes a list of constructor names, and an (alternation) list of patterns, and matches each -pattern against its constructor. It returns the list of names that will be passed to `cases`, -and the list of `(constructor name, patterns)` for each constructor, where `patterns` is the -(conjunctive) list of patterns to apply to each constructor argument. --/ -def processConstructors (ref : Syntax) (params : Nat) (altVarNames : Array AltVarNames := #[]) : - ListΣ Name → ListΣ RCasesPatt → MetaM (Array AltVarNames × ListΣ (Name × ListΠ RCasesPatt)) - | [], _ => pure (altVarNames, []) - | c :: cs, ps => do - let info := (← getFunInfo (← mkConstWithLevelParams c)).paramInfo - let p := ps.headD default - let t := ps.tailD [] - let ((explicit, h), t) := match cs, t with - | [], _ :: _ => ((false, [RCasesPatt.alts ref ps]), []) - | _, _ => (p.asTuple, t) - let (ns, ps) := processConstructor p.ref info explicit params h - let (altVarNames, r) ← processConstructors ref params (altVarNames.push ⟨true, ns⟩) cs t - pure (altVarNames, (c, ps) :: r) - -open Elab Tactic - --- TODO(Mario): this belongs in core -/-- Like `Lean.Meta.subst`, but preserves the `FVarSubst`. -/ -def subst' (goal : MVarId) (hFVarId : FVarId) - (fvarSubst : FVarSubst := {}) : MetaM (FVarSubst × MVarId) := do - let hLocalDecl ← hFVarId.getDecl - let error {α} _ : MetaM α := throwTacticEx `subst goal - m!"invalid equality proof, it is not of the form (x = t) or (t = x){indentExpr hLocalDecl.type}" - let some (_, lhs, rhs) ← matchEq? hLocalDecl.type | error () - let substReduced (newType : Expr) (symm : Bool) : MetaM (FVarSubst × MVarId) := do - let goal ← goal.assert hLocalDecl.userName newType (mkFVar hFVarId) - let (hFVarId', goal) ← goal.intro1P - let goal ← goal.clear hFVarId - substCore goal hFVarId' (symm := symm) (tryToSkip := true) (fvarSubst := fvarSubst) - let rhs' ← whnf rhs - if rhs'.isFVar then - if rhs != rhs' then - substReduced (← mkEq lhs rhs') true - else - substCore goal hFVarId (symm := true) (tryToSkip := true) (fvarSubst := fvarSubst) - else - let lhs' ← whnf lhs - if lhs'.isFVar then - if lhs != lhs' then - substReduced (← mkEq lhs' rhs) false - else - substCore goal hFVarId (symm := false) (tryToSkip := true) (fvarSubst := fvarSubst) - else error () - -mutual - -/-- -This will match a pattern `pat` against a local hypothesis `e`. -* `g`: The initial subgoal -* `fs`: A running variable substitution, the result of `cases` operations upstream. - The variable `e` must be run through this map before locating it in the context of `g`, - and the output variable substitutions will be end extensions of this one. -* `clears`: The list of variables to clear in all subgoals generated from this point on. - We defer clear operations because clearing too early can cause `cases` to fail. - The actual clearing happens in `RCases.finish`. -* `e`: a local hypothesis, the scrutinee to match against. -* `a`: opaque "user data" which is passed through all the goal calls at the end. -* `pat`: the pattern to match against -* `cont`: A continuation. This is called on every goal generated by the result of the pattern - match, with updated values for `g` , `fs`, `clears`, and `a`. --/ -partial def rcasesCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (e : Expr) (a : α) - (pat : RCasesPatt) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : - TermElabM α := do - let asFVar : Expr → MetaM _ - | .fvar e => pure e - | e => throwError "rcases tactic failed: {e} is not a fvar" - withRef pat.ref <| g.withContext do match pat with - | .one ref `rfl => - Term.synthesizeSyntheticMVarsNoPostponing - -- Note: the mdata prevents the span from getting highlighted like a variable - Term.addTermInfo' ref (.mdata {} e) - let (fs, g) ← subst' g (← asFVar (fs.apply e)) fs - cont g fs clears a - | .one ref _ => - if e.isFVar then - Term.addLocalVarInfo ref e - cont g fs clears a - | .clear ref => - Term.addTermInfo' ref (.mdata {} e) - cont g fs (if let .fvar e := e then clears.push e else clears) a - | .typed ref pat ty => - Term.addTermInfo' ref (.mdata {} e) - let expected ← Term.elabType ty - let e := fs.apply e - let etype ← inferType e - unless ← isDefEq etype expected do - Term.throwTypeMismatchError "rcases: scrutinee" expected etype e - let g ← if let .fvar e := e then g.replaceLocalDeclDefEq e expected else pure g - rcasesCore g fs clears e a pat cont - | .paren ref p - | .alts ref [p] => - Term.addTermInfo' ref (.mdata {} e) - rcasesCore g fs clears e a p cont - | _ => - Term.addTermInfo' pat.ref (.mdata {} e) - let e := fs.apply e - let _ ← asFVar e - Term.synthesizeSyntheticMVarsNoPostponing - let type ← whnfD (← inferType e) - let failK {α} _ : TermElabM α := - throwError "rcases tactic failed: {e} : {type} is not an inductive datatype" - let (r, subgoals) ← matchConst type.getAppFn failK fun - | ConstantInfo.quotInfo info, _ => do - unless info.kind matches QuotKind.type do failK () - let pat := pat.asAlts.headD default - let (explicit, pat₁) := pat.asTuple - let ([x], ps) := processConstructor pat.ref #[{}] explicit 0 pat₁ | unreachable! - let (vars, g) ← g.revert (← getFVarsToGeneralize #[e]) - g.withContext do - let elimInfo ← getElimInfo `Quot.ind - let res ← ElimApp.mkElimApp elimInfo #[e] (← g.getTag) - let elimArgs := res.elimApp.getAppArgs - ElimApp.setMotiveArg g elimArgs[elimInfo.motivePos]!.mvarId! #[e.fvarId!] - g.assign res.elimApp - let #[{ name := n, mvarId := g, .. }] := res.alts | unreachable! - let (v, g) ← g.intro x - let (varsOut, g) ← g.introNP vars.size - let fs' := (vars.zip varsOut).foldl (init := fs) fun fs (v, w) => fs.insert v (mkFVar w) - pure ([(n, ps)], #[⟨⟨g, #[mkFVar v], fs'⟩, n⟩]) - | ConstantInfo.inductInfo info, _ => do - let (altVarNames, r) ← processConstructors pat.ref info.numParams #[] info.ctors pat.asAlts - (r, ·) <$> g.cases e.fvarId! altVarNames - | _, _ => failK () - (·.2) <$> subgoals.foldlM (init := (r, a)) fun (r, a) ⟨goal, ctorName⟩ => do - let rec - /-- Runs `rcasesContinue` on the first pattern in `r` with a matching `ctorName`. - The unprocessed patterns (subsequent to the matching pattern) are returned. -/ - align : ListΠ (Name × ListΠ RCasesPatt) → TermElabM (ListΠ (Name × ListΠ RCasesPatt) × α) - | [] => pure ([], a) - | (tgt, ps) :: as => do - if tgt == ctorName then - let fs := fs.append goal.subst - (as, ·) <$> rcasesContinue goal.mvarId fs clears a (ps.zip goal.fields.toList) cont - else - align as - align r - -/-- -This will match a list of patterns against a list of hypotheses `e`. The arguments are similar -to `rcasesCore`, but the patterns and local variables are in `pats`. Because the calls are all -nested in continuations, later arguments can be matched many times, once per goal produced by -earlier arguments. For example `⟨a | b, ⟨c, d⟩⟩` performs the `⟨c, d⟩` match twice, once on the -`a` branch and once on `b`. --/ -partial def rcasesContinue (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a : α) - (pats : ListΠ (RCasesPatt × Expr)) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : - TermElabM α := - match pats with - | [] => cont g fs clears a - | ((pat, e) :: ps) => - rcasesCore g fs clears e a pat fun g fs clears a => - rcasesContinue g fs clears a ps cont - -end - -/-- Like `tryClearMany`, but also clears dependent hypotheses if possible -/ -def tryClearMany' (goal : MVarId) (fvarIds : Array FVarId) : MetaM MVarId := do - let mut toErase := fvarIds - for localDecl in (← goal.getDecl).lctx do - if ← findLocalDeclDependsOn localDecl toErase.contains then - toErase := toErase.push localDecl.fvarId - goal.tryClearMany toErase - -/-- -The terminating continuation used in `rcasesCore` and `rcasesContinue`. We specialize the type -`α` to `Array MVarId` to collect the list of goals, and given the list of `clears`, it attempts to -clear them from the goal and adds the goal to the list. --/ -def finish (toTag : Array (Ident × FVarId) := #[]) - (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) - (gs : Array MVarId) : TermElabM (Array MVarId) := do - let cs : Array Expr := (clears.map fs.get).filter Expr.isFVar - let g ← tryClearMany' g (cs.map Expr.fvarId!) - g.withContext do - for (stx, fvar) in toTag do - Term.addLocalVarInfo stx (fs.get fvar) - return gs.push g - -open Elab - -/-- Parses a `Syntax` into the `RCasesPatt` type used by the `RCases` tactic. -/ -partial def RCasesPatt.parse (stx : Syntax) : MetaM RCasesPatt := - match stx with - | `(rcasesPatMed| $ps:rcasesPat|*) => return .alts' stx (← ps.getElems.toList.mapM (parse ·.raw)) - | `(rcasesPatLo| $pat:rcasesPatMed : $t:term) => return .typed stx (← parse pat) t - | `(rcasesPatLo| $pat:rcasesPatMed) => parse pat - | `(rcasesPat| _) => return .one stx `_ - | `(rcasesPat| $h:ident) => return .one h h.getId - | `(rcasesPat| -) => return .clear stx - | `(rcasesPat| @$pat) => return .explicit stx (← parse pat) - | `(rcasesPat| ⟨$ps,*⟩) => return .tuple stx (← ps.getElems.toList.mapM (parse ·.raw)) - | `(rcasesPat| ($pat)) => return .paren stx (← parse pat) - | _ => throwUnsupportedSyntax - --- extracted from elabCasesTargets -/-- Generalize all the arguments as specified in `args` to fvars if they aren't already -/ -def generalizeExceptFVar (goal : MVarId) (args : Array GeneralizeArg) : - MetaM (Array Expr × Array FVarId × MVarId) := do - let argsToGeneralize := args.filter fun arg => !(arg.expr.isFVar && arg.hName?.isNone) - let (fvarIdsNew, goal) ← goal.generalize argsToGeneralize - let mut result := #[] - let mut j := 0 - for arg in args do - if arg.expr.isFVar && arg.hName?.isNone then - result := result.push arg.expr - else - result := result.push (mkFVar fvarIdsNew[j]!) - j := j+1 - pure (result, fvarIdsNew[j:], goal) - -/-- -Given a list of targets of the form `e` or `h : e`, and a pattern, match all the targets -against the pattern. Returns the list of produced subgoals. --/ -def rcases (tgts : Array (Option Ident × Syntax)) - (pat : RCasesPatt) (g : MVarId) : TermElabM (List MVarId) := Term.withSynthesize do - let pats ← match tgts.size with - | 0 => return [g] - | 1 => pure [pat] - | _ => pure (processConstructor pat.ref (tgts.map fun _ => {}) false 0 pat.asTuple.2).2 - let (pats, args) := Array.unzip <|← (tgts.zip pats.toArray).mapM fun ((hName?, tgt), pat) => do - let (pat, ty) ← match pat with - | .typed ref pat ty => withRef ref do - let ty ← Term.elabType ty - pure (.typed ref pat (← Term.exprToSyntax ty), some ty) - | _ => pure (pat, none) - let expr ← Term.ensureHasType ty (← Term.elabTerm tgt ty) - pure (pat, { expr, xName? := pat.name?, hName? := hName?.map (·.getId) : GeneralizeArg }) - let (vs, hs, g) ← generalizeExceptFVar g args - let toTag := tgts.filterMap (·.1) |>.zip hs - let gs ← rcasesContinue g {} #[] #[] (pats.zip vs).toList (finish (toTag := toTag)) - pure gs.toList - -/-- -The `obtain` tactic in the no-target case. Given a type `T`, create a goal `|- T` and -and pattern match `T` against the given pattern. Returns the list of goals, with the assumed goal -first followed by the goals produced by the pattern match. --/ -def obtainNone (pat : RCasesPatt) (ty : Syntax) (g : MVarId) : TermElabM (List MVarId) := - Term.withSynthesize do - let ty ← Term.elabType ty - let g₁ ← mkFreshExprMVar (some ty) - let (v, g₂) ← (← g.assert (pat.name?.getD default) ty g₁).intro1 - let gs ← rcasesCore g₂ {} #[] (.fvar v) #[] pat finish - pure (g₁.mvarId! :: gs.toList) - -mutual -variable [Monad m] [MonadQuotation m] - -/-- Expand a `rintroPat` into an equivalent list of `rcasesPat` patterns. -/ -partial def expandRIntroPat (pat : TSyntax `rintroPat) - (acc : Array (TSyntax `rcasesPat) := #[]) (ty? : Option Term := none) : - Array (TSyntax `rcasesPat) := - match pat with - | `(rintroPat| $p:rcasesPat) => match ty? with - | some ty => acc.push <| Unhygienic.run <| withRef p `(rcasesPat| ($p:rcasesPat : $ty)) - | none => acc.push p - | `(rintroPat| ($(pats)* $[: $ty?']?)) => expandRIntroPats pats acc (ty?' <|> ty?) - | _ => acc - -/-- Expand a list of `rintroPat` into an equivalent list of `rcasesPat` patterns. -/ -partial def expandRIntroPats (pats : Array (TSyntax `rintroPat)) - (acc : Array (TSyntax `rcasesPat) := #[]) (ty? : Option Term := none) : - Array (TSyntax `rcasesPat) := - pats.foldl (fun acc p => expandRIntroPat p acc ty?) acc - -end - -mutual - -/-- -This introduces the pattern `pat`. It has the same arguments as `rcasesCore`, plus: -* `ty?`: the nearest enclosing type ascription on the current pattern --/ -partial def rintroCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a : α) - (ref : Syntax) (pat : TSyntax `rintroPat) (ty? : Option Term) - (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : TermElabM α := do - match pat with - | `(rintroPat| $pat:rcasesPat) => - let pat := (← RCasesPatt.parse pat).typed? ref ty? - let (v, g) ← g.intro (pat.name?.getD `_) - rcasesCore g fs clears (.fvar v) a pat cont - | `(rintroPat| ($(pats)* $[: $ty?']?)) => - let ref := if pats.size == 1 then pat.raw else .missing - rintroContinue g fs clears ref pats (ty?' <|> ty?) a cont - | _ => throwUnsupportedSyntax - -/-- -This introduces the list of patterns `pats`. It has the same arguments as `rcasesCore`, plus: -* `ty?`: the nearest enclosing type ascription on the current pattern --/ -partial def rintroContinue (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) - (ref : Syntax) (pats : TSyntaxArray `rintroPat) (ty? : Option Term) (a : α) - (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : TermElabM α := do - g.withContext (loop 0 g fs clears a) -where - /-- Runs `rintroContinue` on `pats[i:]` -/ - loop i g fs clears a := do - if h : i < pats.size then - rintroCore g fs clears a ref (pats.get ⟨i, h⟩) ty? (loop (i+1)) - else cont g fs clears a - -end - -/-- -The implementation of the `rintro` tactic. It takes a list of patterns `pats` and -an optional type ascription `ty?` and introduces the patterns, resulting in zero or more goals. --/ -def rintro (pats : TSyntaxArray `rintroPat) (ty? : Option Term) - (g : MVarId) : TermElabM (List MVarId) := Term.withSynthesize do - (·.toList) <$> rintroContinue g {} #[] .missing pats ty? #[] finish - -end RCases - -open Lean Elab Elab.Tactic Meta RCases Parser.Tactic - -/- TODO -/-- -`rcases? e` will perform case splits on `e` in the same way as `rcases e`, -but rather than accepting a pattern, it does a maximal cases and prints the -pattern that would produce this case splitting. The default maximum depth is 5, -but this can be modified with `rcases? e : n`. --/ -elab (name := rcases?) "rcases?" _tgts:casesTarget,* _num:(" : " num)? : tactic => - throwError "unimplemented" --/ - -/-- -`rcases` is a tactic that will perform `cases` recursively, according to a pattern. It is used to -destructure hypotheses or expressions composed of inductive types like `h1 : a ∧ b ∧ c ∨ d` or -`h2 : ∃ x y, trans_rel R x y`. Usual usage might be `rcases h1 with ⟨ha, hb, hc⟩ | hd` or -`rcases h2 with ⟨x, y, _ | ⟨z, hxz, hzy⟩⟩` for these examples. - -Each element of an `rcases` pattern is matched against a particular local hypothesis (most of which -are generated during the execution of `rcases` and represent individual elements destructured from -the input expression). An `rcases` pattern has the following grammar: - -* A name like `x`, which names the active hypothesis as `x`. -* A blank `_`, which does nothing (letting the automatic naming system used by `cases` name the - hypothesis). -* A hyphen `-`, which clears the active hypothesis and any dependents. -* The keyword `rfl`, which expects the hypothesis to be `h : a = b`, and calls `subst` on the - hypothesis (which has the effect of replacing `b` with `a` everywhere or vice versa). -* A type ascription `p : ty`, which sets the type of the hypothesis to `ty` and then matches it - against `p`. (Of course, `ty` must unify with the actual type of `h` for this to work.) -* A tuple pattern `⟨p1, p2, p3⟩`, which matches a constructor with many arguments, or a series - of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`, - then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b` - and so on. -* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor, - while leaving the `@` off will only use the patterns on the explicit arguments. -* An alteration pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors, - or a nested disjunction like `a ∨ b ∨ c`. - -A pattern like `⟨a, b, c⟩ | ⟨d, e⟩` will do a split over the inductive datatype, -naming the first three parameters of the first constructor as `a,b,c` and the -first two of the second constructor `d,e`. If the list is not as long as the -number of arguments to the constructor or the number of constructors, the -remaining variables will be automatically named. If there are nested brackets -such as `⟨⟨a⟩, b | c⟩ | d` then these will cause more case splits as necessary. -If there are too many arguments, such as `⟨a, b, c⟩` for splitting on -`∃ x, ∃ y, p x`, then it will be treated as `⟨a, ⟨b, c⟩⟩`, splitting the last -parameter as necessary. - -`rcases` also has special support for quotient types: quotient induction into Prop works like -matching on the constructor `quot.mk`. - -`rcases h : e with PAT` will do the same as `rcases e with PAT` with the exception that an -assumption `h : e = PAT` will be added to the context. --/ -elab (name := rcases) tk:"rcases" tgts:casesTarget,* pat:((" with " rcasesPatLo)?) : tactic => do - let pat ← match pat.raw.getArgs with - | #[_, pat] => RCasesPatt.parse pat - | #[] => pure $ RCasesPatt.tuple tk [] - | _ => throwUnsupportedSyntax - let tgts := tgts.getElems.map fun tgt => - (if tgt.raw[0].isNone then none else some ⟨tgt.raw[0][0]⟩, tgt.raw[1]) - let g ← getMainGoal - g.withContext do replaceMainGoal (← RCases.rcases tgts pat g) - -/-- -The `obtain` tactic is a combination of `have` and `rcases`. See `rcases` for -a description of supported patterns. - -```lean -obtain ⟨patt⟩ : type := proof -``` -is equivalent to -```lean -have h : type := proof -rcases h with ⟨patt⟩ -``` - -If `⟨patt⟩` is omitted, `rcases` will try to infer the pattern. - -If `type` is omitted, `:= proof` is required. --/ -elab (name := obtain) tk:"obtain" - pat:(ppSpace rcasesPatMed)? ty:((" : " term)?) val:((" := " term,+)?) : tactic => do - let pat ← liftM $ pat.mapM RCasesPatt.parse - if val.raw.isNone then - if ty.raw.isNone then throwError "\ - `obtain` requires either an expected type or a value.\n\ - usage: `obtain ⟨patt⟩? : type (:= val)?` or `obtain ⟨patt⟩? (: type)? := val`" - let pat := pat.getD (RCasesPatt.one tk `this) - let g ← getMainGoal - g.withContext do replaceMainGoal (← RCases.obtainNone pat ty.raw[1] g) - else - let pat := pat.getD (RCasesPatt.one tk `_) - let pat := pat.typed? tk $ if ty.raw.isNone then none else some ⟨ty.raw[1]⟩ - let tgts := val.raw[1].getSepArgs.map fun val => (none, val) - let g ← getMainGoal - g.withContext do replaceMainGoal (← RCases.rcases tgts pat g) - -/- TODO -/-- -`rintro?` will introduce and case split on variables in the same way as -`rintro`, but will also print the `rintro` invocation that would have the same -result. Like `rcases?`, `rintro? : n` allows for modifying the -depth of splitting; the default is 5. --/ -elab (name := rintro?) "rintro?" (" : " num)? : tactic => - throwError "unimplemented" --/ - -/-- -The `rintro` tactic is a combination of the `intros` tactic with `rcases` to -allow for destructuring patterns while introducing variables. See `rcases` for -a description of supported patterns. For example, `rintro (a | ⟨b, c⟩) ⟨d, e⟩` -will introduce two variables, and then do case splits on both of them producing -two subgoals, one with variables `a d e` and the other with `b c d e`. - -`rintro`, unlike `rcases`, also supports the form `(x y : ty)` for introducing -and type-ascripting multiple variables at once, similar to binders. --/ -elab (name := rintro) "rintro" pats:(ppSpace colGt rintroPat)+ ty:((" : " term)?) : tactic => do - let ty? := if ty.raw.isNone then none else some ⟨ty.raw[1]⟩ - let g ← getMainGoal - g.withContext do replaceMainGoal (← RCases.rintro pats ty? g) diff --git a/Std/Tactic/RunCmd.lean b/Std/Tactic/RunCmd.lean index 6896b6626f..9c8eb39389 100644 --- a/Std/Tactic/RunCmd.lean +++ b/Std/Tactic/RunCmd.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Sebastian Ullrich, Mario Carneiro -/ import Lean.Elab.Eval -import Std.Util.TermUnsafe +import Lean.Elab.Command /-! Defines commands to compile and execute a command / term / tactic on the spot: diff --git a/Std/Tactic/Simpa.lean b/Std/Tactic/Simpa.lean index e2a6bb1fdd..b50b740388 100644 --- a/Std/Tactic/Simpa.lean +++ b/Std/Tactic/Simpa.lean @@ -6,7 +6,6 @@ Authors: Arthur Paulino, Gabriel Ebner, Mario Carneiro import Lean.Meta.Tactic.Assumption import Lean.Elab.Tactic.Simp import Lean.Linter.Util -import Std.Lean.LocalContext import Std.Lean.Parser import Std.Tactic.OpenPrivate import Std.Tactic.TryThis diff --git a/Std/Util/Pickle.lean b/Std/Util/Pickle.lean index 8219dd49e0..e3a4c9e71f 100644 --- a/Std/Util/Pickle.lean +++ b/Std/Util/Pickle.lean @@ -3,7 +3,7 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Util.TermUnsafe +import Lean.Environment /-! # Pickling and unpickling objects diff --git a/Std/Util/TermUnsafe.lean b/Std/Util/TermUnsafe.lean deleted file mode 100644 index fcfa9c2aeb..0000000000 --- a/Std/Util/TermUnsafe.lean +++ /dev/null @@ -1,61 +0,0 @@ -/- -Copyright (c) 2021 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ -import Lean.Elab.ElabRules -import Lean.Meta.Closure -import Lean.Compiler.ImplementedByAttr - -/-! -Defines term syntax to call unsafe functions. - -``` -def cool := - unsafe (unsafeCast () : Nat) - -#eval cool -``` --/ - -namespace Std.TermUnsafe -open Lean Meta Elab Term - -/-- Construct an auxiliary name based on the current declaration name and the given `hint` base. -/ -def mkAuxName (hint : Name) : TermElabM Name := - withFreshMacroScope do - let name := (← getDeclName?).getD Name.anonymous ++ hint - pure $ addMacroScope (← getMainModule) name (← getCurrMacroScope) - -/-- -`unsafe t : α` is an expression constructor which allows using unsafe declarations inside the -body of `t : α`, by creating an auxiliary definition containing `t` and using `implementedBy` to -wrap it in a safe interface. It is required that `α` is nonempty for this to be sound, -but even beyond that, an `unsafe` block should be carefully inspected for memory safety because -the compiler is unable to guarantee the safety of the operation. - -For example, the `evalExpr` function is unsafe, because the compiler cannot guarantee that when -you call ```evalExpr Foo ``Foo e``` that the type `Foo` corresponds to the name `Foo`, but in a -particular use case, we can ensure this, so `unsafe (evalExpr Foo ``Foo e)` is a correct usage. --/ -elab "unsafe " t:term : term <= expectedType => do - let mut t ← elabTerm t expectedType - t ← instantiateMVars t - if t.hasExprMVar then - synthesizeSyntheticMVarsNoPostponing - t ← instantiateMVars t - if ← logUnassignedUsingErrorInfos (← getMVars t) then throwAbortTerm - t ← mkAuxDefinitionFor (← mkAuxName `unsafe) t - let Expr.const unsafeFn unsafeLvls .. := t.getAppFn | unreachable! - let ConstantInfo.defnInfo unsafeDefn ← getConstInfo unsafeFn | unreachable! - let implName ← mkAuxName `impl - addDecl <| Declaration.defnDecl { - name := implName - type := unsafeDefn.type - levelParams := unsafeDefn.levelParams - value := ← mkOfNonempty unsafeDefn.type - hints := ReducibilityHints.opaque - safety := DefinitionSafety.safe - } - setImplementedBy implName unsafeFn - pure $ mkAppN (mkConst implName unsafeLvls) t.getAppArgs diff --git a/lean-toolchain b/lean-toolchain index c23b3e7191..5b26253bfe 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-08 +leanprover/lean4:nightly-2024-02-10 diff --git a/test/by_cases.lean b/test/by_cases.lean deleted file mode 100644 index b2ad2bfec2..0000000000 --- a/test/by_cases.lean +++ /dev/null @@ -1,11 +0,0 @@ -import Std.Tactic.ByCases - -example : True := by - if 1 + 1 = 2 then _ else ?_ - case pos => trivial - fail_if_success case neg => contradiction - · contradiction - -example (p : Prop) : True := by - if p then ?foo else trivial - case foo => trivial diff --git a/test/coe.lean b/test/coe.lean index afca989c24..6a52129da0 100644 --- a/test/coe.lean +++ b/test/coe.lean @@ -1,4 +1,3 @@ -import Std.Tactic.CoeExt import Std.Tactic.GuardMsgs set_option linter.missingDocs false @@ -17,10 +16,10 @@ structure WrappedType where attribute [coe] WrappedNat.val instance : Coe WrappedNat Nat where coe := WrappedNat.val -#eval Std.Tactic.Coe.registerCoercion ``WrappedFun.fn (some ⟨2, 1, .coeFun⟩) +#eval Lean.Meta.registerCoercion ``WrappedFun.fn (some ⟨2, 1, .coeFun⟩) instance : CoeFun (WrappedFun α) (fun _ => Nat → α) where coe := WrappedFun.fn -#eval Std.Tactic.Coe.registerCoercion ``WrappedType.typ (some ⟨1, 0, .coeSort⟩) +#eval Lean.Meta.registerCoercion ``WrappedType.typ (some ⟨1, 0, .coeSort⟩) instance : CoeSort WrappedType Type where coe := WrappedType.typ section coe diff --git a/test/rcases.lean b/test/rcases.lean index f1c4039205..1b6eff9985 100644 --- a/test/rcases.lean +++ b/test/rcases.lean @@ -1,6 +1,5 @@ import Std.Tactic.Basic import Std.Tactic.GuardExpr -import Std.Tactic.RCases set_option linter.missingDocs false diff --git a/test/solve_by_elim.lean b/test/solve_by_elim.lean index 779a971c3b..545218077c 100644 --- a/test/solve_by_elim.lean +++ b/test/solve_by_elim.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Std.Tactic.RCases import Std.Tactic.SolveByElim import Std.Tactic.PermuteGoals import Std.Test.Internal.DummyLabelAttr diff --git a/test/symm.lean b/test/symm.lean index 636aa60994..653630d209 100644 --- a/test/symm.lean +++ b/test/symm.lean @@ -1,5 +1,4 @@ import Std.Tactic.Relation.Symm -import Std.Tactic.RCases set_option autoImplicit true set_option linter.missingDocs false diff --git a/test/tryThis.lean b/test/tryThis.lean index b1f8066c36..861de6eb07 100644 --- a/test/tryThis.lean +++ b/test/tryThis.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Murrills -/ import Std.Tactic.TryThis -import Std.Util.TermUnsafe import Std.Tactic.GuardMsgs open Std.Tactic.TryThis From f35afc52941619137876957b0122b1e96500b1a7 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 12 Feb 2024 09:16:18 +0000 Subject: [PATCH 020/213] chore: bump to nightly-2024-02-12 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 5b26253bfe..4387d53c5a 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-10 +leanprover/lean4:nightly-2024-02-12 From 81d38d787ccfa13c607e5919cb2d43fcd5e464bc Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 12 Feb 2024 22:28:52 +1100 Subject: [PATCH 021/213] fixes --- Std.lean | 1 - Std/Data/Nat/Bitwise.lean | 1 + Std/Tactic/GuardExpr.lean | 244 ----------------------------------- Std/Tactic/Init.lean | 3 +- test/bitvec.lean | 1 - test/case.lean | 1 - test/change.lean | 1 - test/classical.lean | 1 - test/congr.lean | 1 - test/conv_equals.lean | 1 - test/false_or_by_contra.lean | 1 - test/float.lean | 1 - test/guardexpr.lean | 1 - test/int.lean | 1 - test/on_goal.lean | 1 - test/rcases.lean | 1 - 16 files changed, 3 insertions(+), 258 deletions(-) delete mode 100644 Std/Tactic/GuardExpr.lean diff --git a/Std.lean b/Std.lean index 7fed219674..1143ccfb0d 100644 --- a/Std.lean +++ b/Std.lean @@ -89,7 +89,6 @@ import Std.Tactic.Exact import Std.Tactic.Ext import Std.Tactic.Ext.Attr import Std.Tactic.FalseOrByContra -import Std.Tactic.GuardExpr import Std.Tactic.GuardMsgs import Std.Tactic.HaveI import Std.Tactic.Init diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean index fd5468df8c..fe0b728f2c 100644 --- a/Std/Data/Nat/Bitwise.lean +++ b/Std/Data/Nat/Bitwise.lean @@ -13,6 +13,7 @@ It is primarily intended to support the bitvector library. import Std.Data.Bool import Std.Data.Nat.Lemmas import Std.Tactic.Simpa +import Std.Tactic.Omega namespace Nat diff --git a/Std/Tactic/GuardExpr.lean b/Std/Tactic/GuardExpr.lean deleted file mode 100644 index ef56aeff6d..0000000000 --- a/Std/Tactic/GuardExpr.lean +++ /dev/null @@ -1,244 +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 --/ -import Lean.Elab.Command -import Lean.Elab.Tactic.Conv.Basic -import Lean.Meta.Basic -import Lean.Meta.Eval - -namespace Std.Tactic.GuardExpr -open Lean Meta Elab Tactic - -/-- -The various `guard_*` tactics have similar matching specifiers for how equal expressions -have to be to pass the tactic. -This inductive gives the different specifiers that can be selected. --/ -inductive MatchKind -/-- A syntactic match means that the `Expr`s are `==` after stripping `MData` -/ -| syntactic -/-- A defeq match `isDefEqGuarded` returns true. (Note that unification is allowed here.) -/ -| defEq (red : TransparencyMode := .reducible) -/-- An alpha-eq match means that `Expr.eqv` returns true. -/ -| alphaEq - -/-- Reducible defeq matching for `guard_hyp` types -/ -syntax colonR := " : " -/-- Default-reducibility defeq matching for `guard_hyp` types -/ -syntax colonD := " :~ " -/-- Syntactic matching for `guard_hyp` types -/ -syntax colonS := " :ₛ " -/-- Alpha-eq matching for `guard_hyp` types -/ -syntax colonA := " :ₐ " -/-- The `guard_hyp` type specifier, one of `:`, `:~`, `:ₛ`, `:ₐ` -/ -syntax colon := colonR <|> colonD <|> colonS <|> colonA - -/-- Reducible defeq matching for `guard_hyp` values -/ -syntax colonEqR := " := " -/-- Default-reducibility defeq matching for `guard_hyp` values -/ -syntax colonEqD := " :=~ " -/-- Syntactic matching for `guard_hyp` values -/ -syntax colonEqS := " :=ₛ " -/-- Alpha-eq matching for `guard_hyp` values -/ -syntax colonEqA := " :=ₐ " -/-- The `guard_hyp` value specifier, one of `:=`, `:=~`, `:=ₛ`, `:=ₐ` -/ -syntax colonEq := colonEqR <|> colonEqD <|> colonEqS <|> colonEqA - -/-- Reducible defeq matching for `guard_expr` -/ -syntax equalR := " = " -/-- Default-reducibility defeq matching for `guard_expr` -/ -syntax equalD := " =~ " -/-- Syntactic matching for `guard_expr` -/ -syntax equalS := " =ₛ " -/-- Alpha-eq matching for `guard_expr` -/ -syntax equalA := " =ₐ " -/-- The `guard_expr` matching specifier, one of `=`, `=~`, `=ₛ`, `=ₐ` -/ -syntax equal := equalR <|> equalD <|> equalS <|> equalA - -/-- Converts a `colon` syntax into a `MatchKind` -/ -def colon.toMatchKind : TSyntax ``colon → Option MatchKind - | `(colon| :) => some .defEq - | `(colon| :~) => some (.defEq .default) - | `(colon| :ₛ) => some .syntactic - | `(colon| :ₐ) => some .alphaEq - | _ => none - -/-- Converts a `colonEq` syntax into a `MatchKind` -/ -def colonEq.toMatchKind : TSyntax ``colonEq → Option MatchKind - | `(colonEq| :=) => some .defEq - | `(colonEq| :=~) => some (.defEq .default) - | `(colonEq| :=ₛ) => some .syntactic - | `(colonEq| :=ₐ) => some .alphaEq - | _ => none - -/-- Converts a `equal` syntax into a `MatchKind` -/ -def equal.toMatchKind : TSyntax ``equal → Option MatchKind - | `(equal| =) => some .defEq - | `(equal| =~) => some (.defEq .default) - | `(equal| =ₛ) => some .syntactic - | `(equal| =ₐ) => some .alphaEq - | _ => none - -/-- Applies the selected matching rule to two expressions. -/ -def MatchKind.isEq (a b : Expr) : MatchKind → MetaM Bool - | .syntactic => return a.consumeMData == b.consumeMData - | .alphaEq => return a.eqv b - | .defEq red => withoutModifyingState <| withTransparency red <| Lean.Meta.isDefEqGuarded a b - -/-- -Tactic to check equality of two expressions. -* `guard_expr e = e'` checks that `e` and `e'` are defeq at reducible transparency. -* `guard_expr e =~ e'` checks that `e` and `e'` are defeq at default transparency. -* `guard_expr e =ₛ e'` checks that `e` and `e'` are syntactically equal. -* `guard_expr e =ₐ e'` checks that `e` and `e'` are alpha-equivalent. - -Both `e` and `e'` are elaborated then have their metavariables instantiated before the equality -check. Their types are unified (using `isDefEqGuarded`) before synthetic metavariables are -processed, which helps with default instance handling. --/ -syntax (name := guardExpr) "guard_expr " term:51 equal term : tactic -@[inherit_doc guardExpr] syntax (name := guardExprConv) "guard_expr " term:51 equal term : conv - -/-- Elaborate `a` and `b` and then do the given equality test `mk`. We make sure to unify -the types of `a` and `b` after elaboration so that when synthesizing pending metavariables -we don't get the wrong instances due to default instances (for example, for nat literals). -/ -def elabAndEvalMatchKind (mk : MatchKind) (a b : Term) : TermElabM Bool := - Term.withoutErrToSorry do - let a ← Term.elabTerm a none - let b ← Term.elabTerm b none - -- Unify types before synthesizing pending metavariables: - _ ← isDefEqGuarded (← inferType a) (← inferType b) - Term.synthesizeSyntheticMVarsNoPostponing - mk.isEq (← instantiateMVars a) (← instantiateMVars b) - -@[inherit_doc guardExpr, tactic guardExpr, tactic guardExprConv] -def evalGuardExpr : Tactic := fun - | `(tactic| guard_expr $r $eq:equal $p) - | `(conv| guard_expr $r $eq:equal $p) => withMainContext do - let some mk := equal.toMatchKind eq | throwUnsupportedSyntax - let res ← elabAndEvalMatchKind mk r p - -- Note: `{eq}` itself prints a space before the relation. - unless res do throwError "failed: {r}{eq} {p} is not true" - | _ => throwUnsupportedSyntax - -/-- -Tactic to check that the target agrees with a given expression. -* `guard_target = e` checks that the target is defeq at reducible transparency to `e`. -* `guard_target =~ e` checks that the target is defeq at default transparency to `e`. -* `guard_target =ₛ e` checks that the target is syntactically equal to `e`. -* `guard_target =ₐ e` checks that the target is alpha-equivalent to `e`. - -The term `e` is elaborated with the type of the goal as the expected type, which is mostly -useful within `conv` mode. --/ -syntax (name := guardTarget) "guard_target " equal term : tactic -@[inherit_doc guardTarget] syntax (name := guardTargetConv) "guard_target " equal term : conv - -@[inherit_doc guardTarget, tactic guardTarget, tactic guardTargetConv] -def evalGuardTarget : Tactic := - let go eq r getTgt := withMainContext do - let t ← getTgt >>= instantiateMVars - let r ← elabTerm r (← inferType t) - let some mk := equal.toMatchKind eq | throwUnsupportedSyntax - unless ← mk.isEq r t do - throwError "target of main goal is{indentExpr t}\nnot{indentExpr r}" - fun - | `(tactic| guard_target $eq $r) => go eq r getMainTarget - | `(conv| guard_target $eq $r) => go eq r Conv.getLhs - | _ => throwUnsupportedSyntax - -/-- -Tactic to check that a named hypothesis has a given type and/or value. - -* `guard_hyp h : t` checks the type up to reducible defeq, -* `guard_hyp h :~ t` checks the type up to default defeq, -* `guard_hyp h :ₛ t` checks the type up to syntactic equality, -* `guard_hyp h :ₐ t` checks the type up to alpha equality. -* `guard_hyp h := v` checks value up to reducible defeq, -* `guard_hyp h :=~ v` checks value up to default defeq, -* `guard_hyp h :=ₛ v` checks value up to syntactic equality, -* `guard_hyp h :=ₐ v` checks the value up to alpha equality. - -The value `v` is elaborated using the type of `h` as the expected type. --/ -syntax (name := guardHyp) - "guard_hyp " term:max (colon term)? (colonEq term)? : tactic -@[inherit_doc guardHyp] syntax (name := guardHypConv) - "guard_hyp " term:max (colon term)? (colonEq term)? : conv - -@[inherit_doc guardHyp, tactic guardHyp, tactic guardHypConv] -def evalGuardHyp : Tactic := fun - | `(tactic| guard_hyp $h $[$c $ty]? $[$eq $val]?) - | `(conv| guard_hyp $h $[$c $ty]? $[$eq $val]?) => withMainContext do - let fvarid ← getFVarId h - let lDecl ← - match (← getLCtx).find? fvarid with - | none => throwError m!"hypothesis {h} not found" - | some lDecl => pure lDecl - if let (some c, some p) := (c, ty) then - let some mk := colon.toMatchKind c | throwUnsupportedSyntax - let e ← elabTerm p none - let hty ← instantiateMVars lDecl.type - unless ← mk.isEq e hty do - throwError m!"hypothesis {h} has type{indentExpr hty}\nnot{indentExpr e}" - match lDecl.value?, val with - | none, some _ => throwError m!"{h} is not a let binding" - | some _, none => throwError m!"{h} is a let binding" - | some hval, some val => - let some mk := eq.bind colonEq.toMatchKind | throwUnsupportedSyntax - let e ← elabTerm val lDecl.type - let hval ← instantiateMVars hval - unless ← mk.isEq e hval do - throwError m!"hypothesis {h} has value{indentExpr hval}\nnot{indentExpr e}" - | none, none => pure () - | _ => throwUnsupportedSyntax - -/-- -Command to check equality of two expressions. -* `#guard_expr e = e'` checks that `e` and `e'` are defeq at reducible transparency. -* `#guard_expr e =~ e'` checks that `e` and `e'` are defeq at default transparency. -* `#guard_expr e =ₛ e'` checks that `e` and `e'` are syntactically equal. -* `#guard_expr e =ₐ e'` checks that `e` and `e'` are alpha-equivalent. - -This is a command version of the `guard_expr` tactic. -/ -syntax (name := guardExprCmd) "#guard_expr " term:51 equal term : command - -@[inherit_doc guardExprCmd, command_elab guardExprCmd] -def evalGuardExprCmd : Lean.Elab.Command.CommandElab - | `(command| #guard_expr $r $eq:equal $p) => - Lean.Elab.Command.runTermElabM fun _ => do - let some mk := equal.toMatchKind eq | throwUnsupportedSyntax - let res ← elabAndEvalMatchKind mk r p - -- Note: `{eq}` itself prints a space before the relation. - unless res do throwError "failed: {r}{eq} {p} is not true" - | _ => throwUnsupportedSyntax - -/-- -Command to check that an expression evaluates to `true`. - -`#guard e` elaborates `e` ensuring its type is `Bool` then evaluates `e` and checks that -the result is `true`. The term is elaborated *without* variables declared using `variable`, since -these cannot be evaluated. - -Since this makes use of coercions, so long as a proposition `p` is decidable, one can write -`#guard p` rather than `#guard decide p`. A consequence to this is that if there is decidable -equality one can write `#guard a = b`. Note that this is not exactly the same as checking -if `a` and `b` evaluate to the same thing since it uses the `DecidableEq` instance to do -the evaluation. - -Note: this uses the untrusted evaluator, so `#guard` passing is *not* a proof that the -expression equals `true`. -/ -elab "#guard " e:term : command => - Lean.Elab.Command.liftTermElabM do - let e ← Term.elabTermEnsuringType e (mkConst ``Bool) - Term.synthesizeSyntheticMVarsNoPostponing - let e ← instantiateMVars e - let mvars ← getMVars e - if mvars.isEmpty then - let v ← unsafe evalExpr Bool (mkConst ``Bool) e - unless v do - throwError "expression{indentExpr e}\ndid not evaluate to `true`" - else - _ ← Term.logUnassignedUsingErrorInfos mvars diff --git a/Std/Tactic/Init.lean b/Std/Tactic/Init.lean index 22101a7127..a5d48c902b 100644 --- a/Std/Tactic/Init.lean +++ b/Std/Tactic/Init.lean @@ -3,8 +3,9 @@ Copyright (c) 2021 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.GuardExpr import Std.Lean.Meta.Basic +import Lean.Elab.Command +import Lean.Elab.Tactic.BuiltinTactic /-! # Simple tactics that are used throughout Std. diff --git a/test/bitvec.lean b/test/bitvec.lean index 7a005da47b..a4f16c5ba5 100644 --- a/test/bitvec.lean +++ b/test/bitvec.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Data.BitVec open Std.BitVec diff --git a/test/case.lean b/test/case.lean index f439a45408..78b6fe5f43 100644 --- a/test/case.lean +++ b/test/case.lean @@ -1,5 +1,4 @@ import Std.Tactic.Case -import Std.Tactic.GuardExpr import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/change.lean b/test/change.lean index be8e0e2885..da295ab843 100644 --- a/test/change.lean +++ b/test/change.lean @@ -1,5 +1,4 @@ import Std.Tactic.Change -import Std.Tactic.GuardExpr private axiom test_sorry : ∀ {α}, α diff --git a/test/classical.lean b/test/classical.lean index a9c527eb75..b65762ae7b 100644 --- a/test/classical.lean +++ b/test/classical.lean @@ -1,6 +1,5 @@ import Std.Tactic.Classical import Std.Tactic.PermuteGoals -import Std.Tactic.GuardExpr noncomputable example : Bool := by fail_if_success have := ∀ p, decide p -- no classical in scope diff --git a/test/congr.lean b/test/congr.lean index 31d590a0b8..21f327fa43 100644 --- a/test/congr.lean +++ b/test/congr.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Tactic.Congr section congr diff --git a/test/conv_equals.lean b/test/conv_equals.lean index 5495c1a4c2..f646192acd 100644 --- a/test/conv_equals.lean +++ b/test/conv_equals.lean @@ -6,7 +6,6 @@ Authors: Joachim Breitner import Std.Tactic.Basic import Std.Tactic.GuardMsgs -import Std.Tactic.GuardExpr -- The example from the doc string, for quick comparision -- and keeping the doc up-to-date diff --git a/test/false_or_by_contra.lean b/test/false_or_by_contra.lean index 7b3f186c7f..5d3e4669e3 100644 --- a/test/false_or_by_contra.lean +++ b/test/false_or_by_contra.lean @@ -1,5 +1,4 @@ import Std.Tactic.FalseOrByContra -import Std.Tactic.GuardExpr example (w : False) : False := by false_or_by_contra diff --git a/test/float.lean b/test/float.lean index 0a5da3023c..05f93e0064 100644 --- a/test/float.lean +++ b/test/float.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Lean.Float #guard 0.0.toRatParts == some (0, -53) diff --git a/test/guardexpr.lean b/test/guardexpr.lean index a3b5e38841..caee2e81df 100644 --- a/test/guardexpr.lean +++ b/test/guardexpr.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Tactic.Basic example (n : Nat) : Nat := by diff --git a/test/int.lean b/test/int.lean index eee63bd591..3c948d4264 100644 --- a/test/int.lean +++ b/test/int.lean @@ -1,5 +1,4 @@ import Std.Data.Int.Basic -import Std.Tactic.GuardExpr -- complement #guard ~~~(-1:Int) = 0 diff --git a/test/on_goal.lean b/test/on_goal.lean index b22d628583..fb53fb3e09 100644 --- a/test/on_goal.lean +++ b/test/on_goal.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Tactic.PermuteGoals import Std.Tactic.Unreachable diff --git a/test/rcases.lean b/test/rcases.lean index 1b6eff9985..39c728a9cc 100644 --- a/test/rcases.lean +++ b/test/rcases.lean @@ -1,5 +1,4 @@ import Std.Tactic.Basic -import Std.Tactic.GuardExpr set_option linter.missingDocs false From 7978514d098306e7cb757bf66575c0b240c42ffe Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 12 Feb 2024 22:56:10 +1100 Subject: [PATCH 022/213] Restore NoMatch.lean --- Std.lean | 1 + Std/Tactic/NoMatch.lean | 42 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+) create mode 100644 Std/Tactic/NoMatch.lean diff --git a/Std.lean b/Std.lean index 1143ccfb0d..fc010f7a2f 100644 --- a/Std.lean +++ b/Std.lean @@ -102,6 +102,7 @@ import Std.Tactic.Lint.Frontend import Std.Tactic.Lint.Misc import Std.Tactic.Lint.Simp import Std.Tactic.Lint.TypeClass +import Std.Tactic.NoMatch import Std.Tactic.NormCast import Std.Tactic.NormCast.Ext import Std.Tactic.NormCast.Lemmas diff --git a/Std/Tactic/NoMatch.lean b/Std/Tactic/NoMatch.lean new file mode 100644 index 0000000000..e72609b905 --- /dev/null +++ b/Std/Tactic/NoMatch.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2021 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import Lean.Elab.ElabRules + +/-! +Deprecation warnings for `match ⋯ with.`, `fun.`, `λ.`, and `intro.`. +-/ +namespace Std.Tactic +open Lean Elab Term Tactic Parser.Term + +/-- +The syntax `match ⋯ with.` has been deprecated in favor of `nomatch ⋯`. + +Both now support multiple discriminants. +-/ +elab (name := matchWithDot) tk:"match " t:term,* " with" "." : term <= expectedType? => do + logWarningAt tk (← findDocString? (← getEnv) ``matchWithDot).get! + elabTerm (← `(nomatch%$tk $[$t],*)) expectedType? + +/-- The syntax `fun.` has been deprecated in favor of `nofun`. -/ +elab (name := funDot) tk:"fun" "." : term <= expectedType? => do + logWarningAt tk (← findDocString? (← getEnv) ``funDot).get! + elabTerm (← `(nofun)) expectedType? + +/-- The syntax `λ.` has been deprecated in favor of `nofun`. -/ +elab (name := lambdaDot) tk:"fun" "." : term <= expectedType? => do + logWarningAt tk (← findDocString? (← getEnv) ``lambdaDot).get! + elabTerm (← `(nofun)) expectedType? + +@[inherit_doc matchWithDot] +macro "match " discrs:term,* " with" "." : tactic => + `(tactic| exact match $discrs,* with.) + +/-- +The syntax `intro.` is deprecated in favor of `nofun`. +-/ +elab (name := introDot) tk:"intro" "." : tactic => do + logWarningAt tk (← findDocString? (← getEnv) ``introDot).get! + evalTactic (← `(tactic| nofun)) From 0e7a21c35a99e196f80b91b9f907eefdbce0b6a2 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 13 Feb 2024 19:40:54 +1100 Subject: [PATCH 023/213] chore: adaptations for nightly-2024-02-12 (#623) --- Std.lean | 1 - Std/Tactic/GuardExpr.lean | 244 ----------------------------------- Std/Tactic/Init.lean | 3 +- lean-toolchain | 2 +- test/bitvec.lean | 1 - test/case.lean | 1 - test/change.lean | 1 - test/classical.lean | 1 - test/congr.lean | 1 - test/conv_equals.lean | 1 - test/false_or_by_contra.lean | 1 - test/float.lean | 1 - test/guardexpr.lean | 1 - test/int.lean | 1 - test/on_goal.lean | 1 - test/rcases.lean | 1 - 16 files changed, 3 insertions(+), 259 deletions(-) delete mode 100644 Std/Tactic/GuardExpr.lean diff --git a/Std.lean b/Std.lean index a11354b4e1..fc010f7a2f 100644 --- a/Std.lean +++ b/Std.lean @@ -89,7 +89,6 @@ import Std.Tactic.Exact import Std.Tactic.Ext import Std.Tactic.Ext.Attr import Std.Tactic.FalseOrByContra -import Std.Tactic.GuardExpr import Std.Tactic.GuardMsgs import Std.Tactic.HaveI import Std.Tactic.Init diff --git a/Std/Tactic/GuardExpr.lean b/Std/Tactic/GuardExpr.lean deleted file mode 100644 index ef56aeff6d..0000000000 --- a/Std/Tactic/GuardExpr.lean +++ /dev/null @@ -1,244 +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 --/ -import Lean.Elab.Command -import Lean.Elab.Tactic.Conv.Basic -import Lean.Meta.Basic -import Lean.Meta.Eval - -namespace Std.Tactic.GuardExpr -open Lean Meta Elab Tactic - -/-- -The various `guard_*` tactics have similar matching specifiers for how equal expressions -have to be to pass the tactic. -This inductive gives the different specifiers that can be selected. --/ -inductive MatchKind -/-- A syntactic match means that the `Expr`s are `==` after stripping `MData` -/ -| syntactic -/-- A defeq match `isDefEqGuarded` returns true. (Note that unification is allowed here.) -/ -| defEq (red : TransparencyMode := .reducible) -/-- An alpha-eq match means that `Expr.eqv` returns true. -/ -| alphaEq - -/-- Reducible defeq matching for `guard_hyp` types -/ -syntax colonR := " : " -/-- Default-reducibility defeq matching for `guard_hyp` types -/ -syntax colonD := " :~ " -/-- Syntactic matching for `guard_hyp` types -/ -syntax colonS := " :ₛ " -/-- Alpha-eq matching for `guard_hyp` types -/ -syntax colonA := " :ₐ " -/-- The `guard_hyp` type specifier, one of `:`, `:~`, `:ₛ`, `:ₐ` -/ -syntax colon := colonR <|> colonD <|> colonS <|> colonA - -/-- Reducible defeq matching for `guard_hyp` values -/ -syntax colonEqR := " := " -/-- Default-reducibility defeq matching for `guard_hyp` values -/ -syntax colonEqD := " :=~ " -/-- Syntactic matching for `guard_hyp` values -/ -syntax colonEqS := " :=ₛ " -/-- Alpha-eq matching for `guard_hyp` values -/ -syntax colonEqA := " :=ₐ " -/-- The `guard_hyp` value specifier, one of `:=`, `:=~`, `:=ₛ`, `:=ₐ` -/ -syntax colonEq := colonEqR <|> colonEqD <|> colonEqS <|> colonEqA - -/-- Reducible defeq matching for `guard_expr` -/ -syntax equalR := " = " -/-- Default-reducibility defeq matching for `guard_expr` -/ -syntax equalD := " =~ " -/-- Syntactic matching for `guard_expr` -/ -syntax equalS := " =ₛ " -/-- Alpha-eq matching for `guard_expr` -/ -syntax equalA := " =ₐ " -/-- The `guard_expr` matching specifier, one of `=`, `=~`, `=ₛ`, `=ₐ` -/ -syntax equal := equalR <|> equalD <|> equalS <|> equalA - -/-- Converts a `colon` syntax into a `MatchKind` -/ -def colon.toMatchKind : TSyntax ``colon → Option MatchKind - | `(colon| :) => some .defEq - | `(colon| :~) => some (.defEq .default) - | `(colon| :ₛ) => some .syntactic - | `(colon| :ₐ) => some .alphaEq - | _ => none - -/-- Converts a `colonEq` syntax into a `MatchKind` -/ -def colonEq.toMatchKind : TSyntax ``colonEq → Option MatchKind - | `(colonEq| :=) => some .defEq - | `(colonEq| :=~) => some (.defEq .default) - | `(colonEq| :=ₛ) => some .syntactic - | `(colonEq| :=ₐ) => some .alphaEq - | _ => none - -/-- Converts a `equal` syntax into a `MatchKind` -/ -def equal.toMatchKind : TSyntax ``equal → Option MatchKind - | `(equal| =) => some .defEq - | `(equal| =~) => some (.defEq .default) - | `(equal| =ₛ) => some .syntactic - | `(equal| =ₐ) => some .alphaEq - | _ => none - -/-- Applies the selected matching rule to two expressions. -/ -def MatchKind.isEq (a b : Expr) : MatchKind → MetaM Bool - | .syntactic => return a.consumeMData == b.consumeMData - | .alphaEq => return a.eqv b - | .defEq red => withoutModifyingState <| withTransparency red <| Lean.Meta.isDefEqGuarded a b - -/-- -Tactic to check equality of two expressions. -* `guard_expr e = e'` checks that `e` and `e'` are defeq at reducible transparency. -* `guard_expr e =~ e'` checks that `e` and `e'` are defeq at default transparency. -* `guard_expr e =ₛ e'` checks that `e` and `e'` are syntactically equal. -* `guard_expr e =ₐ e'` checks that `e` and `e'` are alpha-equivalent. - -Both `e` and `e'` are elaborated then have their metavariables instantiated before the equality -check. Their types are unified (using `isDefEqGuarded`) before synthetic metavariables are -processed, which helps with default instance handling. --/ -syntax (name := guardExpr) "guard_expr " term:51 equal term : tactic -@[inherit_doc guardExpr] syntax (name := guardExprConv) "guard_expr " term:51 equal term : conv - -/-- Elaborate `a` and `b` and then do the given equality test `mk`. We make sure to unify -the types of `a` and `b` after elaboration so that when synthesizing pending metavariables -we don't get the wrong instances due to default instances (for example, for nat literals). -/ -def elabAndEvalMatchKind (mk : MatchKind) (a b : Term) : TermElabM Bool := - Term.withoutErrToSorry do - let a ← Term.elabTerm a none - let b ← Term.elabTerm b none - -- Unify types before synthesizing pending metavariables: - _ ← isDefEqGuarded (← inferType a) (← inferType b) - Term.synthesizeSyntheticMVarsNoPostponing - mk.isEq (← instantiateMVars a) (← instantiateMVars b) - -@[inherit_doc guardExpr, tactic guardExpr, tactic guardExprConv] -def evalGuardExpr : Tactic := fun - | `(tactic| guard_expr $r $eq:equal $p) - | `(conv| guard_expr $r $eq:equal $p) => withMainContext do - let some mk := equal.toMatchKind eq | throwUnsupportedSyntax - let res ← elabAndEvalMatchKind mk r p - -- Note: `{eq}` itself prints a space before the relation. - unless res do throwError "failed: {r}{eq} {p} is not true" - | _ => throwUnsupportedSyntax - -/-- -Tactic to check that the target agrees with a given expression. -* `guard_target = e` checks that the target is defeq at reducible transparency to `e`. -* `guard_target =~ e` checks that the target is defeq at default transparency to `e`. -* `guard_target =ₛ e` checks that the target is syntactically equal to `e`. -* `guard_target =ₐ e` checks that the target is alpha-equivalent to `e`. - -The term `e` is elaborated with the type of the goal as the expected type, which is mostly -useful within `conv` mode. --/ -syntax (name := guardTarget) "guard_target " equal term : tactic -@[inherit_doc guardTarget] syntax (name := guardTargetConv) "guard_target " equal term : conv - -@[inherit_doc guardTarget, tactic guardTarget, tactic guardTargetConv] -def evalGuardTarget : Tactic := - let go eq r getTgt := withMainContext do - let t ← getTgt >>= instantiateMVars - let r ← elabTerm r (← inferType t) - let some mk := equal.toMatchKind eq | throwUnsupportedSyntax - unless ← mk.isEq r t do - throwError "target of main goal is{indentExpr t}\nnot{indentExpr r}" - fun - | `(tactic| guard_target $eq $r) => go eq r getMainTarget - | `(conv| guard_target $eq $r) => go eq r Conv.getLhs - | _ => throwUnsupportedSyntax - -/-- -Tactic to check that a named hypothesis has a given type and/or value. - -* `guard_hyp h : t` checks the type up to reducible defeq, -* `guard_hyp h :~ t` checks the type up to default defeq, -* `guard_hyp h :ₛ t` checks the type up to syntactic equality, -* `guard_hyp h :ₐ t` checks the type up to alpha equality. -* `guard_hyp h := v` checks value up to reducible defeq, -* `guard_hyp h :=~ v` checks value up to default defeq, -* `guard_hyp h :=ₛ v` checks value up to syntactic equality, -* `guard_hyp h :=ₐ v` checks the value up to alpha equality. - -The value `v` is elaborated using the type of `h` as the expected type. --/ -syntax (name := guardHyp) - "guard_hyp " term:max (colon term)? (colonEq term)? : tactic -@[inherit_doc guardHyp] syntax (name := guardHypConv) - "guard_hyp " term:max (colon term)? (colonEq term)? : conv - -@[inherit_doc guardHyp, tactic guardHyp, tactic guardHypConv] -def evalGuardHyp : Tactic := fun - | `(tactic| guard_hyp $h $[$c $ty]? $[$eq $val]?) - | `(conv| guard_hyp $h $[$c $ty]? $[$eq $val]?) => withMainContext do - let fvarid ← getFVarId h - let lDecl ← - match (← getLCtx).find? fvarid with - | none => throwError m!"hypothesis {h} not found" - | some lDecl => pure lDecl - if let (some c, some p) := (c, ty) then - let some mk := colon.toMatchKind c | throwUnsupportedSyntax - let e ← elabTerm p none - let hty ← instantiateMVars lDecl.type - unless ← mk.isEq e hty do - throwError m!"hypothesis {h} has type{indentExpr hty}\nnot{indentExpr e}" - match lDecl.value?, val with - | none, some _ => throwError m!"{h} is not a let binding" - | some _, none => throwError m!"{h} is a let binding" - | some hval, some val => - let some mk := eq.bind colonEq.toMatchKind | throwUnsupportedSyntax - let e ← elabTerm val lDecl.type - let hval ← instantiateMVars hval - unless ← mk.isEq e hval do - throwError m!"hypothesis {h} has value{indentExpr hval}\nnot{indentExpr e}" - | none, none => pure () - | _ => throwUnsupportedSyntax - -/-- -Command to check equality of two expressions. -* `#guard_expr e = e'` checks that `e` and `e'` are defeq at reducible transparency. -* `#guard_expr e =~ e'` checks that `e` and `e'` are defeq at default transparency. -* `#guard_expr e =ₛ e'` checks that `e` and `e'` are syntactically equal. -* `#guard_expr e =ₐ e'` checks that `e` and `e'` are alpha-equivalent. - -This is a command version of the `guard_expr` tactic. -/ -syntax (name := guardExprCmd) "#guard_expr " term:51 equal term : command - -@[inherit_doc guardExprCmd, command_elab guardExprCmd] -def evalGuardExprCmd : Lean.Elab.Command.CommandElab - | `(command| #guard_expr $r $eq:equal $p) => - Lean.Elab.Command.runTermElabM fun _ => do - let some mk := equal.toMatchKind eq | throwUnsupportedSyntax - let res ← elabAndEvalMatchKind mk r p - -- Note: `{eq}` itself prints a space before the relation. - unless res do throwError "failed: {r}{eq} {p} is not true" - | _ => throwUnsupportedSyntax - -/-- -Command to check that an expression evaluates to `true`. - -`#guard e` elaborates `e` ensuring its type is `Bool` then evaluates `e` and checks that -the result is `true`. The term is elaborated *without* variables declared using `variable`, since -these cannot be evaluated. - -Since this makes use of coercions, so long as a proposition `p` is decidable, one can write -`#guard p` rather than `#guard decide p`. A consequence to this is that if there is decidable -equality one can write `#guard a = b`. Note that this is not exactly the same as checking -if `a` and `b` evaluate to the same thing since it uses the `DecidableEq` instance to do -the evaluation. - -Note: this uses the untrusted evaluator, so `#guard` passing is *not* a proof that the -expression equals `true`. -/ -elab "#guard " e:term : command => - Lean.Elab.Command.liftTermElabM do - let e ← Term.elabTermEnsuringType e (mkConst ``Bool) - Term.synthesizeSyntheticMVarsNoPostponing - let e ← instantiateMVars e - let mvars ← getMVars e - if mvars.isEmpty then - let v ← unsafe evalExpr Bool (mkConst ``Bool) e - unless v do - throwError "expression{indentExpr e}\ndid not evaluate to `true`" - else - _ ← Term.logUnassignedUsingErrorInfos mvars diff --git a/Std/Tactic/Init.lean b/Std/Tactic/Init.lean index 22101a7127..a5d48c902b 100644 --- a/Std/Tactic/Init.lean +++ b/Std/Tactic/Init.lean @@ -3,8 +3,9 @@ Copyright (c) 2021 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.GuardExpr import Std.Lean.Meta.Basic +import Lean.Elab.Command +import Lean.Elab.Tactic.BuiltinTactic /-! # Simple tactics that are used throughout Std. diff --git a/lean-toolchain b/lean-toolchain index 5b26253bfe..4387d53c5a 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-10 +leanprover/lean4:nightly-2024-02-12 diff --git a/test/bitvec.lean b/test/bitvec.lean index 7a005da47b..a4f16c5ba5 100644 --- a/test/bitvec.lean +++ b/test/bitvec.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Data.BitVec open Std.BitVec diff --git a/test/case.lean b/test/case.lean index f439a45408..78b6fe5f43 100644 --- a/test/case.lean +++ b/test/case.lean @@ -1,5 +1,4 @@ import Std.Tactic.Case -import Std.Tactic.GuardExpr import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/change.lean b/test/change.lean index be8e0e2885..da295ab843 100644 --- a/test/change.lean +++ b/test/change.lean @@ -1,5 +1,4 @@ import Std.Tactic.Change -import Std.Tactic.GuardExpr private axiom test_sorry : ∀ {α}, α diff --git a/test/classical.lean b/test/classical.lean index a9c527eb75..b65762ae7b 100644 --- a/test/classical.lean +++ b/test/classical.lean @@ -1,6 +1,5 @@ import Std.Tactic.Classical import Std.Tactic.PermuteGoals -import Std.Tactic.GuardExpr noncomputable example : Bool := by fail_if_success have := ∀ p, decide p -- no classical in scope diff --git a/test/congr.lean b/test/congr.lean index 31d590a0b8..21f327fa43 100644 --- a/test/congr.lean +++ b/test/congr.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Tactic.Congr section congr diff --git a/test/conv_equals.lean b/test/conv_equals.lean index 5495c1a4c2..f646192acd 100644 --- a/test/conv_equals.lean +++ b/test/conv_equals.lean @@ -6,7 +6,6 @@ Authors: Joachim Breitner import Std.Tactic.Basic import Std.Tactic.GuardMsgs -import Std.Tactic.GuardExpr -- The example from the doc string, for quick comparision -- and keeping the doc up-to-date diff --git a/test/false_or_by_contra.lean b/test/false_or_by_contra.lean index 7b3f186c7f..5d3e4669e3 100644 --- a/test/false_or_by_contra.lean +++ b/test/false_or_by_contra.lean @@ -1,5 +1,4 @@ import Std.Tactic.FalseOrByContra -import Std.Tactic.GuardExpr example (w : False) : False := by false_or_by_contra diff --git a/test/float.lean b/test/float.lean index 0a5da3023c..05f93e0064 100644 --- a/test/float.lean +++ b/test/float.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Lean.Float #guard 0.0.toRatParts == some (0, -53) diff --git a/test/guardexpr.lean b/test/guardexpr.lean index a3b5e38841..caee2e81df 100644 --- a/test/guardexpr.lean +++ b/test/guardexpr.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Tactic.Basic example (n : Nat) : Nat := by diff --git a/test/int.lean b/test/int.lean index eee63bd591..3c948d4264 100644 --- a/test/int.lean +++ b/test/int.lean @@ -1,5 +1,4 @@ import Std.Data.Int.Basic -import Std.Tactic.GuardExpr -- complement #guard ~~~(-1:Int) = 0 diff --git a/test/on_goal.lean b/test/on_goal.lean index b22d628583..fb53fb3e09 100644 --- a/test/on_goal.lean +++ b/test/on_goal.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardExpr import Std.Tactic.PermuteGoals import Std.Tactic.Unreachable diff --git a/test/rcases.lean b/test/rcases.lean index 1b6eff9985..39c728a9cc 100644 --- a/test/rcases.lean +++ b/test/rcases.lean @@ -1,5 +1,4 @@ import Std.Tactic.Basic -import Std.Tactic.GuardExpr set_option linter.missingDocs false From f0361742a3c1e9ffe4741f21ddd1736601af0b6b Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 13 Feb 2024 19:42:07 +1100 Subject: [PATCH 024/213] 12 --- Std.lean | 2 - Std/Data/Int/DivMod.lean | 1 - Std/Data/Int/Init/DivMod.lean | 2 - Std/Data/List/Lemmas.lean | 1 + Std/Data/Nat/Lemmas.lean | 1 - Std/Lean/Command.lean | 47 ---------- Std/Lean/Meta/DiscrTree.lean | 131 ---------------------------- Std/Linter/UnnecessarySeqFocus.lean | 1 - Std/Linter/UnreachableTactic.lean | 1 - Std/Tactic/Change.lean | 112 ------------------------ Std/Tactic/Ext.lean | 2 + Std/Tactic/Ext/Attr.lean | 3 +- lean-toolchain | 2 +- test/change.lean | 1 - 14 files changed, 5 insertions(+), 302 deletions(-) delete mode 100644 Std/Lean/Command.lean delete mode 100644 Std/Tactic/Change.lean diff --git a/Std.lean b/Std.lean index fc010f7a2f..0245c44c50 100644 --- a/Std.lean +++ b/Std.lean @@ -39,7 +39,6 @@ import Std.Data.String import Std.Data.Sum import Std.Data.UInt import Std.Lean.AttributeExtra -import Std.Lean.Command import Std.Lean.CoreM import Std.Lean.Delaborator import Std.Lean.Elab.Tactic @@ -82,7 +81,6 @@ import Std.Logic import Std.Tactic.Alias import Std.Tactic.Basic import Std.Tactic.Case -import Std.Tactic.Change import Std.Tactic.Classical import Std.Tactic.Congr import Std.Tactic.Exact diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 8e2ae5766c..9d710f2204 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -5,7 +5,6 @@ Authors: Jeremy Avigad, Mario Carneiro -/ import Std.Data.Int.Order import Std.Data.Int.Init.DivMod -import Std.Tactic.Change /-! # Lemmas about integer division diff --git a/Std/Data/Int/Init/DivMod.lean b/Std/Data/Int/Init/DivMod.lean index 02df034871..a0eeb55ae8 100644 --- a/Std/Data/Int/Init/DivMod.lean +++ b/Std/Data/Int/Init/DivMod.lean @@ -4,8 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ import Std.Data.Int.Init.Order -import Std.Tactic.Change -import Std.Tactic.RCases /-! # Lemmas about integer division needed to bootstrap `omega`. diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index f62fc4bfd8..106b3f4841 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -6,6 +6,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M import Std.Control.ForInStep.Lemmas import Std.Data.Bool import Std.Data.Fin.Basic +import Std.Data.Nat.Lemmas import Std.Data.List.Basic import Std.Data.Option.Lemmas import Std.Classes.BEq diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index fcee32bd25..d3324a40ba 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -5,7 +5,6 @@ Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import Std.Logic import Std.Tactic.Alias -import Std.Tactic.RCases import Std.Data.Nat.Init.Lemmas import Std.Data.Nat.Basic import Std.Data.Ord diff --git a/Std/Lean/Command.lean b/Std/Lean/Command.lean deleted file mode 100644 index 1e00599427..0000000000 --- a/Std/Lean/Command.lean +++ /dev/null @@ -1,47 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ -import Lean.Elab.Command -import Lean.Elab.SetOption - -namespace Lean -open Elab Command MonadRecDepth - -/-- -Lift an action in `CommandElabM` into `CoreM`, updating the traces and the environment. -This does not preserve things like `open` and `namespace` declarations. --/ -def liftCommandElabM (k : CommandElabM α) : CoreM α := do - let (a, commandState) ← - k.run { - fileName := ← getFileName - fileMap := ← getFileMap - ref := ← getRef - tacticCache? := none - } |>.run { - env := ← getEnv - maxRecDepth := ← getMaxRecDepth - scopes := [{ header := "", opts := ← getOptions }] - } - modify fun coreState => { coreState with - traceState.traces := coreState.traceState.traces ++ commandState.traceState.traces - env := commandState.env - } - if let some err := commandState.messages.msgs.toArray.find? (·.severity matches .error) then - throwError err.data - pure a - -/-- -Evaluate any `set_option in` commands before the given `stx`, and pass the inner `stx` with the -updated environment to the continuation `k`. --/ -partial def withSetOptionIn (k : CommandElab) : CommandElab := fun stx => do - if stx.getKind == ``Lean.Parser.Command.in && - stx[0].getKind == ``Lean.Parser.Command.set_option then - let opts ← Elab.elabSetOption stx[0][1] stx[0][2] - Command.withScope (fun scope => { scope with opts }) do - withSetOptionIn k stx[1] - else - k stx diff --git a/Std/Lean/Meta/DiscrTree.lean b/Std/Lean/Meta/DiscrTree.lean index d6940b31bb..b14f1bd356 100644 --- a/Std/Lean/Meta/DiscrTree.lean +++ b/Std/Lean/Meta/DiscrTree.lean @@ -33,57 +33,6 @@ end Key namespace Trie --- This is just a partial function, but Lean doesn't realise that its type is --- inhabited. -private unsafe def foldMUnsafe [Monad m] (initialKeys : Array Key) - (f : σ → Array Key → α → m σ) (init : σ) : Trie α → m σ - | Trie.node vs children => do - let s ← vs.foldlM (init := init) fun s v => f s initialKeys v - children.foldlM (init := s) fun s (k, t) => - t.foldMUnsafe (initialKeys.push k) f s - -/-- -Monadically fold the keys and values stored in a `Trie`. --/ -@[implemented_by foldMUnsafe] -opaque foldM [Monad m] (initalKeys : Array Key) - (f : σ → Array Key → α → m σ) (init : σ) (t : Trie α) : m σ := - pure init - -/-- -Fold the keys and values stored in a `Trie`. --/ -@[inline] -def fold (initialKeys : Array Key) (f : σ → Array Key → α → σ) (init : σ) (t : Trie α) : σ := - Id.run <| t.foldM initialKeys (init := init) fun s k a => return f s k a - --- This is just a partial function, but Lean doesn't realise that its type is --- inhabited. -private unsafe def foldValuesMUnsafe [Monad m] (f : σ → α → m σ) (init : σ) : Trie α → m σ - | node vs children => do - let s ← vs.foldlM (init := init) f - children.foldlM (init := s) fun s (_, c) => c.foldValuesMUnsafe (init := s) f - -/-- -Monadically fold the values stored in a `Trie`. --/ -@[implemented_by foldValuesMUnsafe] -opaque foldValuesM [Monad m] (f : σ → α → m σ) (init : σ) (t : Trie α) : m σ := pure init - -/-- -Fold the values stored in a `Trie`. --/ -@[inline] -def foldValues (f : σ → α → σ) (init : σ) (t : Trie α) : σ := - Id.run <| t.foldValuesM (init := init) f - -/-- -The number of values stored in a `Trie`. --/ -partial def size : Trie α → Nat - | Trie.node vs children => - children.foldl (init := vs.size) fun n (_, c) => n + size c - /-- Merge two `Trie`s. Duplicate values are preserved. -/ @@ -100,58 +49,6 @@ where end Trie - -/-- -Monadically fold over the keys and values stored in a `DiscrTree`. --/ -@[inline] -def foldM [Monad m] (f : σ → Array Key → α → m σ) (init : σ) - (t : DiscrTree α) : m σ := - t.root.foldlM (init := init) fun s k t => t.foldM #[k] (init := s) f - -/-- -Fold over the keys and values stored in a `DiscrTree` --/ -@[inline] -def fold (f : σ → Array Key → α → σ) (init : σ) (t : DiscrTree α) : σ := - Id.run <| t.foldM (init := init) fun s keys a => return f s keys a - -/-- -Monadically fold over the values stored in a `DiscrTree`. --/ -@[inline] -def foldValuesM [Monad m] (f : σ → α → m σ) (init : σ) (t : DiscrTree α) : - m σ := - t.root.foldlM (init := init) fun s _ t => t.foldValuesM (init := s) f - -/-- -Fold over the values stored in a `DiscrTree`. --/ -@[inline] -def foldValues (f : σ → α → σ) (init : σ) (t : DiscrTree α) : σ := - Id.run <| t.foldValuesM (init := init) f - -/-- -Extract the values stored in a `DiscrTree`. --/ -@[inline] -def values (t : DiscrTree α) : Array α := - t.foldValues (init := #[]) fun as a => as.push a - -/-- -Extract the keys and values stored in a `DiscrTree`. --/ -@[inline] -def toArray (t : DiscrTree α) : Array (Array Key × α) := - t.fold (init := #[]) fun as keys a => as.push (keys, a) - -/-- -Get the number of values stored in a `DiscrTree`. O(n) in the size of the tree. --/ -@[inline] -def size (t : DiscrTree α) : Nat := - t.root.foldl (init := 0) fun n _ t => n + t.size - /-- Merge two `DiscrTree`s. Duplicate values are preserved. -/ @@ -159,31 +56,3 @@ Merge two `DiscrTree`s. Duplicate values are preserved. def mergePreservingDuplicates (t u : DiscrTree α) : DiscrTree α := ⟨t.root.mergeWith u.root fun _ trie₁ trie₂ => trie₁.mergePreservingDuplicates trie₂⟩ - -/-- -Inserts a new key into a discrimination tree, -but only if it is not of the form `#[*]` or `#[=, *, *, *]`. --/ -def insertIfSpecific [BEq α] (d : DiscrTree α) - (keys : Array DiscrTree.Key) (v : α) : DiscrTree α := - if keys == #[Key.star] || keys == #[Key.const `Eq 3, Key.star, Key.star, Key.star] then - d - else - d.insertCore keys v - -variable {m : Type → Type} [Monad m] - -/-- Apply a monadic function to the array of values at each node in a `DiscrTree`. -/ -partial def Trie.mapArraysM (t : DiscrTree.Trie α) (f : Array α → m (Array β)) : - m (DiscrTree.Trie β) := - match t with - | .node vs children => - return .node (← f vs) (← children.mapM fun (k, t') => do pure (k, ← t'.mapArraysM f)) - -/-- Apply a monadic function to the array of values at each node in a `DiscrTree`. -/ -def mapArraysM (d : DiscrTree α) (f : Array α → m (Array β)) : m (DiscrTree β) := do - pure { root := ← d.root.mapM (fun t => t.mapArraysM f) } - -/-- Apply a function to the array of values at each node in a `DiscrTree`. -/ -def mapArrays (d : DiscrTree α) (f : Array α → Array β) : DiscrTree β := - Id.run <| d.mapArraysM fun A => pure (f A) diff --git a/Std/Linter/UnnecessarySeqFocus.lean b/Std/Linter/UnnecessarySeqFocus.lean index 32f1238726..9070d3c816 100644 --- a/Std/Linter/UnnecessarySeqFocus.lean +++ b/Std/Linter/UnnecessarySeqFocus.lean @@ -6,7 +6,6 @@ Authors: Mario Carneiro import Lean.Elab.Command import Lean.Linter.Util import Std.Lean.AttributeExtra -import Std.Lean.Command namespace Std.Linter open Lean Elab Command Linter diff --git a/Std/Linter/UnreachableTactic.lean b/Std/Linter/UnreachableTactic.lean index d526c359af..46f8d837ab 100644 --- a/Std/Linter/UnreachableTactic.lean +++ b/Std/Linter/UnreachableTactic.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Lean.Elab.Command import Lean.Linter.Util -import Std.Lean.Command import Std.Tactic.Unreachable namespace Std.Linter diff --git a/Std/Tactic/Change.lean b/Std/Tactic/Change.lean deleted file mode 100644 index 9c4b7c9938..0000000000 --- a/Std/Tactic/Change.lean +++ /dev/null @@ -1,112 +0,0 @@ -/- -Copyright (c) 2023 Kyle Miller. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kyle Miller --/ -import Lean.Meta.Tactic.Replace -import Lean.Elab.Tactic.Location - -/-! -# Implementation of the `change at h` tactic --/ - -namespace Lean.MVarId - -open Lean Elab Meta - -/-- Function to help do the revert/intro pattern, running some code inside a context -where certain variables have been reverted before re-introing them. -It will push `FVarId` alias information into info trees for you according to a simple protocol. - -- `fvarIds` is an array of `fvarIds` to revert. These are passed to - `Lean.MVarId.revert` with `preserveOrder := true`, hence the function - raises an error if they cannot be reverted in the provided order. -- `k` is given the goal with all the variables reverted and - the array of reverted `FVarId`s, with the requested `FVarId`s at the beginning. - It must return a tuple of a value, an array describing which `FVarIds` to link, - and a mutated `MVarId`. - -The `a : Array (Option FVarId)` array returned by `k` is interpreted in the following way. -The function will intro `a.size` variables, and then for each non-`none` entry we -create an FVar alias between it and the corresponding `intro`ed variable. -For example, having `k` return `fvars.map .some` causes all reverted variables to be -`intro`ed and linked. - -Returns the value returned by `k` along with the resulting goal. - -/ -def withReverted (mvarId : MVarId) (fvarIds : Array FVarId) - (k : MVarId → Array FVarId → MetaM (α × Array (Option FVarId) × MVarId)) - (clearAuxDeclsInsteadOfRevert := false) : MetaM (α × MVarId) := do - let (xs, mvarId) ← mvarId.revert fvarIds true clearAuxDeclsInsteadOfRevert - let (r, xs', mvarId) ← k mvarId xs - let (ys, mvarId) ← mvarId.introNP xs'.size - mvarId.withContext do - for x? in xs', y in ys do - if let some x := x? then - pushInfoLeaf (.ofFVarAliasInfo { id := y, baseId := x, userName := ← y.getUserName }) - return (r, mvarId) - -/-- -Replace the type of the free variable `fvarId` with `typeNew`. - -If `checkDefEq = true` then throws an error if `typeNew` is not definitionally -equal to the type of `fvarId`. Otherwise this function assumes `typeNew` and the type -of `fvarId` are definitionally equal. - -This function is the same as `Lean.MVarId.changeLocalDecl` but makes sure to push substitution -information into the infotree. --/ -def changeLocalDecl' (mvarId : MVarId) (fvarId : FVarId) (typeNew : Expr) - (checkDefEq := true) : MetaM MVarId := do - mvarId.checkNotAssigned `changeLocalDecl - let (_, mvarId) ← mvarId.withReverted #[fvarId] fun mvarId fvars => mvarId.withContext do - let check (typeOld : Expr) : MetaM Unit := do - if checkDefEq then - unless ← isDefEq typeNew typeOld do - throwTacticEx `changeLocalDecl mvarId - m!"given type{indentExpr typeNew}\nis not definitionally equal to{indentExpr typeOld}" - let finalize (targetNew : Expr) := do - return ((), fvars.map .some, ← mvarId.replaceTargetDefEq targetNew) - match ← mvarId.getType with - | .forallE n d b bi => do check d; finalize (.forallE n typeNew b bi) - | .letE n t v b ndep => do check t; finalize (.letE n typeNew v b ndep) - | _ => throwTacticEx `changeLocalDecl mvarId "unexpected auxiliary target" - return mvarId - -end Lean.MVarId - -open Lean Elab Tactic Meta - -/-- `change` can be used to replace the main goal or its local -variables with definitionally equal ones. - -For example, if `n : ℕ` and the current goal is `⊢ n + 2 = 2`, then -```lean -change _ + 1 = _ -``` -changes the goal to `⊢ n + 1 + 1 = 2`. The tactic also applies to the local context. -If `h : n + 2 = 2` and `h' : n + 3 = 4` are in the local context, then -```lean -change _ + 1 = _ at h h' -``` -changes their types to be `h : n + 1 + 1 = 2` and `h' : n + 2 + 1 = 4`. - -Change is like `refine` in that every placeholder needs to be solved for by unification, -but you can use named placeholders and `?_` where you want `change` to create new goals. - -The tactic `show e` is interchangeable with `change e`, where the pattern `e` is applied to -the main goal. -/ -elab_rules : tactic - | `(tactic| change $newType:term $[$loc:location]?) => do - withLocation (expandOptLocation (Lean.mkOptionalNode loc)) - (atLocal := fun h => do - let hTy ← h.getType - -- This is a hack to get the new type to elaborate in the same sort of way that - -- it would for a `show` expression for the goal. - let mvar ← mkFreshExprMVar none - let (_, mvars) ← elabTermWithHoles - (← `(term | show $newType from $(← Term.exprToSyntax mvar))) hTy `change - liftMetaTactic fun mvarId => do - return (← mvarId.changeLocalDecl' h (← inferType mvar)) :: mvars) - (atTarget := evalTactic <| ← `(tactic| refine_lift show $newType from ?_)) - (failed := fun _ => throwError "change tactic failed") diff --git a/Std/Tactic/Ext.lean b/Std/Tactic/Ext.lean index 623128e16e..6681cc2385 100644 --- a/Std/Tactic/Ext.lean +++ b/Std/Tactic/Ext.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Mario Carneiro -/ import Lean.Elab.Tactic.RCases +import Lean.Linter.Util +import Std.Tactic.Init import Std.Tactic.Ext.Attr namespace Std.Tactic.Ext diff --git a/Std/Tactic/Ext/Attr.lean b/Std/Tactic/Ext/Attr.lean index 141b970e72..febafc4aa8 100644 --- a/Std/Tactic/Ext/Attr.lean +++ b/Std/Tactic/Ext/Attr.lean @@ -3,8 +3,7 @@ Copyright (c) 2021 Gabriel Ebner. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Mario Carneiro -/ -import Std.Lean.Command -import Std.Lean.Meta.DiscrTree +import Lean.Elab.Command namespace Std.Tactic.Ext open Lean Meta diff --git a/lean-toolchain b/lean-toolchain index 4387d53c5a..fc840ba55a 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-12 +leanprover/lean4:nightly-2024-02-13 diff --git a/test/change.lean b/test/change.lean index da295ab843..04fa47c287 100644 --- a/test/change.lean +++ b/test/change.lean @@ -1,4 +1,3 @@ -import Std.Tactic.Change private axiom test_sorry : ∀ {α}, α From b7638a6dd363658e85c6308338203f6cb1b3b15b Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 14 Feb 2024 08:50:26 +1100 Subject: [PATCH 025/213] chore: adaptations for nightly-2024-02-13 (#632) --- Std.lean | 2 - Std/Data/Int/DivMod.lean | 1 - Std/Data/Int/Init/DivMod.lean | 1 - Std/Data/List/Lemmas.lean | 1 + Std/Lean/Command.lean | 47 ---------- Std/Lean/Meta/DiscrTree.lean | 131 ---------------------------- Std/Linter/UnnecessarySeqFocus.lean | 1 - Std/Linter/UnreachableTactic.lean | 1 - Std/Tactic/Change.lean | 112 ------------------------ Std/Tactic/Ext.lean | 2 + Std/Tactic/Ext/Attr.lean | 3 +- lean-toolchain | 2 +- test/change.lean | 1 - 13 files changed, 5 insertions(+), 300 deletions(-) delete mode 100644 Std/Lean/Command.lean delete mode 100644 Std/Tactic/Change.lean diff --git a/Std.lean b/Std.lean index fc010f7a2f..0245c44c50 100644 --- a/Std.lean +++ b/Std.lean @@ -39,7 +39,6 @@ import Std.Data.String import Std.Data.Sum import Std.Data.UInt import Std.Lean.AttributeExtra -import Std.Lean.Command import Std.Lean.CoreM import Std.Lean.Delaborator import Std.Lean.Elab.Tactic @@ -82,7 +81,6 @@ import Std.Logic import Std.Tactic.Alias import Std.Tactic.Basic import Std.Tactic.Case -import Std.Tactic.Change import Std.Tactic.Classical import Std.Tactic.Congr import Std.Tactic.Exact diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 8e2ae5766c..9d710f2204 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -5,7 +5,6 @@ Authors: Jeremy Avigad, Mario Carneiro -/ import Std.Data.Int.Order import Std.Data.Int.Init.DivMod -import Std.Tactic.Change /-! # Lemmas about integer division diff --git a/Std/Data/Int/Init/DivMod.lean b/Std/Data/Int/Init/DivMod.lean index c893a726f4..a0eeb55ae8 100644 --- a/Std/Data/Int/Init/DivMod.lean +++ b/Std/Data/Int/Init/DivMod.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ import Std.Data.Int.Init.Order -import Std.Tactic.Change /-! # Lemmas about integer division needed to bootstrap `omega`. diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index f62fc4bfd8..106b3f4841 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -6,6 +6,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M import Std.Control.ForInStep.Lemmas import Std.Data.Bool import Std.Data.Fin.Basic +import Std.Data.Nat.Lemmas import Std.Data.List.Basic import Std.Data.Option.Lemmas import Std.Classes.BEq diff --git a/Std/Lean/Command.lean b/Std/Lean/Command.lean deleted file mode 100644 index 1e00599427..0000000000 --- a/Std/Lean/Command.lean +++ /dev/null @@ -1,47 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ -import Lean.Elab.Command -import Lean.Elab.SetOption - -namespace Lean -open Elab Command MonadRecDepth - -/-- -Lift an action in `CommandElabM` into `CoreM`, updating the traces and the environment. -This does not preserve things like `open` and `namespace` declarations. --/ -def liftCommandElabM (k : CommandElabM α) : CoreM α := do - let (a, commandState) ← - k.run { - fileName := ← getFileName - fileMap := ← getFileMap - ref := ← getRef - tacticCache? := none - } |>.run { - env := ← getEnv - maxRecDepth := ← getMaxRecDepth - scopes := [{ header := "", opts := ← getOptions }] - } - modify fun coreState => { coreState with - traceState.traces := coreState.traceState.traces ++ commandState.traceState.traces - env := commandState.env - } - if let some err := commandState.messages.msgs.toArray.find? (·.severity matches .error) then - throwError err.data - pure a - -/-- -Evaluate any `set_option in` commands before the given `stx`, and pass the inner `stx` with the -updated environment to the continuation `k`. --/ -partial def withSetOptionIn (k : CommandElab) : CommandElab := fun stx => do - if stx.getKind == ``Lean.Parser.Command.in && - stx[0].getKind == ``Lean.Parser.Command.set_option then - let opts ← Elab.elabSetOption stx[0][1] stx[0][2] - Command.withScope (fun scope => { scope with opts }) do - withSetOptionIn k stx[1] - else - k stx diff --git a/Std/Lean/Meta/DiscrTree.lean b/Std/Lean/Meta/DiscrTree.lean index d6940b31bb..b14f1bd356 100644 --- a/Std/Lean/Meta/DiscrTree.lean +++ b/Std/Lean/Meta/DiscrTree.lean @@ -33,57 +33,6 @@ end Key namespace Trie --- This is just a partial function, but Lean doesn't realise that its type is --- inhabited. -private unsafe def foldMUnsafe [Monad m] (initialKeys : Array Key) - (f : σ → Array Key → α → m σ) (init : σ) : Trie α → m σ - | Trie.node vs children => do - let s ← vs.foldlM (init := init) fun s v => f s initialKeys v - children.foldlM (init := s) fun s (k, t) => - t.foldMUnsafe (initialKeys.push k) f s - -/-- -Monadically fold the keys and values stored in a `Trie`. --/ -@[implemented_by foldMUnsafe] -opaque foldM [Monad m] (initalKeys : Array Key) - (f : σ → Array Key → α → m σ) (init : σ) (t : Trie α) : m σ := - pure init - -/-- -Fold the keys and values stored in a `Trie`. --/ -@[inline] -def fold (initialKeys : Array Key) (f : σ → Array Key → α → σ) (init : σ) (t : Trie α) : σ := - Id.run <| t.foldM initialKeys (init := init) fun s k a => return f s k a - --- This is just a partial function, but Lean doesn't realise that its type is --- inhabited. -private unsafe def foldValuesMUnsafe [Monad m] (f : σ → α → m σ) (init : σ) : Trie α → m σ - | node vs children => do - let s ← vs.foldlM (init := init) f - children.foldlM (init := s) fun s (_, c) => c.foldValuesMUnsafe (init := s) f - -/-- -Monadically fold the values stored in a `Trie`. --/ -@[implemented_by foldValuesMUnsafe] -opaque foldValuesM [Monad m] (f : σ → α → m σ) (init : σ) (t : Trie α) : m σ := pure init - -/-- -Fold the values stored in a `Trie`. --/ -@[inline] -def foldValues (f : σ → α → σ) (init : σ) (t : Trie α) : σ := - Id.run <| t.foldValuesM (init := init) f - -/-- -The number of values stored in a `Trie`. --/ -partial def size : Trie α → Nat - | Trie.node vs children => - children.foldl (init := vs.size) fun n (_, c) => n + size c - /-- Merge two `Trie`s. Duplicate values are preserved. -/ @@ -100,58 +49,6 @@ where end Trie - -/-- -Monadically fold over the keys and values stored in a `DiscrTree`. --/ -@[inline] -def foldM [Monad m] (f : σ → Array Key → α → m σ) (init : σ) - (t : DiscrTree α) : m σ := - t.root.foldlM (init := init) fun s k t => t.foldM #[k] (init := s) f - -/-- -Fold over the keys and values stored in a `DiscrTree` --/ -@[inline] -def fold (f : σ → Array Key → α → σ) (init : σ) (t : DiscrTree α) : σ := - Id.run <| t.foldM (init := init) fun s keys a => return f s keys a - -/-- -Monadically fold over the values stored in a `DiscrTree`. --/ -@[inline] -def foldValuesM [Monad m] (f : σ → α → m σ) (init : σ) (t : DiscrTree α) : - m σ := - t.root.foldlM (init := init) fun s _ t => t.foldValuesM (init := s) f - -/-- -Fold over the values stored in a `DiscrTree`. --/ -@[inline] -def foldValues (f : σ → α → σ) (init : σ) (t : DiscrTree α) : σ := - Id.run <| t.foldValuesM (init := init) f - -/-- -Extract the values stored in a `DiscrTree`. --/ -@[inline] -def values (t : DiscrTree α) : Array α := - t.foldValues (init := #[]) fun as a => as.push a - -/-- -Extract the keys and values stored in a `DiscrTree`. --/ -@[inline] -def toArray (t : DiscrTree α) : Array (Array Key × α) := - t.fold (init := #[]) fun as keys a => as.push (keys, a) - -/-- -Get the number of values stored in a `DiscrTree`. O(n) in the size of the tree. --/ -@[inline] -def size (t : DiscrTree α) : Nat := - t.root.foldl (init := 0) fun n _ t => n + t.size - /-- Merge two `DiscrTree`s. Duplicate values are preserved. -/ @@ -159,31 +56,3 @@ Merge two `DiscrTree`s. Duplicate values are preserved. def mergePreservingDuplicates (t u : DiscrTree α) : DiscrTree α := ⟨t.root.mergeWith u.root fun _ trie₁ trie₂ => trie₁.mergePreservingDuplicates trie₂⟩ - -/-- -Inserts a new key into a discrimination tree, -but only if it is not of the form `#[*]` or `#[=, *, *, *]`. --/ -def insertIfSpecific [BEq α] (d : DiscrTree α) - (keys : Array DiscrTree.Key) (v : α) : DiscrTree α := - if keys == #[Key.star] || keys == #[Key.const `Eq 3, Key.star, Key.star, Key.star] then - d - else - d.insertCore keys v - -variable {m : Type → Type} [Monad m] - -/-- Apply a monadic function to the array of values at each node in a `DiscrTree`. -/ -partial def Trie.mapArraysM (t : DiscrTree.Trie α) (f : Array α → m (Array β)) : - m (DiscrTree.Trie β) := - match t with - | .node vs children => - return .node (← f vs) (← children.mapM fun (k, t') => do pure (k, ← t'.mapArraysM f)) - -/-- Apply a monadic function to the array of values at each node in a `DiscrTree`. -/ -def mapArraysM (d : DiscrTree α) (f : Array α → m (Array β)) : m (DiscrTree β) := do - pure { root := ← d.root.mapM (fun t => t.mapArraysM f) } - -/-- Apply a function to the array of values at each node in a `DiscrTree`. -/ -def mapArrays (d : DiscrTree α) (f : Array α → Array β) : DiscrTree β := - Id.run <| d.mapArraysM fun A => pure (f A) diff --git a/Std/Linter/UnnecessarySeqFocus.lean b/Std/Linter/UnnecessarySeqFocus.lean index 32f1238726..9070d3c816 100644 --- a/Std/Linter/UnnecessarySeqFocus.lean +++ b/Std/Linter/UnnecessarySeqFocus.lean @@ -6,7 +6,6 @@ Authors: Mario Carneiro import Lean.Elab.Command import Lean.Linter.Util import Std.Lean.AttributeExtra -import Std.Lean.Command namespace Std.Linter open Lean Elab Command Linter diff --git a/Std/Linter/UnreachableTactic.lean b/Std/Linter/UnreachableTactic.lean index d526c359af..46f8d837ab 100644 --- a/Std/Linter/UnreachableTactic.lean +++ b/Std/Linter/UnreachableTactic.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Lean.Elab.Command import Lean.Linter.Util -import Std.Lean.Command import Std.Tactic.Unreachable namespace Std.Linter diff --git a/Std/Tactic/Change.lean b/Std/Tactic/Change.lean deleted file mode 100644 index 9c4b7c9938..0000000000 --- a/Std/Tactic/Change.lean +++ /dev/null @@ -1,112 +0,0 @@ -/- -Copyright (c) 2023 Kyle Miller. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kyle Miller --/ -import Lean.Meta.Tactic.Replace -import Lean.Elab.Tactic.Location - -/-! -# Implementation of the `change at h` tactic --/ - -namespace Lean.MVarId - -open Lean Elab Meta - -/-- Function to help do the revert/intro pattern, running some code inside a context -where certain variables have been reverted before re-introing them. -It will push `FVarId` alias information into info trees for you according to a simple protocol. - -- `fvarIds` is an array of `fvarIds` to revert. These are passed to - `Lean.MVarId.revert` with `preserveOrder := true`, hence the function - raises an error if they cannot be reverted in the provided order. -- `k` is given the goal with all the variables reverted and - the array of reverted `FVarId`s, with the requested `FVarId`s at the beginning. - It must return a tuple of a value, an array describing which `FVarIds` to link, - and a mutated `MVarId`. - -The `a : Array (Option FVarId)` array returned by `k` is interpreted in the following way. -The function will intro `a.size` variables, and then for each non-`none` entry we -create an FVar alias between it and the corresponding `intro`ed variable. -For example, having `k` return `fvars.map .some` causes all reverted variables to be -`intro`ed and linked. - -Returns the value returned by `k` along with the resulting goal. - -/ -def withReverted (mvarId : MVarId) (fvarIds : Array FVarId) - (k : MVarId → Array FVarId → MetaM (α × Array (Option FVarId) × MVarId)) - (clearAuxDeclsInsteadOfRevert := false) : MetaM (α × MVarId) := do - let (xs, mvarId) ← mvarId.revert fvarIds true clearAuxDeclsInsteadOfRevert - let (r, xs', mvarId) ← k mvarId xs - let (ys, mvarId) ← mvarId.introNP xs'.size - mvarId.withContext do - for x? in xs', y in ys do - if let some x := x? then - pushInfoLeaf (.ofFVarAliasInfo { id := y, baseId := x, userName := ← y.getUserName }) - return (r, mvarId) - -/-- -Replace the type of the free variable `fvarId` with `typeNew`. - -If `checkDefEq = true` then throws an error if `typeNew` is not definitionally -equal to the type of `fvarId`. Otherwise this function assumes `typeNew` and the type -of `fvarId` are definitionally equal. - -This function is the same as `Lean.MVarId.changeLocalDecl` but makes sure to push substitution -information into the infotree. --/ -def changeLocalDecl' (mvarId : MVarId) (fvarId : FVarId) (typeNew : Expr) - (checkDefEq := true) : MetaM MVarId := do - mvarId.checkNotAssigned `changeLocalDecl - let (_, mvarId) ← mvarId.withReverted #[fvarId] fun mvarId fvars => mvarId.withContext do - let check (typeOld : Expr) : MetaM Unit := do - if checkDefEq then - unless ← isDefEq typeNew typeOld do - throwTacticEx `changeLocalDecl mvarId - m!"given type{indentExpr typeNew}\nis not definitionally equal to{indentExpr typeOld}" - let finalize (targetNew : Expr) := do - return ((), fvars.map .some, ← mvarId.replaceTargetDefEq targetNew) - match ← mvarId.getType with - | .forallE n d b bi => do check d; finalize (.forallE n typeNew b bi) - | .letE n t v b ndep => do check t; finalize (.letE n typeNew v b ndep) - | _ => throwTacticEx `changeLocalDecl mvarId "unexpected auxiliary target" - return mvarId - -end Lean.MVarId - -open Lean Elab Tactic Meta - -/-- `change` can be used to replace the main goal or its local -variables with definitionally equal ones. - -For example, if `n : ℕ` and the current goal is `⊢ n + 2 = 2`, then -```lean -change _ + 1 = _ -``` -changes the goal to `⊢ n + 1 + 1 = 2`. The tactic also applies to the local context. -If `h : n + 2 = 2` and `h' : n + 3 = 4` are in the local context, then -```lean -change _ + 1 = _ at h h' -``` -changes their types to be `h : n + 1 + 1 = 2` and `h' : n + 2 + 1 = 4`. - -Change is like `refine` in that every placeholder needs to be solved for by unification, -but you can use named placeholders and `?_` where you want `change` to create new goals. - -The tactic `show e` is interchangeable with `change e`, where the pattern `e` is applied to -the main goal. -/ -elab_rules : tactic - | `(tactic| change $newType:term $[$loc:location]?) => do - withLocation (expandOptLocation (Lean.mkOptionalNode loc)) - (atLocal := fun h => do - let hTy ← h.getType - -- This is a hack to get the new type to elaborate in the same sort of way that - -- it would for a `show` expression for the goal. - let mvar ← mkFreshExprMVar none - let (_, mvars) ← elabTermWithHoles - (← `(term | show $newType from $(← Term.exprToSyntax mvar))) hTy `change - liftMetaTactic fun mvarId => do - return (← mvarId.changeLocalDecl' h (← inferType mvar)) :: mvars) - (atTarget := evalTactic <| ← `(tactic| refine_lift show $newType from ?_)) - (failed := fun _ => throwError "change tactic failed") diff --git a/Std/Tactic/Ext.lean b/Std/Tactic/Ext.lean index 623128e16e..6681cc2385 100644 --- a/Std/Tactic/Ext.lean +++ b/Std/Tactic/Ext.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Mario Carneiro -/ import Lean.Elab.Tactic.RCases +import Lean.Linter.Util +import Std.Tactic.Init import Std.Tactic.Ext.Attr namespace Std.Tactic.Ext diff --git a/Std/Tactic/Ext/Attr.lean b/Std/Tactic/Ext/Attr.lean index 141b970e72..febafc4aa8 100644 --- a/Std/Tactic/Ext/Attr.lean +++ b/Std/Tactic/Ext/Attr.lean @@ -3,8 +3,7 @@ Copyright (c) 2021 Gabriel Ebner. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Mario Carneiro -/ -import Std.Lean.Command -import Std.Lean.Meta.DiscrTree +import Lean.Elab.Command namespace Std.Tactic.Ext open Lean Meta diff --git a/lean-toolchain b/lean-toolchain index 4387d53c5a..fc840ba55a 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-12 +leanprover/lean4:nightly-2024-02-13 diff --git a/test/change.lean b/test/change.lean index da295ab843..04fa47c287 100644 --- a/test/change.lean +++ b/test/change.lean @@ -1,4 +1,3 @@ -import Std.Tactic.Change private axiom test_sorry : ∀ {α}, α From a553c0a75efe099c826aa6a32232d1aca6d5571c Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 14 Feb 2024 12:21:52 +1100 Subject: [PATCH 026/213] toolchain --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index fc840ba55a..eb9dd73386 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-13 +leanprover/lean4-pr-releases:lean-pr-release-3312 From 47a3867908b3425a4f3f62b38d82287925e7e11a Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 14 Feb 2024 14:37:39 +1100 Subject: [PATCH 027/213] fix Std.lean --- Std.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Std.lean b/Std.lean index 0245c44c50..6b737270f4 100644 --- a/Std.lean +++ b/Std.lean @@ -25,6 +25,7 @@ import Std.Data.DList import Std.Data.Fin import Std.Data.HashMap import Std.Data.Int +import Std.Data.LazyList import Std.Data.List import Std.Data.MLList import Std.Data.Nat From bfe4a249ff816bf823d2e17135a57732e8aa7ef0 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Tue, 13 Feb 2024 12:21:32 -0800 Subject: [PATCH 028/213] chore: changes for lean4/3312 --- Std/Classes/LawfulMonad.lean | 1 - Std/Data/Array/Init/Lemmas.lean | 1 + Std/Data/Bool.lean | 2 + Std/Data/Fin/Iterate.lean | 1 - Std/Data/List/Init/Lemmas.lean | 1 - Std/Data/List/Lemmas.lean | 2 +- Std/Data/Nat/Bitwise.lean | 6 +- Std/Data/Nat/Init/Lemmas.lean | 2 +- Std/Data/Nat/Lemmas.lean | 4 +- Std/Data/Option/Lemmas.lean | 1 - Std/Data/PairingHeap.lean | 1 - Std/Data/RBMap/Basic.lean | 2 +- Std/Data/RBMap/WF.lean | 1 - Std/Data/String/Lemmas.lean | 3 +- Std/Data/Sum/Basic.lean | 2 - Std/Lean/Meta/Basic.lean | 55 -- Std/Logic.lean | 793 +------------------------- Std/Tactic/Init.lean | 35 -- Std/Tactic/Omega/Logic.lean | 3 +- Std/Tactic/SolveByElim.lean | 3 +- Std/Tactic/SolveByElim/Backtrack.lean | 1 + test/isIndependentOf.lean | 1 + test/lintsimp.lean | 4 +- test/print_prefix.lean | 13 +- 24 files changed, 29 insertions(+), 909 deletions(-) diff --git a/Std/Classes/LawfulMonad.lean b/Std/Classes/LawfulMonad.lean index fa45dd7988..58f98486df 100644 --- a/Std/Classes/LawfulMonad.lean +++ b/Std/Classes/LawfulMonad.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Logic /-- An alternative constructor for `LawfulMonad` which has more diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index 5833f80ea3..c5ba59a600 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Tactic.HaveI +import Std.Data.Bool import Std.Classes.LawfulMonad import Std.Data.Fin.Init.Lemmas import Std.Data.Nat.Init.Lemmas diff --git a/Std/Data/Bool.lean b/Std/Data/Bool.lean index 26424373cb..eb463d5d76 100644 --- a/Std/Data/Bool.lean +++ b/Std/Data/Bool.lean @@ -46,6 +46,8 @@ theorem eq_false_iff : {b : Bool} → b = false ↔ b ≠ true := by decide theorem ne_false_iff : {b : Bool} → b ≠ false ↔ b = true := by decide +theorem eq_iff_iff {a b : Bool} : a = b ↔ (a ↔ b) := by cases b <;> simp + /-! ### and -/ @[simp] theorem not_and_self : ∀ (x : Bool), (!x && x) = false := by decide diff --git a/Std/Data/Fin/Iterate.lean b/Std/Data/Fin/Iterate.lean index c21fdffd89..73a03a7998 100644 --- a/Std/Data/Fin/Iterate.lean +++ b/Std/Data/Fin/Iterate.lean @@ -4,7 +4,6 @@ institutional affiliations. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joe Hendrix -/ -import Std.Logic namespace Fin diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean index e651829492..bb7948de08 100644 --- a/Std/Data/List/Init/Lemmas.lean +++ b/Std/Data/List/Init/Lemmas.lean @@ -6,7 +6,6 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M import Std.Classes.SetNotation import Std.Data.Nat.Init.Lemmas import Std.Data.List.Init.Basic -import Std.Logic namespace List diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 106b3f4841..ad71e8e001 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -953,7 +953,7 @@ theorem get?_modifyNth (f : α → α) : | n+1, a :: l, m+1 => (get?_modifyNth f n l m).trans <| by cases l.get? m <;> by_cases h : n = m <;> - simp only [h, if_pos, if_true, if_false, Option.map, mt Nat.succ.inj, not_false_iff] + simp only [h, if_pos, if_neg, Option.map, mt Nat.succ.inj, not_false_iff] theorem modifyNthTail_length (f : List α → List α) (H : ∀ l, length (f l) = length l) : ∀ n l, length (modifyNthTail f n l) = length l diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean index 22924c8450..dc6324c2df 100644 --- a/Std/Data/Nat/Bitwise.lean +++ b/Std/Data/Nat/Bitwise.lean @@ -363,13 +363,13 @@ theorem bitwise_lt_two_pow (left : x < 2^n) (right : y < 2^n) : (Nat.bitwise f x | succ n hyp => unfold bitwise if x_zero : x = 0 then - simp only [x_zero, if_true] + simp only [x_zero, if_pos] by_cases p : f false true = true <;> simp [p, right] else if y_zero : y = 0 then - simp only [x_zero, y_zero, if_false, if_true] + simp only [x_zero, y_zero, if_neg, if_pos] by_cases p : f true false = true <;> simp [p, left] else - simp only [x_zero, y_zero, if_false] + simp only [x_zero, y_zero, if_neg] have hyp1 := hyp (div_two_le_of_lt_two left) (div_two_le_of_lt_two right) by_cases p : f (decide (x % 2 = 1)) (decide (y % 2 = 1)) = true <;> simp [p, pow_succ, mul_succ, Nat.add_assoc] diff --git a/Std/Data/Nat/Init/Lemmas.lean b/Std/Data/Nat/Init/Lemmas.lean index 5c8bbfc379..ea21d5d0af 100644 --- a/Std/Data/Nat/Init/Lemmas.lean +++ b/Std/Data/Nat/Init/Lemmas.lean @@ -3,7 +3,7 @@ Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ -import Std.Logic +import Std.Tactic.Alias namespace Nat diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index 1980ab72ab..cf1799d664 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -3,8 +3,8 @@ Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ -import Std.Logic import Std.Tactic.Alias +import Std.Tactic.Init import Std.Data.Nat.Init.Lemmas import Std.Data.Nat.Basic import Std.Data.Ord @@ -1231,7 +1231,7 @@ protected theorem pow_le_pow_iff_right {a n m : Nat} (h : 1 < a) : a ^ n ≤ a ^ m ↔ n ≤ m := by constructor · by_contra w - simp at w + simp [Decidable.not_imp_iff_and_not] at w apply Nat.lt_irrefl (a ^ n) exact Nat.lt_of_le_of_lt w.1 (Nat.pow_lt_pow_of_lt h w.2) · intro w diff --git a/Std/Data/Option/Lemmas.lean b/Std/Data/Option/Lemmas.lean index fea0a04c28..5ef860bbb7 100644 --- a/Std/Data/Option/Lemmas.lean +++ b/Std/Data/Option/Lemmas.lean @@ -6,7 +6,6 @@ Authors: Mario Carneiro import Std.Data.Option.Init.Lemmas import Std.Data.Option.Basic import Std.Tactic.Ext.Attr -import Std.Logic namespace Option diff --git a/Std/Data/PairingHeap.lean b/Std/Data/PairingHeap.lean index 312b9e3f59..fd30bd0c44 100644 --- a/Std/Data/PairingHeap.lean +++ b/Std/Data/PairingHeap.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuyang Zhao -/ import Std.Classes.Order -import Std.Logic namespace Std.PairingHeapImp diff --git a/Std/Data/RBMap/Basic.lean b/Std/Data/RBMap/Basic.lean index bf69dc8b5a..042d94b7c6 100644 --- a/Std/Data/RBMap/Basic.lean +++ b/Std/Data/RBMap/Basic.lean @@ -5,8 +5,8 @@ Authors: Leonardo de Moura, Mario Carneiro -/ import Std.Classes.Order import Std.Control.ForInStep.Basic -import Std.Logic import Std.Tactic.HaveI +import Std.Tactic.Lint.Misc /-! # Red-black trees diff --git a/Std/Data/RBMap/WF.lean b/Std/Data/RBMap/WF.lean index 7c8bd18775..ddc72ea38f 100644 --- a/Std/Data/RBMap/WF.lean +++ b/Std/Data/RBMap/WF.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Logic import Std.Data.RBMap.Basic import Std.Tactic.SeqFocus diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 958daba086..74c85883ad 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -7,8 +7,9 @@ import Std.Data.Char import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.String.Basic -import Std.Tactic.SeqFocus import Std.Tactic.Ext.Attr +import Std.Tactic.Lint.Misc +import Std.Tactic.SeqFocus import Std.Tactic.Simpa @[simp] theorem Char.length_toString (c : Char) : c.toString.length = 1 := rfl diff --git a/Std/Data/Sum/Basic.lean b/Std/Data/Sum/Basic.lean index 2d60f9ea1c..c5e93ed8f3 100644 --- a/Std/Data/Sum/Basic.lean +++ b/Std/Data/Sum/Basic.lean @@ -4,8 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Yury G. Kudryashov -/ -import Std.Logic - /-! # Disjoint union of types diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index 5ec48693b6..c6bbb8bac5 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -266,61 +266,6 @@ def mkFreshIdWithPrefix [Monad m] [MonadNameGenerator m] («prefix» : Name) : setNGen ngen.next pure r -/-- -Implementation of `repeat'` and `repeat1'`. - -`repeat'Core f` runs `f` on all of the goals to produce a new list of goals, -then runs `f` again on all of those goals, and repeats until `f` fails on all remaining goals, -or until `maxIters` total calls to `f` have occurred. - -Returns a boolean indicating whether `f` succeeded at least once, and -all the remaining goals (i.e. those on which `f` failed). --/ -def repeat'Core [Monad m] [MonadExcept ε m] [MonadBacktrack s m] [MonadMCtx m] - (f : MVarId → m (List MVarId)) (gs : List MVarId) (maxIters := 100000) : - m (Bool × List MVarId) := do - let (progress, acc) ← go maxIters false gs [] #[] - pure (progress, (← acc.filterM fun g => not <$> g.isAssigned).toList) -where - /-- Auxiliary for `repeat'Core`. `repeat'Core.go f maxIters progress gs stk acc` evaluates to - essentially `acc.toList ++ repeat' f (gs::stk).join maxIters`: that is, `acc` are goals we will - not revisit, and `(gs::stk).join` is the accumulated todo list of subgoals. -/ - go : Nat → Bool → List MVarId → List (List MVarId) → Array MVarId → m (Bool × Array MVarId) - | _, p, [], [], acc => pure (p, acc) - | n, p, [], gs::stk, acc => go n p gs stk acc - | n, p, g::gs, stk, acc => do - if ← g.isAssigned then - go n p gs stk acc - else - match n with - | 0 => pure <| (p, acc.push g ++ gs |> stk.foldl .appendList) - | n+1 => - match ← observing? (f g) with - | some gs' => go n true gs' (gs::stk) acc - | none => go n p gs stk (acc.push g) -termination_by n p gs stk _ => (n, stk, gs) - -/-- -`repeat' f` runs `f` on all of the goals to produce a new list of goals, -then runs `f` again on all of those goals, and repeats until `f` fails on all remaining goals, -or until `maxIters` total calls to `f` have occurred. -Always succeeds (returning the original goals if `f` fails on all of them). --/ -def repeat' [Monad m] [MonadExcept ε m] [MonadBacktrack s m] [MonadMCtx m] - (f : MVarId → m (List MVarId)) (gs : List MVarId) (maxIters := 100000) : m (List MVarId) := - repeat'Core f gs maxIters <&> (·.2) - -/-- -`repeat1' f` runs `f` on all of the goals to produce a new list of goals, -then runs `f` again on all of those goals, and repeats until `f` fails on all remaining goals, -or until `maxIters` total calls to `f` have occurred. -Fails if `f` does not succeed at least once. --/ -def repeat1' [Monad m] [MonadError m] [MonadExcept ε m] [MonadBacktrack s m] [MonadMCtx m] - (f : MVarId → m (List MVarId)) (gs : List MVarId) (maxIters := 100000) : m (List MVarId) := do - let (.true, gs) ← repeat'Core f gs maxIters | throwError "repeat1' made no progress" - pure gs - /-- `saturate1 goal tac` runs `tac` on `goal`, then on the resulting goals, etc., until `tac` does not apply to any goal any more (i.e. it returns `none`). The diff --git a/Std/Logic.lean b/Std/Logic.lean index 1d6f50171f..418b2f5d6c 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -10,721 +10,20 @@ import Std.Tactic.Lint.Misc instance {f : α → β} [DecidablePred p] : DecidablePred (p ∘ f) := inferInstanceAs <| DecidablePred fun x => p (f x) -theorem Function.comp_def {α β δ} (f : β → δ) (g : α → β) : f ∘ g = fun x => f (g x) := rfl - -/-! ## not -/ - -theorem Not.intro {a : Prop} (h : a → False) : ¬a := h - -/-- Ex falso for negation. From `¬a` and `a` anything follows. This is the same as `absurd` with -the arguments flipped, but it is in the `not` namespace so that projection notation can be used. -/ -def Not.elim {α : Sort _} (H1 : ¬a) (H2 : a) : α := absurd H2 H1 - -theorem Not.imp {a b : Prop} (H2 : ¬b) (H1 : a → b) : ¬a := mt H1 H2 - -theorem not_congr (h : a ↔ b) : ¬a ↔ ¬b := ⟨mt h.2, mt h.1⟩ - -theorem not_not_not : ¬¬¬a ↔ ¬a := ⟨mt not_not_intro, not_not_intro⟩ - -theorem not_not_of_not_imp : ¬(a → b) → ¬¬a := mt Not.elim - -theorem not_of_not_imp {a : Prop} : ¬(a → b) → ¬b := mt fun h _ => h - -@[simp] theorem imp_not_self : (a → ¬a) ↔ ¬a := ⟨fun h ha => h ha ha, fun h _ => h⟩ - -/-! ## iff -/ - --- This is needed for `calc` to work with `iff`. -instance : Trans Iff Iff Iff where - trans p q := p.trans q - -theorem iff_def : (a ↔ b) ↔ (a → b) ∧ (b → a) := iff_iff_implies_and_implies .. - -theorem iff_def' : (a ↔ b) ↔ (b → a) ∧ (a → b) := iff_def.trans And.comm - -/-- Non-dependent eliminator for `Iff`. -/ -def Iff.elim (f : (a → b) → (b → a) → α) (h : a ↔ b) : α := f h.1 h.2 - -theorem Eq.to_iff : a = b → (a ↔ b) | rfl => Iff.rfl - -theorem iff_of_eq : a = b → (a ↔ b) := Eq.to_iff - -theorem neq_of_not_iff : ¬(a ↔ b) → a ≠ b := mt Eq.to_iff - -theorem iff_iff_eq : (a ↔ b) ↔ a = b := ⟨propext, iff_of_eq⟩ - -@[simp] theorem eq_iff_iff {p q : Prop} : (p = q) ↔ (p ↔ q) := iff_iff_eq.symm - -theorem of_iff_true (h : a ↔ True) : a := h.2 ⟨⟩ - -theorem not_of_iff_false : (a ↔ False) → ¬a := Iff.mp - -theorem iff_of_true (ha : a) (hb : b) : a ↔ b := ⟨fun _ => hb, fun _ => ha⟩ - -theorem iff_of_false (ha : ¬a) (hb : ¬b) : a ↔ b := ⟨ha.elim, hb.elim⟩ - -theorem iff_true_left (ha : a) : (a ↔ b) ↔ b := ⟨fun h => h.1 ha, iff_of_true ha⟩ - -theorem iff_true_right (ha : a) : (b ↔ a) ↔ b := Iff.comm.trans (iff_true_left ha) - -theorem iff_false_left (ha : ¬a) : (a ↔ b) ↔ ¬b := ⟨fun h => mt h.2 ha, iff_of_false ha⟩ - -theorem iff_false_right (ha : ¬a) : (b ↔ a) ↔ ¬b := Iff.comm.trans (iff_false_left ha) - -theorem iff_true_intro (h : a) : a ↔ True := iff_of_true h ⟨⟩ - -theorem iff_false_intro (h : ¬a) : a ↔ False := iff_of_false h id - -theorem not_iff_false_intro (h : a) : ¬a ↔ False := iff_false_intro (not_not_intro h) - -theorem iff_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a ↔ b) ↔ (c ↔ d) := - ⟨fun h => h₁.symm.trans <| h.trans h₂, fun h => h₁.trans <| h.trans h₂.symm⟩ - -theorem not_true : (¬True) ↔ False := iff_false_intro (not_not_intro ⟨⟩) - -theorem not_false_iff : (¬False) ↔ True := iff_true_intro not_false - -theorem ne_self_iff_false (a : α) : a ≠ a ↔ False := not_iff_false_intro rfl - -theorem eq_self_iff_true (a : α) : a = a ↔ True := iff_true_intro rfl - -theorem heq_self_iff_true (a : α) : HEq a a ↔ True := iff_true_intro HEq.rfl - -theorem iff_not_self : ¬(a ↔ ¬a) | H => let f h := H.1 h h; f (H.2 f) - -@[simp] theorem not_iff_self : ¬(¬a ↔ a) | H => iff_not_self H.symm - -theorem true_iff_false : (True ↔ False) ↔ False := iff_false_intro (fun h => h.1 ⟨⟩) - -theorem false_iff_true : (False ↔ True) ↔ False := iff_false_intro (fun h => h.2 ⟨⟩) - -theorem false_of_true_iff_false : (True ↔ False) → False := fun h => h.1 ⟨⟩ - -theorem false_of_true_eq_false : (True = False) → False := fun h => h ▸ trivial - -theorem true_eq_false_of_false : False → (True = False) := False.elim - -theorem eq_comm {a b : α} : a = b ↔ b = a := ⟨Eq.symm, Eq.symm⟩ - -/-! ## implies -/ - -@[nolint unusedArguments] -theorem imp_intro {α β : Prop} (h : α) : β → α := fun _ => h - -theorem imp_imp_imp {a b c d : Prop} (h₀ : c → a) (h₁ : b → d) : (a → b) → (c → d) := (h₁ ∘ · ∘ h₀) - -theorem imp_iff_right {a : Prop} (ha : a) : (a → b) ↔ b := ⟨fun f => f ha, imp_intro⟩ - --- This is not marked `@[simp]` because we have `implies_true : (α → True) = True` in core. -theorem imp_true_iff (α : Sort u) : (α → True) ↔ True := iff_true_intro fun _ => trivial - -theorem false_imp_iff (a : Prop) : (False → a) ↔ True := iff_true_intro False.elim - -theorem true_imp_iff (α : Prop) : (True → α) ↔ α := ⟨fun h => h trivial, fun h _ => h⟩ - -@[simp] theorem imp_self : (a → a) ↔ True := iff_true_intro id - -theorem imp_false : (a → False) ↔ ¬a := Iff.rfl - -theorem imp.swap : (a → b → c) ↔ (b → a → c) := ⟨flip, flip⟩ - -theorem imp_not_comm : (a → ¬b) ↔ (b → ¬a) := imp.swap - -theorem imp_congr_left (h : a ↔ b) : (a → c) ↔ (b → c) := - ⟨fun hac ha => hac (h.2 ha), fun hbc ha => hbc (h.1 ha)⟩ - -theorem imp_congr_right (h : a → (b ↔ c)) : (a → b) ↔ (a → c) := - ⟨fun hab ha => (h ha).1 (hab ha), fun hcd ha => (h ha).2 (hcd ha)⟩ - -theorem imp_congr_ctx (h₁ : a ↔ c) (h₂ : c → (b ↔ d)) : (a → b) ↔ (c → d) := - (imp_congr_left h₁).trans (imp_congr_right h₂) - -theorem imp_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a → b) ↔ (c → d) := imp_congr_ctx h₁ fun _ => h₂ - -theorem imp_iff_not (hb : ¬b) : a → b ↔ ¬a := imp_congr_right fun _ => iff_false_intro hb - -/-! ## and -/ - -/-- Non-dependent eliminator for `And`. -/ -abbrev And.elim (f : a → b → α) (h : a ∧ b) : α := f h.1 h.2 - --- TODO: rename and_self to and_self_eq -theorem and_self_iff : a ∧ a ↔ a := and_self _ ▸ .rfl - -theorem And.symm : a ∧ b → b ∧ a | ⟨ha, hb⟩ => ⟨hb, ha⟩ - -theorem And.imp (f : a → c) (g : b → d) (h : a ∧ b) : c ∧ d := ⟨f h.1, g h.2⟩ - -theorem And.imp_left (h : a → b) : a ∧ c → b ∧ c := .imp h id - -theorem And.imp_right (h : a → b) : c ∧ a → c ∧ b := .imp id h - -theorem and_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : a ∧ b ↔ c ∧ d := - ⟨And.imp h₁.1 h₂.1, And.imp h₁.2 h₂.2⟩ - -theorem and_comm : a ∧ b ↔ b ∧ a := And.comm - -theorem and_congr_right (h : a → (b ↔ c)) : a ∧ b ↔ a ∧ c := -⟨fun ⟨ha, hb⟩ => ⟨ha, (h ha).1 hb⟩, fun ⟨ha, hb⟩ => ⟨ha, (h ha).2 hb⟩⟩ - -theorem and_congr_left (h : c → (a ↔ b)) : a ∧ c ↔ b ∧ c := - and_comm.trans <| (and_congr_right h).trans and_comm - -theorem and_congr_left' (h : a ↔ b) : a ∧ c ↔ b ∧ c := and_congr h .rfl - -theorem and_congr_right' (h : b ↔ c) : a ∧ b ↔ a ∧ c := and_congr .rfl h - -theorem and_congr_right_eq (h : a → b = c) : (a ∧ b) = (a ∧ c) := - propext <| and_congr_right fun hc => h hc ▸ .rfl - -theorem and_congr_left_eq (h : c → a = b) : (a ∧ c) = (b ∧ c) := - propext <| and_congr_left fun hc => h hc ▸ .rfl - -theorem and_assoc : (a ∧ b) ∧ c ↔ a ∧ (b ∧ c) := - ⟨fun ⟨⟨ha, hb⟩, hc⟩ => ⟨ha, hb, hc⟩, fun ⟨ha, hb, hc⟩ => ⟨⟨ha, hb⟩, hc⟩⟩ - -theorem and_left_comm : a ∧ (b ∧ c) ↔ b ∧ (a ∧ c) := by - rw [← and_assoc, ← and_assoc, @and_comm a b] - -theorem and_right_comm : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b := by - simp only [and_left_comm, and_comm] - -theorem and_rotate : a ∧ b ∧ c ↔ b ∧ c ∧ a := by - simp only [and_left_comm, and_comm] - -theorem and_and_and_comm : (a ∧ b) ∧ c ∧ d ↔ (a ∧ c) ∧ b ∧ d := by - rw [← and_assoc, @and_right_comm a, and_assoc] - -theorem and_and_left : a ∧ b ∧ c ↔ (a ∧ b) ∧ a ∧ c := by - rw [and_and_and_comm, and_self] - -theorem and_and_right : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b ∧ c := by - rw [and_and_and_comm, and_self] - -theorem and_iff_left_of_imp (h : a → b) : (a ∧ b) ↔ a := - ⟨And.left, fun ha => ⟨ha, h ha⟩⟩ - -theorem and_iff_right_of_imp (h : b → a) : (a ∧ b) ↔ b := - ⟨And.right, fun hb => ⟨h hb, hb⟩⟩ - -theorem and_iff_left (hb : b) : a ∧ b ↔ a := and_iff_left_of_imp fun _ => hb - -theorem and_iff_right (ha : a) : a ∧ b ↔ b := and_iff_right_of_imp fun _ => ha - -@[simp] theorem and_iff_left_iff_imp : ((a ∧ b) ↔ a) ↔ (a → b) := - ⟨fun h ha => (h.2 ha).2, and_iff_left_of_imp⟩ - -@[simp] theorem and_iff_right_iff_imp : ((a ∧ b) ↔ b) ↔ (b → a) := - ⟨fun h ha => (h.2 ha).1, and_iff_right_of_imp⟩ - -@[simp] theorem iff_self_and : (p ↔ p ∧ q) ↔ (p → q) := by - rw [@Iff.comm p, and_iff_left_iff_imp] - -@[simp] theorem iff_and_self : (p ↔ q ∧ p) ↔ (p → q) := by rw [and_comm, iff_self_and] - -@[simp] theorem and_congr_right_iff : (a ∧ b ↔ a ∧ c) ↔ (a → (b ↔ c)) := - ⟨fun h ha => by simp [ha] at h; exact h, and_congr_right⟩ - -@[simp] theorem and_congr_left_iff : (a ∧ c ↔ b ∧ c) ↔ c → (a ↔ b) := by - simp only [and_comm, ← and_congr_right_iff] - -@[simp] theorem and_self_left : a ∧ a ∧ b ↔ a ∧ b := - ⟨fun h => ⟨h.1, h.2.2⟩, fun h => ⟨h.1, h.1, h.2⟩⟩ - -@[simp] theorem and_self_right : (a ∧ b) ∧ b ↔ a ∧ b := - ⟨fun h => ⟨h.1.1, h.2⟩, fun h => ⟨⟨h.1, h.2⟩, h.2⟩⟩ - -theorem not_and_of_not_left (b : Prop) : ¬a → ¬(a ∧ b) := mt And.left - -theorem not_and_of_not_right (a : Prop) {b : Prop} : ¬b → ¬(a ∧ b) := mt And.right - -@[simp] theorem and_not_self : ¬(a ∧ ¬a) | ⟨ha, hn⟩ => hn ha - -@[simp] theorem not_and_self : ¬(¬a ∧ a) | ⟨hn, ha⟩ => hn ha - -theorem and_not_self_iff (a : Prop) : a ∧ ¬a ↔ False := iff_false_intro and_not_self - -theorem not_and_self_iff (a : Prop) : ¬a ∧ a ↔ False := iff_false_intro not_and_self - -/-! ## or -/ - -theorem not_not_em (a : Prop) : ¬¬(a ∨ ¬a) := fun h => h (.inr (h ∘ .inl)) - --- TODO: rename or_self to or_self_eq -theorem or_self_iff : a ∨ a ↔ a := or_self _ ▸ .rfl - -theorem Or.symm : a ∨ b → b ∨ a := .rec .inr .inl - -theorem Or.imp (f : a → c) (g : b → d) (h : a ∨ b) : c ∨ d := h.elim (inl ∘ f) (inr ∘ g) - -theorem Or.imp_left (f : a → b) : a ∨ c → b ∨ c := .imp f id - -theorem Or.imp_right (f : b → c) : a ∨ b → a ∨ c := .imp id f - -theorem or_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a ∨ b) ↔ (c ∨ d) := ⟨.imp h₁.1 h₂.1, .imp h₁.2 h₂.2⟩ - -theorem or_congr_left (h : a ↔ b) : a ∨ c ↔ b ∨ c := or_congr h .rfl - -theorem or_congr_right (h : b ↔ c) : a ∨ b ↔ a ∨ c := or_congr .rfl h - -theorem Or.comm : a ∨ b ↔ b ∨ a := ⟨Or.symm, Or.symm⟩ - -theorem or_comm : a ∨ b ↔ b ∨ a := Or.comm - -theorem or_assoc : (a ∨ b) ∨ c ↔ a ∨ (b ∨ c) := - ⟨.rec (.imp_right .inl) (.inr ∘ .inr), .rec (.inl ∘ .inl) (.imp_left .inr)⟩ - -theorem Or.resolve_left {a b : Prop} (h: a ∨ b) (na : ¬a) : b := h.elim (absurd · na) id - -theorem Or.neg_resolve_left (h : ¬a ∨ b) (ha : a) : b := h.elim (absurd ha) id - -theorem Or.resolve_right {a b : Prop} (h: a ∨ b) (nb : ¬b) : a := h.elim id (absurd · nb) - -theorem Or.neg_resolve_right (h : a ∨ ¬b) (nb : b) : a := h.elim id (absurd nb) - -theorem or_left_comm : a ∨ (b ∨ c) ↔ b ∨ (a ∨ c) := by rw [← or_assoc, ← or_assoc, @or_comm a b] - -theorem or_right_comm : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b := by rw [or_assoc, or_assoc, @or_comm b] - -theorem or_or_or_comm : (a ∨ b) ∨ c ∨ d ↔ (a ∨ c) ∨ b ∨ d := by - rw [← or_assoc, @or_right_comm a, or_assoc] - -theorem or_or_distrib_left : a ∨ b ∨ c ↔ (a ∨ b) ∨ a ∨ c := by rw [or_or_or_comm, or_self] - -theorem or_or_distrib_right : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b ∨ c := by rw [or_or_or_comm, or_self] - -theorem or_rotate : a ∨ b ∨ c ↔ b ∨ c ∨ a := by simp only [or_left_comm, Or.comm] - -theorem or_iff_right_of_imp (ha : a → b) : (a ∨ b) ↔ b := ⟨Or.rec ha id, .inr⟩ - -theorem or_iff_left_of_imp (hb : b → a) : (a ∨ b) ↔ a := ⟨Or.rec id hb, .inl⟩ - -theorem not_or_intro {a b : Prop} (ha : ¬a) (hb : ¬b) : ¬(a ∨ b) := (·.elim ha hb) - -@[simp] theorem or_iff_left_iff_imp : (a ∨ b ↔ a) ↔ (b → a) := - ⟨fun h hb => h.1 (Or.inr hb), or_iff_left_of_imp⟩ - -@[simp] theorem or_iff_right_iff_imp : (a ∨ b ↔ b) ↔ (a → b) := by - rw [or_comm, or_iff_left_iff_imp] - -theorem or_iff_left (hb : ¬b) : a ∨ b ↔ a := or_iff_left_iff_imp.2 hb.elim - -theorem or_iff_right (ha : ¬a) : a ∨ b ↔ b := or_iff_right_iff_imp.2 ha.elim - -/-! ## distributivity -/ - -theorem not_imp_of_and_not : a ∧ ¬b → ¬(a → b) - | ⟨ha, hb⟩, h => hb <| h ha - -theorem imp_and {α} : (α → b ∧ c) ↔ (α → b) ∧ (α → c) := - ⟨fun h => ⟨fun ha => (h ha).1, fun ha => (h ha).2⟩, fun h ha => ⟨h.1 ha, h.2 ha⟩⟩ - -@[simp] theorem and_imp : (a ∧ b → c) ↔ (a → b → c) := - ⟨fun h ha hb => h ⟨ha, hb⟩, fun h ⟨ha, hb⟩ => h ha hb⟩ - -@[simp] theorem not_and : ¬(a ∧ b) ↔ (a → ¬b) := and_imp - -theorem not_and' : ¬(a ∧ b) ↔ b → ¬a := not_and.trans imp_not_comm - -/-- `∧` distributes over `∨` (on the left). -/ -theorem and_or_left : a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) := - ⟨fun ⟨ha, hbc⟩ => hbc.imp (.intro ha) (.intro ha), Or.rec (.imp_right .inl) (.imp_right .inr)⟩ - -/-- `∧` distributes over `∨` (on the right). -/ -theorem or_and_right : (a ∨ b) ∧ c ↔ (a ∧ c) ∨ (b ∧ c) := by - simp [and_comm, and_or_left] - -/-- `∨` distributes over `∧` (on the left). -/ -theorem or_and_left : a ∨ (b ∧ c) ↔ (a ∨ b) ∧ (a ∨ c) := - ⟨Or.rec (fun ha => ⟨.inl ha, .inl ha⟩) (.imp .inr .inr), - And.rec <| .rec (fun _ => .inl ·) (.imp_right ∘ .intro)⟩ - -/-- `∨` distributes over `∧` (on the right). -/ -theorem and_or_right : (a ∧ b) ∨ c ↔ (a ∨ c) ∧ (b ∨ c) := by - simp [or_comm, or_and_left] - -theorem or_imp : (a ∨ b → c) ↔ (a → c) ∧ (b → c) := - ⟨fun h => ⟨h ∘ .inl, h ∘ .inr⟩, fun ⟨ha, hb⟩ => Or.rec ha hb⟩ - -theorem not_or : ¬(p ∨ q) ↔ ¬p ∧ ¬q := or_imp - -theorem not_and_of_not_or_not (h : ¬a ∨ ¬b) : ¬(a ∧ b) := h.elim (mt (·.1)) (mt (·.2)) - -@[simp] theorem or_self_left : a ∨ a ∨ b ↔ a ∨ b := ⟨.rec .inl id, .rec .inl (.inr ∘ .inr)⟩ - -@[simp] theorem or_self_right : (a ∨ b) ∨ b ↔ a ∨ b := ⟨.rec id .inr, .rec (.inl ∘ .inl) .inr⟩ - /-! ## exists and forall -/ -section quantifiers -variable {p q : α → Prop} {b : Prop} - -theorem forall_imp (h : ∀ a, p a → q a) : (∀ a, p a) → ∀ a, q a := -fun h' a => h a (h' a) - -@[simp] theorem forall_exists_index {q : (∃ x, p x) → Prop} : - (∀ h, q h) ↔ ∀ x (h : p x), q ⟨x, h⟩ := - ⟨fun h x hpx => h ⟨x, hpx⟩, fun h ⟨x, hpx⟩ => h x hpx⟩ - -theorem Exists.imp (h : ∀ a, p a → q a) : (∃ a, p a) → ∃ a, q a - | ⟨a, hp⟩ => ⟨a, h a hp⟩ - -theorem Exists.imp' {β} {q : β → Prop} (f : α → β) (hpq : ∀ a, p a → q (f a)) : - (∃ a, p a) → ∃ b, q b - | ⟨_, hp⟩ => ⟨_, hpq _ hp⟩ - -theorem exists_imp : ((∃ x, p x) → b) ↔ ∀ x, p x → b := forall_exists_index - -@[simp] theorem exists_const (α) [i : Nonempty α] : (∃ _ : α, b) ↔ b := - ⟨fun ⟨_, h⟩ => h, i.elim Exists.intro⟩ - -section forall_congr - --- Port note: this is `forall_congr` from Lean 3. In Lean 4, there is already something --- with that name and a slightly different type. -theorem forall_congr' (h : ∀ a, p a ↔ q a) : (∀ a, p a) ↔ ∀ a, q a := - ⟨fun H a => (h a).1 (H a), fun H a => (h a).2 (H a)⟩ - -theorem exists_congr (h : ∀ a, p a ↔ q a) : (∃ a, p a) ↔ ∃ a, q a := - ⟨Exists.imp fun x => (h x).1, Exists.imp fun x => (h x).2⟩ - -variable {β : α → Sort _} -theorem forall₂_congr {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) : - (∀ a b, p a b) ↔ ∀ a b, q a b := - forall_congr' fun a => forall_congr' <| h a - -theorem exists₂_congr {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) : - (∃ a b, p a b) ↔ ∃ a b, q a b := - exists_congr fun a => exists_congr <| h a - -variable {γ : ∀ a, β a → Sort _} -theorem forall₃_congr {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) : - (∀ a b c, p a b c) ↔ ∀ a b c, q a b c := - forall_congr' fun a => forall₂_congr <| h a - -theorem exists₃_congr {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) : - (∃ a b c, p a b c) ↔ ∃ a b c, q a b c := - exists_congr fun a => exists₂_congr <| h a - -variable {δ : ∀ a b, γ a b → Sort _} -theorem forall₄_congr {p q : ∀ a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) : - (∀ a b c d, p a b c d) ↔ ∀ a b c d, q a b c d := - forall_congr' fun a => forall₃_congr <| h a - -theorem exists₄_congr {p q : ∀ a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) : - (∃ a b c d, p a b c d) ↔ ∃ a b c d, q a b c d := - exists_congr fun a => exists₃_congr <| h a - -variable {ε : ∀ a b c, δ a b c → Sort _} -theorem forall₅_congr {p q : ∀ a b c d, ε a b c d → Prop} - (h : ∀ a b c d e, p a b c d e ↔ q a b c d e) : - (∀ a b c d e, p a b c d e) ↔ ∀ a b c d e, q a b c d e := - forall_congr' fun a => forall₄_congr <| h a - -theorem exists₅_congr {p q : ∀ a b c d, ε a b c d → Prop} - (h : ∀ a b c d e, p a b c d e ↔ q a b c d e) : - (∃ a b c d e, p a b c d e) ↔ ∃ a b c d e, q a b c d e := - exists_congr fun a => exists₄_congr <| h a - -end forall_congr - -@[simp] theorem not_exists : (¬∃ x, p x) ↔ ∀ x, ¬p x := exists_imp - alias ⟨forall_not_of_not_exists, not_exists_of_forall_not⟩ := not_exists -theorem forall_and : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := - ⟨fun h => ⟨fun x => (h x).1, fun x => (h x).2⟩, fun ⟨h₁, h₂⟩ x => ⟨h₁ x, h₂ x⟩⟩ - -theorem exists_or : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ ∃ x, q x := - ⟨fun | ⟨x, .inl h⟩ => .inl ⟨x, h⟩ | ⟨x, .inr h⟩ => .inr ⟨x, h⟩, - fun | .inl ⟨x, h⟩ => ⟨x, .inl h⟩ | .inr ⟨x, h⟩ => ⟨x, .inr h⟩⟩ - -@[simp] theorem exists_false : ¬(∃ _a : α, False) := fun ⟨_, h⟩ => h - -@[simp] theorem forall_const (α : Sort _) [i : Nonempty α] : (α → b) ↔ b := - ⟨i.elim, fun hb _ => hb⟩ - -theorem Exists.nonempty : (∃ x, p x) → Nonempty α | ⟨x, _⟩ => ⟨x⟩ - -/-- Extract an element from a existential statement, using `Classical.choose`. -/ --- This enables projection notation. -@[reducible] noncomputable def Exists.choose (P : ∃ a, p a) : α := Classical.choose P - -/-- Show that an element extracted from `P : ∃ a, p a` using `P.choose` satisfies `p`. -/ -theorem Exists.choose_spec {p : α → Prop} (P : ∃ a, p a) : p P.choose := Classical.choose_spec P - -theorem not_forall_of_exists_not {p : α → Prop} : (∃ x, ¬p x) → ¬∀ x, p x - | ⟨x, hn⟩, h => hn (h x) - -@[simp] theorem forall_eq {p : α → Prop} {a' : α} : (∀ a, a = a' → p a) ↔ p a' := - ⟨fun h => h a' rfl, fun h _ e => e.symm ▸ h⟩ - -@[simp] theorem forall_eq' {a' : α} : (∀ a, a' = a → p a) ↔ p a' := by simp [@eq_comm _ a'] - -@[simp] theorem exists_eq : ∃ a, a = a' := ⟨_, rfl⟩ - -@[simp] theorem exists_eq' : ∃ a, a' = a := ⟨_, rfl⟩ - -@[simp] theorem exists_eq_left : (∃ a, a = a' ∧ p a) ↔ p a' := - ⟨fun ⟨_, e, h⟩ => e ▸ h, fun h => ⟨_, rfl, h⟩⟩ - -@[simp] theorem exists_eq_right : (∃ a, p a ∧ a = a') ↔ p a' := - (exists_congr <| by exact fun a => And.comm).trans exists_eq_left - -@[simp] theorem exists_and_left : (∃ x, b ∧ p x) ↔ b ∧ (∃ x, p x) := - ⟨fun ⟨x, h, hp⟩ => ⟨h, x, hp⟩, fun ⟨h, x, hp⟩ => ⟨x, h, hp⟩⟩ - -@[simp] theorem exists_and_right : (∃ x, p x ∧ b) ↔ (∃ x, p x) ∧ b := by simp [And.comm] - -@[simp] theorem exists_eq_left' : (∃ a, a' = a ∧ p a) ↔ p a' := by simp [@eq_comm _ a'] - --- this theorem is needed to simplify the output of `List.mem_cons_iff` -@[simp] theorem forall_eq_or_imp : (∀ a, a = a' ∨ q a → p a) ↔ p a' ∧ ∀ a, q a → p a := by - simp only [or_imp, forall_and, forall_eq] - -@[simp] theorem exists_eq_or_imp : (∃ a, (a = a' ∨ q a) ∧ p a) ↔ p a' ∨ ∃ a, q a ∧ p a := by - simp only [or_and_right, exists_or, exists_eq_left] - -@[simp] theorem exists_eq_right_right : (∃ (a : α), p a ∧ q a ∧ a = a') ↔ p a' ∧ q a' := by - simp [← and_assoc] - -@[simp] theorem exists_eq_right_right' : (∃ (a : α), p a ∧ q a ∧ a' = a) ↔ p a' ∧ q a' := by - (conv in _=_ => rw [eq_comm]); simp - -@[simp] theorem exists_prop : (∃ _h : a, b) ↔ a ∧ b := - ⟨fun ⟨hp, hq⟩ => ⟨hp, hq⟩, fun ⟨hp, hq⟩ => ⟨hp, hq⟩⟩ - -@[simp] theorem exists_apply_eq_apply (f : α → β) (a' : α) : ∃ a, f a = f a' := ⟨a', rfl⟩ - -theorem forall_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∀ h' : p, q h') ↔ q h := - @forall_const (q h) p ⟨h⟩ - -theorem forall_comm {p : α → β → Prop} : (∀ a b, p a b) ↔ (∀ b a, p a b) := - ⟨fun h b a => h a b, fun h a b => h b a⟩ - -theorem exists_comm {p : α → β → Prop} : (∃ a b, p a b) ↔ (∃ b a, p a b) := - ⟨fun ⟨a, b, h⟩ => ⟨b, a, h⟩, fun ⟨b, a, h⟩ => ⟨a, b, h⟩⟩ - -@[simp] theorem forall_apply_eq_imp_iff {f : α → β} {p : β → Prop} : - (∀ b a, f a = b → p b) ↔ ∀ a, p (f a) := by simp [forall_comm] - -@[simp] theorem forall_eq_apply_imp_iff {f : α → β} {p : β → Prop} : - (∀ b a, b = f a → p b) ↔ ∀ a, p (f a) := by simp [forall_comm] - -@[simp] theorem forall_apply_eq_imp_iff₂ {f : α → β} {p : α → Prop} {q : β → Prop} : - (∀ b a, p a → f a = b → q b) ↔ ∀ a, p a → q (f a) := - ⟨fun h a ha => h (f a) a ha rfl, fun h _ a ha hb => hb ▸ h a ha⟩ - -theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬p) : (∀ h' : p, q h') ↔ True := - iff_true_intro fun h => hn.elim h - -end quantifiers - /-! ## decidable -/ -theorem Decidable.not_not [Decidable p] : ¬¬p ↔ p := ⟨of_not_not, not_not_intro⟩ - -theorem Decidable.by_contra [Decidable p] : (¬p → False) → p := of_not_not - -/-- Construct a non-Prop by cases on an `Or`, when the left conjunct is decidable. -/ -protected def Or.by_cases [Decidable p] {α : Sort u} (h : p ∨ q) (h₁ : p → α) (h₂ : q → α) : α := - if hp : p then h₁ hp else h₂ (h.resolve_left hp) - -/-- Construct a non-Prop by cases on an `Or`, when the right conjunct is decidable. -/ -protected def Or.by_cases' [Decidable q] {α : Sort u} (h : p ∨ q) (h₁ : p → α) (h₂ : q → α) : α := - if hq : q then h₂ hq else h₁ (h.resolve_right hq) - -instance exists_prop_decidable {p} (P : p → Prop) - [Decidable p] [∀ h, Decidable (P h)] : Decidable (∃ h, P h) := -if h : p then - decidable_of_decidable_of_iff ⟨fun h2 => ⟨h, h2⟩, fun ⟨_, h2⟩ => h2⟩ -else isFalse fun ⟨h', _⟩ => h h' - -instance forall_prop_decidable {p} (P : p → Prop) - [Decidable p] [∀ h, Decidable (P h)] : Decidable (∀ h, P h) := -if h : p then - decidable_of_decidable_of_iff ⟨fun h2 _ => h2, fun al => al h⟩ -else isTrue fun h2 => absurd h2 h - -theorem decide_eq_true_iff (p : Prop) [Decidable p] : (decide p = true) ↔ p := by simp - -@[simp] theorem decide_eq_false_iff_not (p : Prop) {_ : Decidable p} : (decide p = false) ↔ ¬p := - ⟨of_decide_eq_false, decide_eq_false⟩ - -@[simp] theorem decide_eq_decide {p q : Prop} {_ : Decidable p} {_ : Decidable q} : - decide p = decide q ↔ (p ↔ q) := - ⟨fun h => by rw [← decide_eq_true_iff p, h, decide_eq_true_iff], fun h => by simp [h]⟩ - -theorem Decidable.of_not_imp [Decidable a] (h : ¬(a → b)) : a := - byContradiction (not_not_of_not_imp h) - -theorem Decidable.not_imp_symm [Decidable a] (h : ¬a → b) (hb : ¬b) : a := - byContradiction <| hb ∘ h - -theorem Decidable.not_imp_comm [Decidable a] [Decidable b] : (¬a → b) ↔ (¬b → a) := - ⟨not_imp_symm, not_imp_symm⟩ - -theorem Decidable.not_imp_self [Decidable a] : (¬a → a) ↔ a := by - have := @imp_not_self (¬a); rwa [not_not] at this - -theorem Decidable.or_iff_not_imp_left [Decidable a] : a ∨ b ↔ (¬a → b) := - ⟨Or.resolve_left, fun h => dite _ .inl (.inr ∘ h)⟩ - -theorem Decidable.or_iff_not_imp_right [Decidable b] : a ∨ b ↔ (¬b → a) := -or_comm.trans or_iff_not_imp_left - -theorem Decidable.not_imp_not [Decidable a] : (¬a → ¬b) ↔ (b → a) := -⟨fun h hb => byContradiction (h · hb), mt⟩ - -theorem Decidable.not_or_of_imp [Decidable a] (h : a → b) : ¬a ∨ b := - if ha : a then .inr (h ha) else .inl ha - -theorem Decidable.imp_iff_not_or [Decidable a] : (a → b) ↔ (¬a ∨ b) := - ⟨not_or_of_imp, Or.neg_resolve_left⟩ - -theorem Decidable.imp_iff_or_not [Decidable b] : b → a ↔ a ∨ ¬b := - Decidable.imp_iff_not_or.trans or_comm - -theorem Decidable.imp_or [Decidable a] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) := by - by_cases a <;> simp_all - -theorem Decidable.imp_or' [Decidable b] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) := - if h : b then by simp [h] else by - rw [eq_false h, false_or]; exact (or_iff_right_of_imp fun hx x => (hx x).elim).symm - -theorem Decidable.not_imp_iff_and_not [Decidable a] : ¬(a → b) ↔ a ∧ ¬b := - ⟨fun h => ⟨of_not_imp h, not_of_not_imp h⟩, not_imp_of_and_not⟩ - -theorem Decidable.peirce (a b : Prop) [Decidable a] : ((a → b) → a) → a := - if ha : a then fun _ => ha else fun h => h ha.elim - -theorem peirce' {a : Prop} (H : ∀ b : Prop, (a → b) → a) : a := H _ id - -theorem Decidable.not_iff_not [Decidable a] [Decidable b] : (¬a ↔ ¬b) ↔ (a ↔ b) := by - rw [@iff_def (¬a), @iff_def' a]; exact and_congr not_imp_not not_imp_not - -theorem Decidable.not_iff_comm [Decidable a] [Decidable b] : (¬a ↔ b) ↔ (¬b ↔ a) := by - rw [@iff_def (¬a), @iff_def (¬b)]; exact and_congr not_imp_comm imp_not_comm - -theorem Decidable.not_iff [Decidable b] : ¬(a ↔ b) ↔ (¬a ↔ b) := by - by_cases h : b <;> simp [h, iff_true, iff_false] - -theorem Decidable.iff_not_comm [Decidable a] [Decidable b] : (a ↔ ¬b) ↔ (b ↔ ¬a) := by - rw [@iff_def a, @iff_def b]; exact and_congr imp_not_comm not_imp_comm - -theorem Decidable.iff_iff_and_or_not_and_not {a b : Prop} [Decidable b] : - (a ↔ b) ↔ (a ∧ b) ∨ (¬a ∧ ¬b) := - ⟨fun e => if h : b then .inl ⟨e.2 h, h⟩ else .inr ⟨mt e.1 h, h⟩, - Or.rec (And.rec iff_of_true) (And.rec iff_of_false)⟩ - -theorem Decidable.iff_iff_not_or_and_or_not [Decidable a] [Decidable b] : - (a ↔ b) ↔ (¬a ∨ b) ∧ (a ∨ ¬b) := by - rw [iff_iff_implies_and_implies a b]; simp only [imp_iff_not_or, Or.comm] - -theorem Decidable.not_and_not_right [Decidable b] : ¬(a ∧ ¬b) ↔ (a → b) := - ⟨fun h ha => not_imp_symm (And.intro ha) h, fun h ⟨ha, hb⟩ => hb <| h ha⟩ - -theorem Decidable.not_and_iff_or_not_not [Decidable a] : ¬(a ∧ b) ↔ ¬a ∨ ¬b := - ⟨fun h => if ha : a then .inr (h ⟨ha, ·⟩) else .inl ha, not_and_of_not_or_not⟩ - -theorem Decidable.not_and_iff_or_not_not' [Decidable b] : ¬(a ∧ b) ↔ ¬a ∨ ¬b := - ⟨fun h => if hb : b then .inl (h ⟨·, hb⟩) else .inr hb, not_and_of_not_or_not⟩ - -theorem Decidable.or_iff_not_and_not [Decidable a] [Decidable b] : a ∨ b ↔ ¬(¬a ∧ ¬b) := by - rw [← not_or, not_not] - -theorem Decidable.and_iff_not_or_not [Decidable a] [Decidable b] : a ∧ b ↔ ¬(¬a ∨ ¬b) := by - rw [← not_and_iff_or_not_not, not_not] - -theorem Decidable.imp_iff_right_iff [Decidable a] : (a → b ↔ b) ↔ a ∨ b := - ⟨fun H => (Decidable.em a).imp_right fun ha' => H.1 fun ha => (ha' ha).elim, - fun H => H.elim imp_iff_right fun hb => iff_of_true (fun _ => hb) hb⟩ - -theorem Decidable.and_or_imp [Decidable a] : a ∧ b ∨ (a → c) ↔ a → b ∨ c := - if ha : a then by simp only [ha, true_and, true_imp_iff] - else by simp only [ha, false_or, false_and, false_imp_iff] - -theorem Decidable.or_congr_left' [Decidable c] (h : ¬c → (a ↔ b)) : a ∨ c ↔ b ∨ c := by - rw [or_iff_not_imp_right, or_iff_not_imp_right]; exact imp_congr_right h - -theorem Decidable.or_congr_right' [Decidable a] (h : ¬a → (b ↔ c)) : a ∨ b ↔ a ∨ c := by - rw [or_iff_not_imp_left, or_iff_not_imp_left]; exact imp_congr_right h - -/-- Transfer decidability of `a` to decidability of `b`, if the propositions are equivalent. -**Important**: this function should be used instead of `rw` on `decidable b`, because the -kernel will get stuck reducing the usage of `propext` otherwise, -and `dec_trivial` will not work. -/ -@[inline] def decidable_of_iff (a : Prop) (h : a ↔ b) [Decidable a] : Decidable b := - decidable_of_decidable_of_iff h - -/-- Transfer decidability of `b` to decidability of `a`, if the propositions are equivalent. -This is the same as `decidable_of_iff` but the iff is flipped. -/ -@[inline] def decidable_of_iff' (b : Prop) (h : a ↔ b) [Decidable b] : Decidable a := - decidable_of_decidable_of_iff h.symm - -instance Decidable.predToBool (p : α → Prop) [DecidablePred p] : - CoeDep (α → Prop) p (α → Bool) := ⟨fun b => decide <| p b⟩ - -/-- Prove that `a` is decidable by constructing a boolean `b` and a proof that `b ↔ a`. -(This is sometimes taken as an alternate definition of decidability.) -/ -def decidable_of_bool : ∀ (b : Bool), (b ↔ a) → Decidable a - | true, h => isTrue (h.1 rfl) - | false, h => isFalse (mt h.2 Bool.noConfusion) - -protected theorem Decidable.not_forall {p : α → Prop} [Decidable (∃ x, ¬p x)] - [∀ x, Decidable (p x)] : (¬∀ x, p x) ↔ ∃ x, ¬p x := - ⟨Decidable.not_imp_symm fun nx x => Decidable.not_imp_symm (fun h => ⟨x, h⟩) nx, - not_forall_of_exists_not⟩ - protected alias ⟨Decidable.exists_not_of_not_forall, _⟩ := Decidable.not_forall -protected theorem Decidable.not_forall_not {p : α → Prop} [Decidable (∃ x, p x)] : - (¬∀ x, ¬p x) ↔ ∃ x, p x := - (@Decidable.not_iff_comm _ _ _ (decidable_of_iff (¬∃ x, p x) not_exists)).1 not_exists - -protected theorem Decidable.not_exists_not {p : α → Prop} [∀ x, Decidable (p x)] : - (¬∃ x, ¬p x) ↔ ∀ x, p x := by - simp only [not_exists, Decidable.not_not] - /-! ## classical logic -/ namespace Classical -/-- The Double Negation Theorem: `¬¬P` is equivalent to `P`. -The left-to-right direction, double negation elimination (DNE), -is classically true but not constructively. -/ -@[scoped simp] theorem not_not : ¬¬a ↔ a := Decidable.not_not - -@[simp] theorem not_forall {p : α → Prop} : (¬∀ x, p x) ↔ ∃ x, ¬p x := - Decidable.not_forall - alias ⟨exists_not_of_not_forall, _⟩ := not_forall -theorem not_forall_not {p : α → Prop} : (¬∀ x, ¬p x) ↔ ∃ x, p x := Decidable.not_forall_not - -theorem not_exists_not {p : α → Prop} : (¬∃ x, ¬p x) ↔ ∀ x, p x := Decidable.not_exists_not - -theorem forall_or_exists_not (P : α → Prop) : (∀ a, P a) ∨ ∃ a, ¬ P a := by - rw [← not_forall]; exact em _ - -theorem exists_or_forall_not (P : α → Prop) : (∃ a, P a) ∨ ∀ a, ¬ P a := by - rw [← not_exists]; exact em _ - -theorem or_iff_not_imp_left : a ∨ b ↔ (¬a → b) := - Decidable.or_iff_not_imp_left - -theorem or_iff_not_imp_right : a ∨ b ↔ (¬b → a) := - Decidable.or_iff_not_imp_right - -theorem not_imp_iff_and_not : ¬(a → b) ↔ a ∧ ¬b := - Decidable.not_imp_iff_and_not - -theorem not_and_iff_or_not_not : ¬(a ∧ b) ↔ ¬a ∨ ¬b := - Decidable.not_and_iff_or_not_not - -theorem not_iff : ¬(a ↔ b) ↔ (¬a ↔ b) := - Decidable.not_iff - end Classical /-! ## equality -/ @@ -824,92 +123,11 @@ theorem ne_of_mem_of_not_mem' (h : a ∈ s) : a ∉ t → s ≠ t := mt fun e => end Mem -/-! ## if-then-else -/ - -@[simp] theorem if_true {h : Decidable True} (t e : α) : ite True t e = t := if_pos trivial - -@[simp] theorem if_false {h : Decidable False} (t e : α) : ite False t e = e := if_neg id - -theorem ite_id [Decidable c] {α} (t : α) : (if c then t else t) = t := by split <;> rfl - -/-- A function applied to a `dite` is a `dite` of that function applied to each of the branches. -/ -theorem apply_dite (f : α → β) (P : Prop) [Decidable P] (x : P → α) (y : ¬P → α) : - f (dite P x y) = dite P (fun h => f (x h)) (fun h => f (y h)) := by - by_cases h : P <;> simp [h] - -/-- A function applied to a `ite` is a `ite` of that function applied to each of the branches. -/ -theorem apply_ite (f : α → β) (P : Prop) [Decidable P] (x y : α) : - f (ite P x y) = ite P (f x) (f y) := - apply_dite f P (fun _ => x) (fun _ => y) - -/-- Negation of the condition `P : Prop` in a `dite` is the same as swapping the branches. -/ -@[simp] theorem dite_not (P : Prop) {_ : Decidable P} (x : ¬P → α) (y : ¬¬P → α) : - dite (¬P) x y = dite P (fun h => y (not_not_intro h)) x := by - by_cases h : P <;> simp [h] - -/-- Negation of the condition `P : Prop` in a `ite` is the same as swapping the branches. -/ -@[simp] theorem ite_not (P : Prop) {_ : Decidable P} (x y : α) : ite (¬P) x y = ite P y x := - dite_not P (fun _ => x) (fun _ => y) - -@[simp] theorem dite_eq_left_iff {P : Prop} [Decidable P] {B : ¬ P → α} : - dite P (fun _ => a) B = a ↔ ∀ h, B h = a := by - by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false] - -@[simp] theorem dite_eq_right_iff {P : Prop} [Decidable P] {A : P → α} : - (dite P A fun _ => b) = b ↔ ∀ h, A h = b := by - by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false] - -@[simp] theorem ite_eq_left_iff {P : Prop} [Decidable P] : ite P a b = a ↔ ¬P → b = a := - dite_eq_left_iff - -@[simp] theorem ite_eq_right_iff {P : Prop} [Decidable P] : ite P a b = b ↔ P → a = b := - dite_eq_right_iff - -/-- A `dite` whose results do not actually depend on the condition may be reduced to an `ite`. -/ -@[simp] theorem dite_eq_ite [Decidable P] : (dite P (fun _ => a) fun _ => b) = ite P a b := rfl - --- We don't mark this as `simp` as it is already handled by `ite_eq_right_iff`. -theorem ite_some_none_eq_none [Decidable P] : - (if P then some x else none) = none ↔ ¬ P := by - simp only [ite_eq_right_iff] - -@[simp] theorem ite_some_none_eq_some [Decidable P] : - (if P then some x else none) = some y ↔ P ∧ x = y := by - split <;> simp_all - /-! ## miscellaneous -/ -attribute [simp] inline - -/-- Ex falso, the nondependent eliminator for the `Empty` type. -/ -def Empty.elim : Empty → C := nofun - -instance : Subsingleton Empty := ⟨fun a => a.elim⟩ - -instance : DecidableEq Empty := fun a => a.elim - -/-- Ex falso, the nondependent eliminator for the `PEmpty` type. -/ -def PEmpty.elim : PEmpty → C := nofun - -instance : Subsingleton PEmpty := ⟨fun a => a.elim⟩ - -instance : DecidableEq PEmpty := fun a => a.elim - -@[simp] theorem not_nonempty_empty : ¬Nonempty Empty := fun ⟨h⟩ => h.elim - +@[simp] theorem not_nonempty_empty : ¬Nonempty Empty := fun ⟨h⟩ => h.elim @[simp] theorem not_nonempty_pempty : ¬Nonempty PEmpty := fun ⟨h⟩ => h.elim -instance [Subsingleton α] [Subsingleton β] : Subsingleton (α × β) := - ⟨fun {..} {..} => by congr <;> apply Subsingleton.elim⟩ - -instance : Inhabited (Sort _) := ⟨PUnit⟩ - -instance : Inhabited default := ⟨PUnit.unit⟩ - -instance {α β} [Inhabited α] : Inhabited (PSum α β) := ⟨PSum.inl default⟩ - -instance {α β} [Inhabited β] : Inhabited (PSum α β) := ⟨PSum.inr default⟩ - -- TODO(Mario): profile first, this is a dangerous instance -- instance (priority := 10) {α} [Subsingleton α] : DecidableEq α -- | a, b => isTrue (Subsingleton.elim a b) @@ -925,14 +143,5 @@ theorem subsingleton_of_forall_eq (x : α) (h : ∀ y, y = x) : Subsingleton α theorem subsingleton_iff_forall_eq (x : α) : Subsingleton α ↔ ∀ y, y = x := ⟨fun _ y => Subsingleton.elim y x, subsingleton_of_forall_eq x⟩ -example [Subsingleton α] (p : α → Prop) : Subsingleton (Subtype p) := - ⟨fun ⟨x, _⟩ ⟨y, _⟩ => by congr; exact Subsingleton.elim x y⟩ - -theorem false_ne_true : False ≠ True := fun h => h.symm ▸ trivial - -theorem Bool.eq_iff_iff {a b : Bool} : a = b ↔ (a ↔ b) := by cases b <;> simp - -theorem ne_comm {α} {a b : α} : a ≠ b ↔ b ≠ a := ⟨Ne.symm, Ne.symm⟩ - theorem congr_eqRec {β : α → Sort _} (f : (x : α) → β x → γ) (h : x = x') (y : β x) : f x' (Eq.rec y h) = f x y := by cases h; rfl diff --git a/Std/Tactic/Init.lean b/Std/Tactic/Init.lean index a5d48c902b..a69482d355 100644 --- a/Std/Tactic/Init.lean +++ b/Std/Tactic/Init.lean @@ -73,41 +73,6 @@ If `p` is a negation `¬q` then the goal is changed to `⊢ q` instead. macro "absurd " h:term : tactic => `(tactic| first | refine absurd ?_ $h | refine absurd $h ?_) -/-- -`iterate n tac` runs `tac` exactly `n` times. -`iterate tac` runs `tac` repeatedly until failure. - -To run multiple tactics, one can do `iterate (tac₁; tac₂; ⋯)` or -```lean -iterate - tac₁ - tac₂ - ⋯ -``` --/ -syntax "iterate" (ppSpace num)? ppSpace tacticSeq : tactic -macro_rules - | `(tactic| iterate $seq:tacticSeq) => - `(tactic| try ($seq:tacticSeq); iterate $seq:tacticSeq) - | `(tactic| iterate $n $seq:tacticSeq) => - match n.1.toNat with - | 0 => `(tactic| skip) - | n+1 => `(tactic| ($seq:tacticSeq); iterate $(quote n) $seq:tacticSeq) - -/-- -`repeat' tac` runs `tac` on all of the goals to produce a new list of goals, -then runs `tac` again on all of those goals, and repeats until `tac` fails on all remaining goals. --/ -elab "repeat' " tac:tacticSeq : tactic => do - setGoals (← repeat' (evalTacticAtRaw tac) (← getGoals)) - -/-- -`repeat1' tac` applies `tac` to main goal at least once. If the application succeeds, -the tactic is applied recursively to the generated subgoals until it eventually fails. --/ -elab "repeat1' " tac:tacticSeq : tactic => do - setGoals (← repeat1' (evalTacticAtRaw tac) (← getGoals)) - /-- `subst_eqs` applies `subst` to all equalities in the context as long as it makes progress. -/ elab "subst_eqs" : tactic => Elab.Tactic.liftMetaTactic1 (·.substEqs) diff --git a/Std/Tactic/Omega/Logic.lean b/Std/Tactic/Omega/Logic.lean index 7f699a7731..86a695df0b 100644 --- a/Std/Tactic/Omega/Logic.lean +++ b/Std/Tactic/Omega/Logic.lean @@ -5,7 +5,6 @@ Authors: Scott Morrison -/ import Std.Tactic.Alias -import Std.Logic /-! # Specializations of basic logic lemmas @@ -13,7 +12,7 @@ import Std.Logic These are useful for `omega` while constructing proofs, but not considered generally useful so are hidden in the `Std.Tactic.Omega` namespace. -If you find yourself needing them elsewhere, please move them first to `Std.Logic`. +If you find yourself needing them elsewhere, please move them first to another file. -/ namespace Std.Tactic.Omega diff --git a/Std/Tactic/SolveByElim.lean b/Std/Tactic/SolveByElim.lean index 7983129a3b..522b3558b2 100644 --- a/Std/Tactic/SolveByElim.lean +++ b/Std/Tactic/SolveByElim.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, David Renshaw -/ import Lean.Elab.Tactic.Config +import Lean.Meta.Tactic.Repeat import Std.Data.Sum.Basic import Std.Tactic.LabelAttr import Std.Tactic.Relation.Symm @@ -293,7 +294,7 @@ where if cfg.backtracking then backtrack cfg `Meta.Tactic.solveByElim (applyLemmas cfg lemmas ctx) else - repeat1' (maxIters := cfg.maxDepth) (applyFirstLemma cfg lemmas ctx) + Lean.Meta.repeat1' (maxIters := cfg.maxDepth) (applyFirstLemma cfg lemmas ctx) /-- A `MetaM` analogue of the `apply_rules` user tactic. diff --git a/Std/Tactic/SolveByElim/Backtrack.lean b/Std/Tactic/SolveByElim/Backtrack.lean index 63d36e889a..91f5606b47 100644 --- a/Std/Tactic/SolveByElim/Backtrack.lean +++ b/Std/Tactic/SolveByElim/Backtrack.lean @@ -6,6 +6,7 @@ Authors: Scott Morrison import Std.Control.Nondet.Basic import Std.Data.List.Basic import Std.Lean.Except +import Std.Lean.Meta.Basic /-! # `backtrack` diff --git a/test/isIndependentOf.lean b/test/isIndependentOf.lean index 74348f1d2d..59e9363ad7 100644 --- a/test/isIndependentOf.lean +++ b/test/isIndependentOf.lean @@ -1,3 +1,4 @@ +import Std.Lean.Meta.Basic import Std.Tactic.PermuteGoals import Std.Tactic.GuardMsgs diff --git a/test/lintsimp.lean b/test/lintsimp.lean index 7551bafcdd..43e1f3267e 100644 --- a/test/lintsimp.lean +++ b/test/lintsimp.lean @@ -13,8 +13,8 @@ def h : Nat := 0 run_meta guard (← [``fg, ``fh].anyM fun n => return (← simpNF.test n).isSome) -@[simp] theorem and_comm : a ∧ b ↔ b ∧ a := And.comm -run_meta guard (← simpComm.test ``and_comm).isSome +@[simp] theorem test_and_comm : a ∧ b ↔ b ∧ a := And.comm +run_meta guard (← simpComm.test ``test_and_comm).isSome @[simp] theorem Prod.mk_fst : (a, b).1 = id a := rfl run_meta guard (← simpVarHead.test ``Prod.mk_fst).isSome diff --git a/test/print_prefix.lean b/test/print_prefix.lean index 4446591040..a80badc41b 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -1,14 +1,17 @@ import Std.Tactic.PrintPrefix import Std.Tactic.GuardMsgs +inductive TEmpty : Type /-- -info: Empty : Type -Empty.casesOn : (motive : Empty → Sort u) → (t : Empty) → motive t -Empty.rec : (motive : Empty → Sort u) → (t : Empty) → motive t -Empty.recOn : (motive : Empty → Sort u) → (t : Empty) → motive t +info: TEmpty : Type +TEmpty.casesOn : (motive : TEmpty → Sort u) → (t : TEmpty) → motive t +TEmpty.noConfusion : {P : Sort u} → {v1 v2 : TEmpty} → v1 = v2 → TEmpty.noConfusionType P v1 v2 +TEmpty.noConfusionType : Sort u → TEmpty → TEmpty → Sort u +TEmpty.rec : (motive : TEmpty → Sort u) → (t : TEmpty) → motive t +TEmpty.recOn : (motive : TEmpty → Sort u) → (t : TEmpty) → motive t -/ #guard_msgs in -#print prefix Empty -- Test type that probably won't change much. +#print prefix TEmpty -- Test type that probably won't change much. /-- -/ From 6401f3509945590cf32dfd17900741b7ee2e800d Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 14 Feb 2024 20:02:32 +1100 Subject: [PATCH 029/213] nolint --- Std/Tactic/Init.lean | 3 --- lean-toolchain | 2 +- scripts/nolints.json | 3 ++- 3 files changed, 3 insertions(+), 5 deletions(-) diff --git a/Std/Tactic/Init.lean b/Std/Tactic/Init.lean index a69482d355..7f24240656 100644 --- a/Std/Tactic/Init.lean +++ b/Std/Tactic/Init.lean @@ -73,9 +73,6 @@ If `p` is a negation `¬q` then the goal is changed to `⊢ q` instead. macro "absurd " h:term : tactic => `(tactic| first | refine absurd ?_ $h | refine absurd $h ?_) -/-- `subst_eqs` applies `subst` to all equalities in the context as long as it makes progress. -/ -elab "subst_eqs" : tactic => Elab.Tactic.liftMetaTactic1 (·.substEqs) - /-- `split_ands` applies `And.intro` until it does not make progress. -/ syntax "split_ands" : tactic macro_rules | `(tactic| split_ands) => `(tactic| repeat' refine And.intro ?_ ?_) diff --git a/lean-toolchain b/lean-toolchain index eb9dd73386..fc27481ccd 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4-pr-releases:lean-pr-release-3312 +leanprover/lean4-pr-releases:pr-release-3312 diff --git a/scripts/nolints.json b/scripts/nolints.json index 274f119219..6a1efa2eaf 100644 --- a/scripts/nolints.json +++ b/scripts/nolints.json @@ -42,4 +42,5 @@ ["docBlame", "Std.BitVec.reduceUShiftRight"], ["docBlame", "Std.BitVec.reduceXOr"], ["docBlame", "Std.BitVec.reduceZeroExtend"], - ["docBlame", "Std.BitVec.reduceZeroExtend'"]] \ No newline at end of file + ["docBlame", "Std.BitVec.reduceZeroExtend'"], + ["unusedArguments", "imp_intro"]] From 83abf1a682552290231604ae1ebbdda534f43b23 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Wed, 14 Feb 2024 09:15:38 +0000 Subject: [PATCH 030/213] chore: bump to nightly-2024-02-14 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index fc840ba55a..2d47fabe49 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-13 +leanprover/lean4:nightly-2024-02-14 From bc06d3a0c4416b72e2cbc668bc70006521afc869 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 14 Feb 2024 20:16:44 +1100 Subject: [PATCH 031/213] . --- Std/Logic.lean | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Std/Logic.lean b/Std/Logic.lean index 418b2f5d6c..43a9b31f66 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -10,6 +10,8 @@ import Std.Tactic.Lint.Misc instance {f : α → β} [DecidablePred p] : DecidablePred (p ∘ f) := inferInstanceAs <| DecidablePred fun x => p (f x) +@[deprecated] alias proofIrrel := proof_irrel + /-! ## exists and forall -/ alias ⟨forall_not_of_not_exists, not_exists_of_forall_not⟩ := not_exists From 19ea1af28e0fe4860b2bfb9623492ebf6c572864 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 14 Feb 2024 20:31:42 +1100 Subject: [PATCH 032/213] fixes for nightly-2024-02-14 --- Std.lean | 3 - Std/CodeAction/Misc.lean | 1 + Std/Data/Prod/Lex.lean | 1 - Std/Lean/Meta/Basic.lean | 55 --- Std/Lean/Position.lean | 8 - Std/Tactic/GuardMsgs.lean | 1 + Std/Tactic/Init.lean | 38 --- Std/Tactic/LeftRight.lean | 54 --- Std/Tactic/LibrarySearch.lean | 4 +- Std/Tactic/Omega/Int.lean | 1 - Std/Tactic/Omega/IntList.lean | 1 - Std/Tactic/Omega/MinNatAbs.lean | 1 - Std/Tactic/Replace.lean | 55 --- Std/Tactic/ShowTerm.lean | 4 +- Std/Tactic/SimpTrace.lean | 4 +- Std/Tactic/Simpa.lean | 2 +- Std/Tactic/SolveByElim.lean | 1 + Std/Tactic/SqueezeScope.lean | 3 +- Std/Tactic/TryThis.lean | 582 -------------------------------- test/add_suggestion.lean | 6 +- test/left_right.lean | 7 +- test/replace.lean | 1 - test/tryThis.lean | 4 +- 23 files changed, 20 insertions(+), 817 deletions(-) delete mode 100644 Std/Tactic/LeftRight.lean delete mode 100644 Std/Tactic/Replace.lean delete mode 100644 Std/Tactic/TryThis.lean diff --git a/Std.lean b/Std.lean index 6b737270f4..9756ff2841 100644 --- a/Std.lean +++ b/Std.lean @@ -93,7 +93,6 @@ import Std.Tactic.HaveI import Std.Tactic.Init import Std.Tactic.Instances import Std.Tactic.LabelAttr -import Std.Tactic.LeftRight import Std.Tactic.LibrarySearch import Std.Tactic.Lint import Std.Tactic.Lint.Basic @@ -123,7 +122,6 @@ import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix import Std.Tactic.Relation.Rfl import Std.Tactic.Relation.Symm -import Std.Tactic.Replace import Std.Tactic.RunCmd import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm @@ -132,7 +130,6 @@ import Std.Tactic.Simpa import Std.Tactic.SolveByElim import Std.Tactic.SolveByElim.Backtrack import Std.Tactic.SqueezeScope -import Std.Tactic.TryThis import Std.Tactic.Unreachable import Std.Tactic.Where import Std.Test.Internal.DummyLabelAttr diff --git a/Std/CodeAction/Misc.lean b/Std/CodeAction/Misc.lean index 7c063fee5b..18f38ec793 100644 --- a/Std/CodeAction/Misc.lean +++ b/Std/CodeAction/Misc.lean @@ -8,6 +8,7 @@ import Lean.Elab.BuiltinNotation import Std.Lean.Name import Std.Lean.Position import Std.CodeAction.Attr +import Lean.Meta.Tactic.TryThis /-! # Miscellaneous code actions diff --git a/Std/Data/Prod/Lex.lean b/Std/Data/Prod/Lex.lean index 7fd404bdfd..2bb21568dc 100644 --- a/Std/Data/Prod/Lex.lean +++ b/Std/Data/Prod/Lex.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Std.Tactic.LeftRight namespace Prod diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index 5ec48693b6..c6bbb8bac5 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -266,61 +266,6 @@ def mkFreshIdWithPrefix [Monad m] [MonadNameGenerator m] («prefix» : Name) : setNGen ngen.next pure r -/-- -Implementation of `repeat'` and `repeat1'`. - -`repeat'Core f` runs `f` on all of the goals to produce a new list of goals, -then runs `f` again on all of those goals, and repeats until `f` fails on all remaining goals, -or until `maxIters` total calls to `f` have occurred. - -Returns a boolean indicating whether `f` succeeded at least once, and -all the remaining goals (i.e. those on which `f` failed). --/ -def repeat'Core [Monad m] [MonadExcept ε m] [MonadBacktrack s m] [MonadMCtx m] - (f : MVarId → m (List MVarId)) (gs : List MVarId) (maxIters := 100000) : - m (Bool × List MVarId) := do - let (progress, acc) ← go maxIters false gs [] #[] - pure (progress, (← acc.filterM fun g => not <$> g.isAssigned).toList) -where - /-- Auxiliary for `repeat'Core`. `repeat'Core.go f maxIters progress gs stk acc` evaluates to - essentially `acc.toList ++ repeat' f (gs::stk).join maxIters`: that is, `acc` are goals we will - not revisit, and `(gs::stk).join` is the accumulated todo list of subgoals. -/ - go : Nat → Bool → List MVarId → List (List MVarId) → Array MVarId → m (Bool × Array MVarId) - | _, p, [], [], acc => pure (p, acc) - | n, p, [], gs::stk, acc => go n p gs stk acc - | n, p, g::gs, stk, acc => do - if ← g.isAssigned then - go n p gs stk acc - else - match n with - | 0 => pure <| (p, acc.push g ++ gs |> stk.foldl .appendList) - | n+1 => - match ← observing? (f g) with - | some gs' => go n true gs' (gs::stk) acc - | none => go n p gs stk (acc.push g) -termination_by n p gs stk _ => (n, stk, gs) - -/-- -`repeat' f` runs `f` on all of the goals to produce a new list of goals, -then runs `f` again on all of those goals, and repeats until `f` fails on all remaining goals, -or until `maxIters` total calls to `f` have occurred. -Always succeeds (returning the original goals if `f` fails on all of them). --/ -def repeat' [Monad m] [MonadExcept ε m] [MonadBacktrack s m] [MonadMCtx m] - (f : MVarId → m (List MVarId)) (gs : List MVarId) (maxIters := 100000) : m (List MVarId) := - repeat'Core f gs maxIters <&> (·.2) - -/-- -`repeat1' f` runs `f` on all of the goals to produce a new list of goals, -then runs `f` again on all of those goals, and repeats until `f` fails on all remaining goals, -or until `maxIters` total calls to `f` have occurred. -Fails if `f` does not succeed at least once. --/ -def repeat1' [Monad m] [MonadError m] [MonadExcept ε m] [MonadBacktrack s m] [MonadMCtx m] - (f : MVarId → m (List MVarId)) (gs : List MVarId) (maxIters := 100000) : m (List MVarId) := do - let (.true, gs) ← repeat'Core f gs maxIters | throwError "repeat1' made no progress" - pure gs - /-- `saturate1 goal tac` runs `tac` on `goal`, then on the resulting goals, etc., until `tac` does not apply to any goal any more (i.e. it returns `none`). The diff --git a/Std/Lean/Position.lean b/Std/Lean/Position.lean index 000436d3a6..6b48dee89a 100644 --- a/Std/Lean/Position.lean +++ b/Std/Lean/Position.lean @@ -6,14 +6,6 @@ Authors: Mario Carneiro import Lean.Syntax import Lean.Data.Lsp.Utf16 -/-- Gets the LSP range from a `String.Range`. -/ -def Lean.FileMap.utf8RangeToLspRange (text : FileMap) (range : String.Range) : Lsp.Range := - { start := text.utf8PosToLspPos range.start, «end» := text.utf8PosToLspPos range.stop } - -/-- Gets the LSP range of syntax `stx`. -/ -def Lean.FileMap.rangeOfStx? (text : FileMap) (stx : Syntax) : Option Lsp.Range := - text.utf8RangeToLspRange <$> stx.getRange? - /-- Return the beginning of the line contatining character `pos`. -/ def Lean.findLineStart (s : String) (pos : String.Pos) : String.Pos := match s.revFindAux (· = '\n') pos with diff --git a/Std/Tactic/GuardMsgs.lean b/Std/Tactic/GuardMsgs.lean index 59aa964e5b..f425891424 100644 --- a/Std/Tactic/GuardMsgs.lean +++ b/Std/Tactic/GuardMsgs.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kyle Miller -/ import Lean.Elab.Command +import Lean.Meta.Tactic.TryThis import Std.CodeAction.Basic import Std.Lean.Position diff --git a/Std/Tactic/Init.lean b/Std/Tactic/Init.lean index a5d48c902b..7f24240656 100644 --- a/Std/Tactic/Init.lean +++ b/Std/Tactic/Init.lean @@ -73,44 +73,6 @@ If `p` is a negation `¬q` then the goal is changed to `⊢ q` instead. macro "absurd " h:term : tactic => `(tactic| first | refine absurd ?_ $h | refine absurd $h ?_) -/-- -`iterate n tac` runs `tac` exactly `n` times. -`iterate tac` runs `tac` repeatedly until failure. - -To run multiple tactics, one can do `iterate (tac₁; tac₂; ⋯)` or -```lean -iterate - tac₁ - tac₂ - ⋯ -``` --/ -syntax "iterate" (ppSpace num)? ppSpace tacticSeq : tactic -macro_rules - | `(tactic| iterate $seq:tacticSeq) => - `(tactic| try ($seq:tacticSeq); iterate $seq:tacticSeq) - | `(tactic| iterate $n $seq:tacticSeq) => - match n.1.toNat with - | 0 => `(tactic| skip) - | n+1 => `(tactic| ($seq:tacticSeq); iterate $(quote n) $seq:tacticSeq) - -/-- -`repeat' tac` runs `tac` on all of the goals to produce a new list of goals, -then runs `tac` again on all of those goals, and repeats until `tac` fails on all remaining goals. --/ -elab "repeat' " tac:tacticSeq : tactic => do - setGoals (← repeat' (evalTacticAtRaw tac) (← getGoals)) - -/-- -`repeat1' tac` applies `tac` to main goal at least once. If the application succeeds, -the tactic is applied recursively to the generated subgoals until it eventually fails. --/ -elab "repeat1' " tac:tacticSeq : tactic => do - setGoals (← repeat1' (evalTacticAtRaw tac) (← getGoals)) - -/-- `subst_eqs` applies `subst` to all equalities in the context as long as it makes progress. -/ -elab "subst_eqs" : tactic => Elab.Tactic.liftMetaTactic1 (·.substEqs) - /-- `split_ands` applies `And.intro` until it does not make progress. -/ syntax "split_ands" : tactic macro_rules | `(tactic| split_ands) => `(tactic| repeat' refine And.intro ?_ ?_) diff --git a/Std/Tactic/LeftRight.lean b/Std/Tactic/LeftRight.lean deleted file mode 100644 index 7d4c5f34f2..0000000000 --- a/Std/Tactic/LeftRight.lean +++ /dev/null @@ -1,54 +0,0 @@ -/- -Copyright (c) 2022 Siddhartha Gadgil. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Siddhartha Gadgil --/ -import Lean.Elab.Tactic.Basic -import Lean.Meta.Tactic.Apply - -open Lean Meta Elab Tactic - -namespace Std.Tactic.NthConstructor - -/-- -Apply the `n`-th constructor of the target type, -checking that it is an inductive type, -and that there are the expected number of constructors. --/ -def nthConstructor (name : Name) (idx : Nat) (max : Option Nat) (goal : MVarId) : - MetaM (List MVarId) := do - goal.withContext do - goal.checkNotAssigned name - matchConstInduct (← goal.getType').getAppFn - (fun _ => throwTacticEx `constructor goal "target is not an inductive datatype") - fun ival us => do - if let some max := max then unless ival.ctors.length == max do - throwTacticEx `constructor goal - s!"{name} tactic works for inductive types with exactly {max} constructors" - goal.apply <| mkConst ival.ctors[idx]! us - -end NthConstructor - -open NthConstructor - -/-- -Apply the first constructor, -in the case that the goal is an inductive type with exactly two constructors. -``` -example : True ∨ False := by - left - trivial -``` --/ -elab "left" : tactic => liftMetaTactic (nthConstructor `left 0 (some 2)) - -/-- -Apply the second constructor, -in the case that the goal is an inductive type with exactly two constructors. -``` -example {p q : Prop} (h : q) : p ∨ q := by - right - exact h -``` --/ -elab "right" : tactic => liftMetaTactic (nthConstructor `right 1 (some 2)) diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean index f5829ef49d..64079d3b85 100644 --- a/Std/Tactic/LibrarySearch.lean +++ b/Std/Tactic/LibrarySearch.lean @@ -3,6 +3,7 @@ Copyright (c) 2021-2023 Gabriel Ebner and Lean FRO. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Joe Hendrix, Scott Morrison -/ +import Lean.Meta.Tactic.TryThis import Std.Lean.CoreM import Std.Lean.Expr import Std.Lean.Meta.DiscrTree @@ -10,7 +11,6 @@ import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Parser import Std.Data.Option.Basic import Std.Tactic.SolveByElim -import Std.Tactic.TryThis import Std.Util.Pickle /-! @@ -34,7 +34,7 @@ we are ready to replace the corresponding implementations in Mathlib. namespace Std.Tactic.LibrarySearch -open Lean Meta Std.Tactic.TryThis +open Lean Meta Tactic.TryThis initialize registerTraceClass `Tactic.stdLibrarySearch initialize registerTraceClass `Tactic.stdLibrarySearch.lemmas diff --git a/Std/Tactic/Omega/Int.lean b/Std/Tactic/Omega/Int.lean index 147de0ec31..2fd621c6d9 100644 --- a/Std/Tactic/Omega/Int.lean +++ b/Std/Tactic/Omega/Int.lean @@ -6,7 +6,6 @@ Authors: Scott Morrison import Std.Classes.Order import Std.Data.Int.Init.Order import Std.Data.Prod.Lex -import Std.Tactic.LeftRight /-! # Lemmas about `Nat` and `Int` needed internally by `omega`. diff --git a/Std/Tactic/Omega/IntList.lean b/Std/Tactic/Omega/IntList.lean index 8aaaa1942e..e4eac5f771 100644 --- a/Std/Tactic/Omega/IntList.lean +++ b/Std/Tactic/Omega/IntList.lean @@ -7,7 +7,6 @@ import Std.Data.List.Init.Lemmas import Std.Data.Nat.Gcd import Std.Data.Int.Init.DivMod import Std.Data.Option.Lemmas -import Std.Tactic.Replace import Std.Tactic.Simpa /-- diff --git a/Std/Tactic/Omega/MinNatAbs.lean b/Std/Tactic/Omega/MinNatAbs.lean index c5725be026..274d2c6ddc 100644 --- a/Std/Tactic/Omega/MinNatAbs.lean +++ b/Std/Tactic/Omega/MinNatAbs.lean @@ -6,7 +6,6 @@ Authors: Scott Morrison import Std.Data.List.Init.Lemmas import Std.Data.Int.Init.Order import Std.Data.Option.Lemmas -import Std.Tactic.LeftRight /-! # `List.nonzeroMinimum`, `List.minNatAbs`, `List.maxNatAbs` diff --git a/Std/Tactic/Replace.lean b/Std/Tactic/Replace.lean deleted file mode 100644 index 77238ac5ad..0000000000 --- a/Std/Tactic/Replace.lean +++ /dev/null @@ -1,55 +0,0 @@ -/- -Copyright (c) 2017 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Arthur Paulino, Mario Carneiro --/ -import Lean.Elab.Tactic.Basic -import Lean.Elab.Do -import Lean.Meta.Tactic.Clear - -namespace Std.Tactic - -open Lean Elab.Tactic - -/-- -Acts like `have`, but removes a hypothesis with the same name as -this one if possible. For example, if the state is: - -```lean -f : α → β -h : α -⊢ goal -``` - -Then after `replace h := f h` the state will be: - -```lean -f : α → β -h : β -⊢ goal -``` - -whereas `have h := f h` would result in: - -```lean -f : α → β -h† : α -h : β -⊢ goal -``` - -This can be used to simulate the `specialize` and `apply at` tactics of Coq. --/ -syntax "replace" haveDecl : tactic - -elab_rules : tactic - | `(tactic| replace $decl:haveDecl) => - withMainContext do - let vars ← Elab.Term.Do.getDoHaveVars <| mkNullNode #[.missing, decl] - let origLCtx ← getLCtx - evalTactic $ ← `(tactic| have $decl:haveDecl) - let mut toClear := #[] - for fv in vars do - if let some ldecl := origLCtx.findFromUserName? fv.getId then - toClear := toClear.push ldecl.fvarId - liftMetaTactic1 (·.tryClearMany toClear) diff --git a/Std/Tactic/ShowTerm.lean b/Std/Tactic/ShowTerm.lean index d460f52869..f554cb7d64 100644 --- a/Std/Tactic/ShowTerm.lean +++ b/Std/Tactic/ShowTerm.lean @@ -4,10 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Mario Carneiro -/ import Lean.Elab.ElabRules -import Std.Tactic.TryThis +import Lean.Meta.Tactic.TryThis namespace Std.Tactic -open Lean Elab Tactic TryThis +open Lean Elab Tactic Meta.Tactic.TryThis /-- `show_term tac` runs `tac`, then prints the generated term in the form diff --git a/Std/Tactic/SimpTrace.lean b/Std/Tactic/SimpTrace.lean index 59f9e85425..30f1edbea1 100644 --- a/Std/Tactic/SimpTrace.lean +++ b/Std/Tactic/SimpTrace.lean @@ -5,8 +5,8 @@ Authors: Mario Carneiro -/ import Lean.Elab.ElabRules import Lean.Elab.Tactic.Simp +import Lean.Meta.Tactic.TryThis import Std.Lean.Parser -import Std.Tactic.TryThis /-! # `simp?` tactic @@ -14,7 +14,7 @@ import Std.Tactic.TryThis The `simp?` tactic is a simple wrapper around the simp with trace behavior implemented in core. -/ namespace Std.Tactic -open Lean Elab Parser Tactic Meta Simp +open Lean Elab Parser Tactic Meta Simp Meta.Tactic /-- The common arguments of `simp?` and `simp?!`. -/ syntax simpTraceArgsRest := (config)? (discharger)? (&" only")? (simpArgs)? (ppSpace location)? diff --git a/Std/Tactic/Simpa.lean b/Std/Tactic/Simpa.lean index b50b740388..b333ef73d5 100644 --- a/Std/Tactic/Simpa.lean +++ b/Std/Tactic/Simpa.lean @@ -4,11 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Gabriel Ebner, Mario Carneiro -/ import Lean.Meta.Tactic.Assumption +import Lean.Meta.Tactic.TryThis import Lean.Elab.Tactic.Simp import Lean.Linter.Util import Std.Lean.Parser import Std.Tactic.OpenPrivate -import Std.Tactic.TryThis /-- Enables the 'unnecessary `simpa`' linter. This will report if a use of diff --git a/Std/Tactic/SolveByElim.lean b/Std/Tactic/SolveByElim.lean index 7983129a3b..104d4c7ab7 100644 --- a/Std/Tactic/SolveByElim.lean +++ b/Std/Tactic/SolveByElim.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, David Renshaw -/ import Lean.Elab.Tactic.Config +import Lean.Meta.Tactic.Repeat import Std.Data.Sum.Basic import Std.Tactic.LabelAttr import Std.Tactic.Relation.Symm diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 520fa5b2e8..49b8853680 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Lean.Elab.Tactic.Simp +import Lean.Meta.Tactic.TryThis import Std.Tactic.SimpTrace /-! @@ -14,7 +15,7 @@ but in different branches of execution, such as in `cases x <;> simp`. The reported `simp` call covers all simp lemmas used by this syntax. -/ namespace Std.Tactic -open Lean Elab Parser Tactic +open Lean Elab Parser Tactic Meta.Tactic /-- `squeeze_scope a => tacs` is part of the implementation of `squeeze_scope`. diff --git a/Std/Tactic/TryThis.lean b/Std/Tactic/TryThis.lean deleted file mode 100644 index 865aaea851..0000000000 --- a/Std/Tactic/TryThis.lean +++ /dev/null @@ -1,582 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro, Thomas Murrills --/ -import Lean.Server.CodeActions -import Lean.Widget.UserWidget -import Std.Lean.Name -import Std.Lean.Position -import Std.Lean.Syntax - -/-! -# "Try this" support - -This implements a mechanism for tactics to print a message saying `Try this: `, -where `` is a link to a replacement tactic. Users can either click on the link -in the suggestion (provided by a widget), or use a code action which applies the suggestion. --/ -namespace Std.Tactic.TryThis - -open Lean Elab PrettyPrinter Meta Server RequestM - -/-! # Raw widget -/ - -/-- -This is a widget which is placed by `TryThis.addSuggestion` and `TryThis.addSuggestions`. - -When placed by `addSuggestion`, it says `Try this: ` -where `` is a link which will perform the replacement. - -When placed by `addSuggestions`, it says: -``` -Try these: -``` -* `` -* `` -* `` -* ... - -where `` is a link which will perform the replacement. --/ -@[widget_module] def tryThisWidget : Widget.Module where - javascript := " -import * as React from 'react'; -import { EditorContext } from '@leanprover/infoview'; -const e = React.createElement; -export default function ({ pos, suggestions, range, header, isInline, style }) { - const editorConnection = React.useContext(EditorContext) - const defStyle = style || { - className: 'link pointer dim', - style: { color: 'var(--vscode-textLink-foreground)' } - } - - // Construct the children of the HTML element for a given suggestion. - function makeSuggestion({ suggestion, preInfo, postInfo, style }) { - function onClick() { - editorConnection.api.applyEdit({ - changes: { [pos.uri]: [{ range, newText: suggestion }] } - }) - } - return [ - preInfo, - e('span', { onClick, title: 'Apply suggestion', ...style || defStyle }, suggestion), - postInfo - ] - } - - // Choose between an inline 'Try this'-like display and a list-based 'Try these'-like display. - let inner = null - if (isInline) { - inner = e('div', { className: 'ml1' }, - e('pre', { className: 'font-code pre-wrap' }, header, makeSuggestion(suggestions[0]))) - } else { - inner = e('div', { className: 'ml1' }, - e('pre', { className: 'font-code pre-wrap' }, header), - e('ul', { style: { paddingInlineStart: '20px' } }, suggestions.map(s => - e('li', { className: 'font-code pre-wrap' }, makeSuggestion(s))))) - } - return e('details', { open: true }, - e('summary', { className: 'mv2 pointer' }, 'Suggestions'), - inner) -}" - -/-! # Code action -/ - -/-- A packet of information about a "Try this" suggestion -that we store in the infotree for the associated code action to retrieve. -/ -structure TryThisInfo : Type where - /-- The textual range to be replaced by one of the suggestions. -/ - range : Lsp.Range - /-- - A list of suggestions for the user to choose from. - Each suggestion may optionally come with an override for the code action title. - -/ - suggestionTexts : Array (String × Option String) - /-- The prefix to display before the code action for a "Try this" suggestion if no custom code - action title is provided. If not provided, `"Try this: "` is used. -/ - codeActionPrefix? : Option String - deriving TypeName - -/-- -This is a code action provider that looks for `TryThisInfo` nodes and supplies a code action to -apply the replacement. --/ -@[code_action_provider] def tryThisProvider : CodeActionProvider := fun params snap => do - let doc ← readDoc - pure <| snap.infoTree.foldInfo (init := #[]) fun _ctx info result => Id.run do - let .ofCustomInfo { stx, value } := info | result - let some { range, suggestionTexts, codeActionPrefix? } := - value.get? TryThisInfo | result - let some stxRange := stx.getRange? | result - let stxRange := doc.meta.text.utf8RangeToLspRange stxRange - unless stxRange.start.line ≤ params.range.end.line do return result - unless params.range.start.line ≤ stxRange.end.line do return result - let mut result := result - for h : i in [:suggestionTexts.size] do - let (newText, title?) := suggestionTexts[i]'h.2 - let title := title?.getD <| (codeActionPrefix?.getD "Try this: ") ++ newText - result := result.push { - eager.title := title - eager.kind? := "quickfix" - -- Only make the first option preferred - eager.isPreferred? := if i = 0 then true else none - eager.edit? := some <| .ofTextEdit doc.versionedIdentifier { range, newText } - } - result - -/-! # Formatting -/ - -/-- Yields `(indent, column)` given a `FileMap` and a `String.Range`, where `indent` is the number -of spaces by which the line that first includes `range` is initially indented, and `column` is the -column `range` starts at in that line. -/ -def getIndentAndColumn (map : FileMap) (range : String.Range) : Nat × Nat := - let start := findLineStart map.source range.start - let body := map.source.findAux (· ≠ ' ') range.start start - ((body - start).1, (range.start - start).1) - -/-- Replace subexpressions like `?m.1234` with `?_` so it can be copy-pasted. -/ -partial def replaceMVarsByUnderscores [Monad m] [MonadQuotation m] - (s : Syntax) : m Syntax := - s.replaceM fun s => do - let `(?$id:ident) := s | pure none - if id.getId.hasNum || id.getId.isInternal then `(?_) else pure none - -/-- Delaborate `e` into syntax suitable for use by `refine`. -/ -def delabToRefinableSyntax (e : Expr) : MetaM Term := - return ⟨← replaceMVarsByUnderscores (← delab e)⟩ - -/-- The default maximum width of an ideal line in source code, 100 is the current convention. -/ -def inputWidth : Nat := 100 - -/-- An option allowing the user to customize the ideal input width, this controls output format when -the output is intended to be copied back into a lean file -/ -register_option format.inputWidth : Nat := { - defValue := inputWidth - descr := "ideal input width" -} - -/-- Get the input width specified in the options -/ -def getInputWidth (o : Options) : Nat := format.inputWidth.get o - -/-! # `Suggestion` data -/ - --- TODO: we could also support `Syntax` and `Format` -/-- Text to be used as a suggested replacement in the infoview. This can be either a `TSyntax kind` -for a single `kind : SyntaxNodeKind` or a raw `String`. - -Instead of using constructors directly, there are coercions available from these types to -`SuggestionText`. -/ -inductive SuggestionText where - /-- `TSyntax kind` used as suggested replacement text in the infoview. Note that while `TSyntax` - is in general parameterized by a list of `SyntaxNodeKind`s, we only allow one here; this - unambiguously guides pretty-printing. -/ - | tsyntax {kind : SyntaxNodeKind} : TSyntax kind → SuggestionText - /-- A raw string to be used as suggested replacement text in the infoview. -/ - | string : String → SuggestionText - deriving Inhabited - -instance : ToMessageData SuggestionText where - toMessageData - | .tsyntax stx => stx - | .string s => s - -instance {kind : SyntaxNodeKind} : CoeHead (TSyntax kind) SuggestionText where - coe := .tsyntax - -instance : Coe String SuggestionText where - coe := .string - -namespace SuggestionText - -/-- Pretty-prints a `SuggestionText` as a `Format`. If the `SuggestionText` is some `TSyntax kind`, -we use the appropriate pretty-printer; strings are coerced to `Format`s as-is. -/ -def pretty : SuggestionText → CoreM Format - | .tsyntax (kind := kind) stx => ppCategory kind stx - | .string text => return text - -/- Note that this is essentially `return (← s.pretty).prettyExtra w indent column`, but we -special-case strings to avoid converting them to `Format`s and back. -/ -/-- Pretty-prints a `SuggestionText` as a `String` and wraps with respect to the pane width, -indentation, and column, via `Format.prettyExtra`. If `w := none`, then -`w := getInputWidth (← getOptions)` is used. Raw `String`s are returned as-is. -/ -def prettyExtra (s : SuggestionText) (w : Option Nat := none) - (indent column : Nat := 0) : CoreM String := - match s with - | .tsyntax (kind := kind) stx => do - let w ← match w with | none => do pure <| getInputWidth (← getOptions) | some n => pure n - return (← ppCategory kind stx).pretty w indent column - | .string text => return text - -end SuggestionText - -/-- -Style hooks for `Suggestion`s. See `SuggestionStyle.error`, `.warning`, `.success`, `.value`, -and other definitions here for style presets. This is an arbitrary `Json` object, with the following -interesting fields: -* `title`: the hover text in the suggestion link -* `className`: the CSS classes applied to the link -* `style`: A `Json` object with additional inline CSS styles such as `color` or `textDecoration`. --/ -def SuggestionStyle := Json deriving Inhabited, ToJson - -/-- Style as an error. By default, decorates the text with an undersquiggle; providing the argument -`decorated := false` turns this off. -/ -def SuggestionStyle.error (decorated := true) : SuggestionStyle := - let style := if decorated then - json% { - -- The VS code error foreground theme color (`--vscode-errorForeground`). - color: "var(--vscode-errorForeground)", - textDecoration: "underline wavy var(--vscode-editorError-foreground) 1pt" - } - else json% { color: "var(--vscode-errorForeground)" } - json% { className: "pointer dim", style: $style } - -/-- Style as a warning. By default, decorates the text with an undersquiggle; providing the -argument `decorated := false` turns this off. -/ -def SuggestionStyle.warning (decorated := true) : SuggestionStyle := - if decorated then - json% { - -- The `.gold` CSS class, which the infoview uses when e.g. building a file. - className: "gold pointer dim", - style: { textDecoration: "underline wavy var(--vscode-editorWarning-foreground) 1pt" } - } - else json% { className: "gold pointer dim" } - -/-- Style as a success. -/ -def SuggestionStyle.success : SuggestionStyle := - -- The `.information` CSS class, which the infoview uses on successes. - json% { className: "information pointer dim" } - -/-- Style the same way as a hypothesis appearing in the infoview. -/ -def SuggestionStyle.asHypothesis : SuggestionStyle := - json% { className: "goal-hyp pointer dim" } - -/-- Style the same way as an inaccessible hypothesis appearing in the infoview. -/ -def SuggestionStyle.asInaccessible : SuggestionStyle := - json% { className: "goal-inaccessible pointer dim" } - -/-- Draws the color from a red-yellow-green color gradient with red at `0.0`, yellow at `0.5`, and -green at `1.0`. Values outside the range `[0.0, 1.0]` are clipped to lie within this range. - -With `showValueInHoverText := true` (the default), the value `t` will be included in the `title` of -the HTML element (which appears on hover). -/ -def SuggestionStyle.value (t : Float) (showValueInHoverText := true) : SuggestionStyle := - let t := min (max t 0) 1 - json% { - className: "pointer dim", - -- interpolates linearly from 0º to 120º with 95% saturation and lightness - -- varying around 50% in HSL space - style: { color: $(s!"hsl({(t * 120).round} 95% {60 * ((t - 0.5)^2 + 0.75)}%)") }, - title: $(if showValueInHoverText then s!"Apply suggestion ({t})" else "Apply suggestion") - } - -/-- Holds a `suggestion` for replacement, along with `preInfo` and `postInfo` strings to be printed -immediately before and after that suggestion, respectively. It also includes an optional -`MessageData` to represent the suggestion in logs; by default, this is `none`, and `suggestion` is -used. -/ -structure Suggestion where - /-- Text to be used as a replacement via a code action. -/ - suggestion : SuggestionText - /-- Optional info to be printed immediately before replacement text in a widget. -/ - preInfo? : Option String := none - /-- Optional info to be printed immediately after replacement text in a widget. -/ - postInfo? : Option String := none - /-- Optional style specification for the suggestion. If `none` (the default), the suggestion is - styled as a text link. Otherwise, the suggestion can be styled as: - * a status: `.error`, `.warning`, `.success` - * a hypothesis name: `.asHypothesis`, `.asInaccessible` - * a variable color: `.value (t : Float)`, which draws from a red-yellow-green gradient, with red - at `0.0` and green at `1.0`. - - See `SuggestionStyle` for details. -/ - style? : Option SuggestionStyle := none - /-- How to represent the suggestion as `MessageData`. This is used only in the info diagnostic. - If `none`, we use `suggestion`. Use `toMessageData` to render a `Suggestion` in this manner. -/ - messageData? : Option MessageData := none - /-- How to construct the text that appears in the lightbulb menu from the suggestion text. If - `none`, we use `fun ppSuggestionText => "Try this: " ++ ppSuggestionText`. Only the pretty-printed - `suggestion : SuggestionText` is used here. -/ - toCodeActionTitle? : Option (String → String) := none - deriving Inhabited - -/-- Converts a `Suggestion` to `Json` in `CoreM`. We need `CoreM` in order to pretty-print syntax. - -This also returns a `String × Option String` consisting of the pretty-printed text and any custom -code action title if `toCodeActionTitle?` is provided. - -If `w := none`, then `w := getInputWidth (← getOptions)` is used. --/ -def Suggestion.toJsonAndInfoM (s : Suggestion) (w : Option Nat := none) (indent column : Nat := 0) : - CoreM (Json × String × Option String) := do - let text ← s.suggestion.prettyExtra w indent column - let mut json := [("suggestion", (text : Json))] - if let some preInfo := s.preInfo? then json := ("preInfo", preInfo) :: json - if let some postInfo := s.postInfo? then json := ("postInfo", postInfo) :: json - if let some style := s.style? then json := ("style", toJson style) :: json - return (Json.mkObj json, text, s.toCodeActionTitle?.map (· text)) - -/- If `messageData?` is specified, we use that; otherwise (by default), we use `toMessageData` of -the suggestion text. -/ -instance : ToMessageData Suggestion where - toMessageData s := s.messageData?.getD (toMessageData s.suggestion) - -instance : Coe SuggestionText Suggestion where - coe t := { suggestion := t } - -/-- Delaborate `e` into a suggestion suitable for use by `refine`. -/ -def delabToRefinableSuggestion (e : Expr) : MetaM Suggestion := - return { suggestion := ← delabToRefinableSyntax e, messageData? := e } - -/-! # Widget hooks -/ - -/-- Core of `addSuggestion` and `addSuggestions`. Whether we use an inline display for a single -element or a list display is controlled by `isInline`. -/ -private def addSuggestionCore (ref : Syntax) (suggestions : Array Suggestion) - (header : String) (isInline : Bool) (origSpan? : Option Syntax := none) - (style? : Option SuggestionStyle := none) - (codeActionPrefix? : Option String := none) : CoreM Unit := do - if let some range := (origSpan?.getD ref).getRange? then - let map ← getFileMap - -- FIXME: this produces incorrect results when `by` is at the beginning of the line, i.e. - -- replacing `tac` in `by tac`, because the next line will only be 2 space indented - -- (less than `tac` which starts at column 3) - let (indent, column) := getIndentAndColumn map range - let suggestions ← suggestions.mapM (·.toJsonAndInfoM (indent := indent) (column := column)) - let suggestionTexts := suggestions.map (·.2) - let suggestions := suggestions.map (·.1) - let ref := Syntax.ofRange <| ref.getRange?.getD range - let range := map.utf8RangeToLspRange range - pushInfoLeaf <| .ofCustomInfo { - stx := ref - value := Dynamic.mk - { range, suggestionTexts, codeActionPrefix? : TryThisInfo } - } - Widget.savePanelWidgetInfo (hash tryThisWidget.javascript) ref - (props := return json% { - suggestions: $suggestions, - range: $range, - header: $header, - isInline: $isInline, - style: $style? - }) - -/-- Add a "try this" suggestion. This has three effects: - -* An info diagnostic is displayed saying `Try this: ` -* A widget is registered, saying `Try this: ` with a link on `` to apply - the suggestion -* A code action is added, which will apply the suggestion. - -The parameters are: -* `ref`: the span of the info diagnostic -* `s`: a `Suggestion`, which contains - * `suggestion`: the replacement text; - * `preInfo?`: an optional string shown immediately after the replacement text in the widget - message (only) - * `postInfo?`: an optional string shown immediately after the replacement text in the widget - message (only) - * `style?`: an optional `Json` object used as the value of the `style` attribute of the - suggestion text's element (not the whole suggestion element). - * `messageData?`: an optional message to display in place of `suggestion` in the info diagnostic - (only). The widget message uses only `suggestion`. If `messageData?` is `none`, we simply use - `suggestion` instead. - * `toCodeActionTitle?`: an optional function `String → String` describing how to transform the - pretty-printed suggestion text into the code action text which appears in the lightbulb menu. - If `none`, we simply prepend `"Try This: "` to the suggestion text. -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `header`: a string that begins the display. By default, it is `"Try this: "`. -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text if the - suggestion does not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is used. --/ -def addSuggestion (ref : Syntax) (s : Suggestion) (origSpan? : Option Syntax := none) - (header : String := "Try this: ") (codeActionPrefix? : Option String := none) : MetaM Unit := do - logInfoAt ref m!"{header}{s}" - addSuggestionCore ref #[s] header (isInline := true) origSpan? - (codeActionPrefix? := codeActionPrefix?) - -/-- Add a list of "try this" suggestions as a single "try these" suggestion. This has three effects: - -* An info diagnostic is displayed saying `Try these: ` -* A widget is registered, saying `Try these: ` with a link on each - `` to apply the suggestion -* A code action for each suggestion is added, which will apply the suggestion. - -The parameters are: -* `ref`: the span of the info diagnostic -* `suggestions`: an array of `Suggestion`s, which each contain - * `suggestion`: the replacement text; - * `preInfo?`: an optional string shown immediately after the replacement text in the widget - message (only) - * `postInfo?`: an optional string shown immediately after the replacement text in the widget - message (only) - * `style?`: an optional `Json` object used as the value of the `style` attribute of the - suggestion text's element (not the whole suggestion element). - * `messageData?`: an optional message to display in place of `suggestion` in the info diagnostic - (only). The widget message uses only `suggestion`. If `messageData?` is `none`, we simply use - `suggestion` instead. - * `toCodeActionTitle?`: an optional function `String → String` describing how to transform the - pretty-printed suggestion text into the code action text which appears in the lightbulb menu. - If `none`, we simply prepend `"Try This: "` to the suggestion text. -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `header`: a string that precedes the list. By default, it is `"Try these:"`. -* `style?`: a default style for all suggestions which do not have a custom `style?` set. -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text for all - suggestions which do not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is - used. --/ -def addSuggestions (ref : Syntax) (suggestions : Array Suggestion) - (origSpan? : Option Syntax := none) (header : String := "Try these:") - (style? : Option SuggestionStyle := none) - (codeActionPrefix? : Option String := none) : MetaM Unit := do - if suggestions.isEmpty then throwErrorAt ref "no suggestions available" - let msgs := suggestions.map toMessageData - let msgs := msgs.foldl (init := MessageData.nil) (fun msg m => msg ++ m!"\n• " ++ m) - logInfoAt ref m!"{header}{msgs}" - addSuggestionCore ref suggestions header (isInline := false) origSpan? style? codeActionPrefix? - -private def addExactSuggestionCore (addSubgoalsMsg : Bool) (e : Expr) : MetaM Suggestion := do - let stx ← delabToRefinableSyntax e - let mvars ← getMVars e - let suggestion ← if mvars.isEmpty then `(tactic| exact $stx) else `(tactic| refine $stx) - let messageData? := if mvars.isEmpty then m!"exact {e}" else m!"refine {e}" - let postInfo? ← if !addSubgoalsMsg || mvars.isEmpty then pure none else - let mut str := "\nRemaining subgoals:" - for g in mvars do - -- TODO: use a MessageData.ofExpr instead of rendering to string - let e ← PrettyPrinter.ppExpr (← instantiateMVars (← g.getType)) - str := str ++ Format.pretty ("\n⊢ " ++ e) - pure str - pure { suggestion, postInfo?, messageData? } - -/-- Add an `exact e` or `refine e` suggestion. - -The parameters are: -* `ref`: the span of the info diagnostic -* `e`: the replacement expression -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `addSubgoalsMsg`: if true (default false), any remaining subgoals will be shown after - `Remaining subgoals:` -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text if the - suggestion does not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is used. --/ -def addExactSuggestion (ref : Syntax) (e : Expr) - (origSpan? : Option Syntax := none) (addSubgoalsMsg := false) - (codeActionPrefix? : Option String := none): MetaM Unit := do - addSuggestion ref (← addExactSuggestionCore addSubgoalsMsg e) - (origSpan? := origSpan?) (codeActionPrefix? := codeActionPrefix?) - -/-- Add `exact e` or `refine e` suggestions. - -The parameters are: -* `ref`: the span of the info diagnostic -* `es`: the array of replacement expressions -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `addSubgoalsMsg`: if true (default false), any remaining subgoals will be shown after - `Remaining subgoals:` -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text for all - suggestions which do not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is - used. --/ -def addExactSuggestions (ref : Syntax) (es : Array Expr) - (origSpan? : Option Syntax := none) (addSubgoalsMsg := false) - (codeActionPrefix? : Option String := none) : MetaM Unit := do - let suggestions ← es.mapM <| addExactSuggestionCore addSubgoalsMsg - addSuggestions ref suggestions (origSpan? := origSpan?) (codeActionPrefix? := codeActionPrefix?) - -/-- Add a term suggestion. - -The parameters are: -* `ref`: the span of the info diagnostic -* `e`: the replacement expression -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `header`: a string which precedes the suggestion. By default, it's `"Try this: "`. -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text if the - suggestion does not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is used. --/ -def addTermSuggestion (ref : Syntax) (e : Expr) - (origSpan? : Option Syntax := none) (header : String := "Try this: ") - (codeActionPrefix? : Option String := none) : MetaM Unit := do - addSuggestion ref (← delabToRefinableSuggestion e) (origSpan? := origSpan?) (header := header) - (codeActionPrefix? := codeActionPrefix?) - -/-- Add term suggestions. - -The parameters are: -* `ref`: the span of the info diagnostic -* `es`: an array of the replacement expressions -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `header`: a string which precedes the list of suggestions. By default, it's `"Try these:"`. -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text for all - suggestions which do not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is - used. --/ -def addTermSuggestions (ref : Syntax) (es : Array Expr) - (origSpan? : Option Syntax := none) (header : String := "Try these:") - (codeActionPrefix? : Option String := none) : MetaM Unit := do - addSuggestions ref (← es.mapM delabToRefinableSuggestion) - (origSpan? := origSpan?) (header := header) (codeActionPrefix? := codeActionPrefix?) - -open Lean Elab Elab.Tactic PrettyPrinter Meta Std.Tactic.TryThis - -/-- Add a suggestion for `have h : t := e`. -/ -def addHaveSuggestion (ref : Syntax) (h? : Option Name) (t? : Option Expr) (e : Expr) - (origSpan? : Option Syntax := none) : TermElabM Unit := do - let estx ← delabToRefinableSyntax e - let prop ← isProp (← inferType e) - let tac ← if let some t := t? then - let tstx ← delabToRefinableSyntax t - if prop then - match h? with - | some h => `(tactic| have $(mkIdent h) : $tstx := $estx) - | none => `(tactic| have : $tstx := $estx) - else - `(tactic| let $(mkIdent (h?.getD `_)) : $tstx := $estx) - else - if prop then - match h? with - | some h => `(tactic| have $(mkIdent h) := $estx) - | none => `(tactic| have := $estx) - else - `(tactic| let $(mkIdent (h?.getD `_)) := $estx) - addSuggestion ref tac origSpan? - -open Lean.Parser.Tactic -open Lean.Syntax - -/-- Add a suggestion for `rw [h₁, ← h₂] at loc`. -/ -def addRewriteSuggestion (ref : Syntax) (rules : List (Expr × Bool)) - (type? : Option Expr := none) (loc? : Option Expr := none) - (origSpan? : Option Syntax := none) : - TermElabM Unit := do - let rules_stx := TSepArray.ofElems <| ← rules.toArray.mapM fun ⟨e, symm⟩ => do - let t ← delabToRefinableSyntax e - if symm then `(rwRule| ← $t:term) else `(rwRule| $t:term) - let tac ← do - let loc ← loc?.mapM fun loc => do `(location| at $(← delab loc):term) - `(tactic| rw [$rules_stx,*] $(loc)?) - - -- We don't simply write `let mut tacMsg := m!"{tac}"` here - -- but instead rebuild it, so that there are embedded `Expr`s in the message, - -- thus giving more information in the hovers. - -- Perhaps in future we will have a better way to attach elaboration information to - -- `Syntax` embedded in a `MessageData`. - let mut tacMsg := - let rulesMsg := MessageData.sbracket <| MessageData.joinSep - (rules.map fun ⟨e, symm⟩ => (if symm then "← " else "") ++ m!"{e}") ", " - if let some loc := loc? then - m!"rw {rulesMsg} at {loc}" - else - m!"rw {rulesMsg}" - let mut extraMsg := "" - if let some type := type? then - tacMsg := tacMsg ++ m!"\n-- {type}" - extraMsg := extraMsg ++ s!"\n-- {← PrettyPrinter.ppExpr type}" - addSuggestion ref (s := { suggestion := tac, postInfo? := extraMsg, messageData? := tacMsg }) - origSpan? diff --git a/test/add_suggestion.lean b/test/add_suggestion.lean index 91e54f0cfc..6604c092d9 100644 --- a/test/add_suggestion.lean +++ b/test/add_suggestion.lean @@ -1,4 +1,4 @@ -import Std.Tactic.TryThis +import Lean.Meta.Tactic.TryThis import Std.Tactic.GuardMsgs set_option linter.unusedVariables false @@ -14,7 +14,7 @@ def longdef (a b : Nat) (h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h : a = b) : 2 * a = 2 * b := by rw [h] -namespace Std.Tactic.TryThis +namespace Lean.Meta.Tactic.TryThis open Lean Elab Tactic set_option hygiene false in @@ -25,7 +25,7 @@ elab "test" : tactic => do h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h)) -end Std.Tactic.TryThis +end Lean.Meta.Tactic.TryThis #guard_msgs (drop info, drop warning) in -- ideally we would have a #guard_widgets or #guard_infos too, but instead we can simply check by diff --git a/test/left_right.lean b/test/left_right.lean index bc7b18e432..fcff731b06 100644 --- a/test/left_right.lean +++ b/test/left_right.lean @@ -1,4 +1,3 @@ -import Std.Tactic.LeftRight import Std.Tactic.GuardMsgs /-- Construct a natural number using `left`. -/ @@ -17,7 +16,7 @@ example : two = 2 := rfl set_option linter.missingDocs false /-- -error: tactic 'constructor' failed, +error: tactic 'left' failed, left tactic works for inductive types with exactly 2 constructors ⊢ Unit -/ @@ -29,7 +28,7 @@ inductive F | a | b | c /-- -error: tactic 'constructor' failed, +error: tactic 'left' failed, left tactic works for inductive types with exactly 2 constructors ⊢ F -/ @@ -44,7 +43,7 @@ example : G := by left /-- -error: tactic 'constructor' failed, target is not an inductive datatype +error: tactic 'left' failed, target is not an inductive datatype ⊢ Type -/ #guard_msgs in diff --git a/test/replace.lean b/test/replace.lean index c75d390b8d..99cfd227fe 100644 --- a/test/replace.lean +++ b/test/replace.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Arthur Paulino. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino -/ -import Std.Tactic.Replace set_option linter.unusedVariables false diff --git a/test/tryThis.lean b/test/tryThis.lean index 861de6eb07..e616193b62 100644 --- a/test/tryThis.lean +++ b/test/tryThis.lean @@ -3,10 +3,10 @@ Copyright (c) 2023 Thomas Murrills. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Murrills -/ -import Std.Tactic.TryThis import Std.Tactic.GuardMsgs +import Lean.Meta.Tactic.TryThis -open Std.Tactic.TryThis +open Lean.Meta.Tactic.TryThis /-! This test file demonstrates the `Try This:` widget and describes how certain examples should From 9c3a5c2cceca60308b104dc3d1b075aa71f3353d Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 14 Feb 2024 20:34:37 +1100 Subject: [PATCH 033/213] sync --- Std/Data/Int/Order.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 08618e7551..8bb6b5f89f 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -5,6 +5,7 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Data.Int.Init.Order import Std.Data.Option.Basic +import Std.Tactic.Omega /-! # Results about the order properties of the integers, and the integers as an ordered ring. From c331724c9b4aa5d163cf3a90940038aa8a095ab0 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 14 Feb 2024 20:56:47 +1100 Subject: [PATCH 034/213] restore rangeOfStx? --- Std/Lean/Position.lean | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/Std/Lean/Position.lean b/Std/Lean/Position.lean index 6b48dee89a..f2bc155886 100644 --- a/Std/Lean/Position.lean +++ b/Std/Lean/Position.lean @@ -4,8 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Lean.Syntax +import Lean.Meta.Tactic.TryThis import Lean.Data.Lsp.Utf16 +/-- Gets the LSP range of syntax `stx`. -/ +def Lean.FileMap.rangeOfStx? (text : FileMap) (stx : Syntax) : Option Lsp.Range := + text.utf8RangeToLspRange <$> stx.getRange? + /-- Return the beginning of the line contatining character `pos`. -/ def Lean.findLineStart (s : String) (pos : String.Pos) : String.Pos := match s.revFindAux (· = '\n') pos with From 212c4e533c95b293bc773f0a2adcdf343c9907dc Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 15 Feb 2024 07:06:01 +1100 Subject: [PATCH 035/213] chore: adaptations for nightly-2024-02-14 (#644) Co-authored-by: Joe Hendrix --- Std.lean | 3 - Std/CodeAction/Misc.lean | 1 + Std/Data/Prod/Lex.lean | 1 - Std/Lean/Meta/Basic.lean | 55 --- Std/Lean/Position.lean | 5 +- Std/Tactic/GuardMsgs.lean | 1 + Std/Tactic/Init.lean | 38 --- Std/Tactic/LeftRight.lean | 54 --- Std/Tactic/LibrarySearch.lean | 4 +- Std/Tactic/Omega/Int.lean | 1 - Std/Tactic/Omega/IntList.lean | 1 - Std/Tactic/Omega/MinNatAbs.lean | 1 - Std/Tactic/Replace.lean | 55 --- Std/Tactic/RunCmd.lean | 4 +- Std/Tactic/ShowTerm.lean | 4 +- Std/Tactic/SimpTrace.lean | 4 +- Std/Tactic/Simpa.lean | 2 +- Std/Tactic/SolveByElim.lean | 1 + Std/Tactic/SqueezeScope.lean | 3 +- Std/Tactic/TryThis.lean | 582 -------------------------------- lean-toolchain | 2 +- test/add_suggestion.lean | 6 +- test/left_right.lean | 7 +- test/replace.lean | 1 - test/tryThis.lean | 4 +- 25 files changed, 25 insertions(+), 815 deletions(-) delete mode 100644 Std/Tactic/LeftRight.lean delete mode 100644 Std/Tactic/Replace.lean delete mode 100644 Std/Tactic/TryThis.lean diff --git a/Std.lean b/Std.lean index 6b737270f4..9756ff2841 100644 --- a/Std.lean +++ b/Std.lean @@ -93,7 +93,6 @@ import Std.Tactic.HaveI import Std.Tactic.Init import Std.Tactic.Instances import Std.Tactic.LabelAttr -import Std.Tactic.LeftRight import Std.Tactic.LibrarySearch import Std.Tactic.Lint import Std.Tactic.Lint.Basic @@ -123,7 +122,6 @@ import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix import Std.Tactic.Relation.Rfl import Std.Tactic.Relation.Symm -import Std.Tactic.Replace import Std.Tactic.RunCmd import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm @@ -132,7 +130,6 @@ import Std.Tactic.Simpa import Std.Tactic.SolveByElim import Std.Tactic.SolveByElim.Backtrack import Std.Tactic.SqueezeScope -import Std.Tactic.TryThis import Std.Tactic.Unreachable import Std.Tactic.Where import Std.Test.Internal.DummyLabelAttr diff --git a/Std/CodeAction/Misc.lean b/Std/CodeAction/Misc.lean index 7c063fee5b..18f38ec793 100644 --- a/Std/CodeAction/Misc.lean +++ b/Std/CodeAction/Misc.lean @@ -8,6 +8,7 @@ import Lean.Elab.BuiltinNotation import Std.Lean.Name import Std.Lean.Position import Std.CodeAction.Attr +import Lean.Meta.Tactic.TryThis /-! # Miscellaneous code actions diff --git a/Std/Data/Prod/Lex.lean b/Std/Data/Prod/Lex.lean index 7fd404bdfd..2bb21568dc 100644 --- a/Std/Data/Prod/Lex.lean +++ b/Std/Data/Prod/Lex.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Std.Tactic.LeftRight namespace Prod diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index 5ec48693b6..c6bbb8bac5 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -266,61 +266,6 @@ def mkFreshIdWithPrefix [Monad m] [MonadNameGenerator m] («prefix» : Name) : setNGen ngen.next pure r -/-- -Implementation of `repeat'` and `repeat1'`. - -`repeat'Core f` runs `f` on all of the goals to produce a new list of goals, -then runs `f` again on all of those goals, and repeats until `f` fails on all remaining goals, -or until `maxIters` total calls to `f` have occurred. - -Returns a boolean indicating whether `f` succeeded at least once, and -all the remaining goals (i.e. those on which `f` failed). --/ -def repeat'Core [Monad m] [MonadExcept ε m] [MonadBacktrack s m] [MonadMCtx m] - (f : MVarId → m (List MVarId)) (gs : List MVarId) (maxIters := 100000) : - m (Bool × List MVarId) := do - let (progress, acc) ← go maxIters false gs [] #[] - pure (progress, (← acc.filterM fun g => not <$> g.isAssigned).toList) -where - /-- Auxiliary for `repeat'Core`. `repeat'Core.go f maxIters progress gs stk acc` evaluates to - essentially `acc.toList ++ repeat' f (gs::stk).join maxIters`: that is, `acc` are goals we will - not revisit, and `(gs::stk).join` is the accumulated todo list of subgoals. -/ - go : Nat → Bool → List MVarId → List (List MVarId) → Array MVarId → m (Bool × Array MVarId) - | _, p, [], [], acc => pure (p, acc) - | n, p, [], gs::stk, acc => go n p gs stk acc - | n, p, g::gs, stk, acc => do - if ← g.isAssigned then - go n p gs stk acc - else - match n with - | 0 => pure <| (p, acc.push g ++ gs |> stk.foldl .appendList) - | n+1 => - match ← observing? (f g) with - | some gs' => go n true gs' (gs::stk) acc - | none => go n p gs stk (acc.push g) -termination_by n p gs stk _ => (n, stk, gs) - -/-- -`repeat' f` runs `f` on all of the goals to produce a new list of goals, -then runs `f` again on all of those goals, and repeats until `f` fails on all remaining goals, -or until `maxIters` total calls to `f` have occurred. -Always succeeds (returning the original goals if `f` fails on all of them). --/ -def repeat' [Monad m] [MonadExcept ε m] [MonadBacktrack s m] [MonadMCtx m] - (f : MVarId → m (List MVarId)) (gs : List MVarId) (maxIters := 100000) : m (List MVarId) := - repeat'Core f gs maxIters <&> (·.2) - -/-- -`repeat1' f` runs `f` on all of the goals to produce a new list of goals, -then runs `f` again on all of those goals, and repeats until `f` fails on all remaining goals, -or until `maxIters` total calls to `f` have occurred. -Fails if `f` does not succeed at least once. --/ -def repeat1' [Monad m] [MonadError m] [MonadExcept ε m] [MonadBacktrack s m] [MonadMCtx m] - (f : MVarId → m (List MVarId)) (gs : List MVarId) (maxIters := 100000) : m (List MVarId) := do - let (.true, gs) ← repeat'Core f gs maxIters | throwError "repeat1' made no progress" - pure gs - /-- `saturate1 goal tac` runs `tac` on `goal`, then on the resulting goals, etc., until `tac` does not apply to any goal any more (i.e. it returns `none`). The diff --git a/Std/Lean/Position.lean b/Std/Lean/Position.lean index 000436d3a6..60ea2d058a 100644 --- a/Std/Lean/Position.lean +++ b/Std/Lean/Position.lean @@ -5,10 +5,7 @@ Authors: Mario Carneiro -/ import Lean.Syntax import Lean.Data.Lsp.Utf16 - -/-- Gets the LSP range from a `String.Range`. -/ -def Lean.FileMap.utf8RangeToLspRange (text : FileMap) (range : String.Range) : Lsp.Range := - { start := text.utf8PosToLspPos range.start, «end» := text.utf8PosToLspPos range.stop } +import Lean.Meta.Tactic.TryThis /-- Gets the LSP range of syntax `stx`. -/ def Lean.FileMap.rangeOfStx? (text : FileMap) (stx : Syntax) : Option Lsp.Range := diff --git a/Std/Tactic/GuardMsgs.lean b/Std/Tactic/GuardMsgs.lean index 59aa964e5b..f425891424 100644 --- a/Std/Tactic/GuardMsgs.lean +++ b/Std/Tactic/GuardMsgs.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kyle Miller -/ import Lean.Elab.Command +import Lean.Meta.Tactic.TryThis import Std.CodeAction.Basic import Std.Lean.Position diff --git a/Std/Tactic/Init.lean b/Std/Tactic/Init.lean index a5d48c902b..7f24240656 100644 --- a/Std/Tactic/Init.lean +++ b/Std/Tactic/Init.lean @@ -73,44 +73,6 @@ If `p` is a negation `¬q` then the goal is changed to `⊢ q` instead. macro "absurd " h:term : tactic => `(tactic| first | refine absurd ?_ $h | refine absurd $h ?_) -/-- -`iterate n tac` runs `tac` exactly `n` times. -`iterate tac` runs `tac` repeatedly until failure. - -To run multiple tactics, one can do `iterate (tac₁; tac₂; ⋯)` or -```lean -iterate - tac₁ - tac₂ - ⋯ -``` --/ -syntax "iterate" (ppSpace num)? ppSpace tacticSeq : tactic -macro_rules - | `(tactic| iterate $seq:tacticSeq) => - `(tactic| try ($seq:tacticSeq); iterate $seq:tacticSeq) - | `(tactic| iterate $n $seq:tacticSeq) => - match n.1.toNat with - | 0 => `(tactic| skip) - | n+1 => `(tactic| ($seq:tacticSeq); iterate $(quote n) $seq:tacticSeq) - -/-- -`repeat' tac` runs `tac` on all of the goals to produce a new list of goals, -then runs `tac` again on all of those goals, and repeats until `tac` fails on all remaining goals. --/ -elab "repeat' " tac:tacticSeq : tactic => do - setGoals (← repeat' (evalTacticAtRaw tac) (← getGoals)) - -/-- -`repeat1' tac` applies `tac` to main goal at least once. If the application succeeds, -the tactic is applied recursively to the generated subgoals until it eventually fails. --/ -elab "repeat1' " tac:tacticSeq : tactic => do - setGoals (← repeat1' (evalTacticAtRaw tac) (← getGoals)) - -/-- `subst_eqs` applies `subst` to all equalities in the context as long as it makes progress. -/ -elab "subst_eqs" : tactic => Elab.Tactic.liftMetaTactic1 (·.substEqs) - /-- `split_ands` applies `And.intro` until it does not make progress. -/ syntax "split_ands" : tactic macro_rules | `(tactic| split_ands) => `(tactic| repeat' refine And.intro ?_ ?_) diff --git a/Std/Tactic/LeftRight.lean b/Std/Tactic/LeftRight.lean deleted file mode 100644 index 7d4c5f34f2..0000000000 --- a/Std/Tactic/LeftRight.lean +++ /dev/null @@ -1,54 +0,0 @@ -/- -Copyright (c) 2022 Siddhartha Gadgil. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Siddhartha Gadgil --/ -import Lean.Elab.Tactic.Basic -import Lean.Meta.Tactic.Apply - -open Lean Meta Elab Tactic - -namespace Std.Tactic.NthConstructor - -/-- -Apply the `n`-th constructor of the target type, -checking that it is an inductive type, -and that there are the expected number of constructors. --/ -def nthConstructor (name : Name) (idx : Nat) (max : Option Nat) (goal : MVarId) : - MetaM (List MVarId) := do - goal.withContext do - goal.checkNotAssigned name - matchConstInduct (← goal.getType').getAppFn - (fun _ => throwTacticEx `constructor goal "target is not an inductive datatype") - fun ival us => do - if let some max := max then unless ival.ctors.length == max do - throwTacticEx `constructor goal - s!"{name} tactic works for inductive types with exactly {max} constructors" - goal.apply <| mkConst ival.ctors[idx]! us - -end NthConstructor - -open NthConstructor - -/-- -Apply the first constructor, -in the case that the goal is an inductive type with exactly two constructors. -``` -example : True ∨ False := by - left - trivial -``` --/ -elab "left" : tactic => liftMetaTactic (nthConstructor `left 0 (some 2)) - -/-- -Apply the second constructor, -in the case that the goal is an inductive type with exactly two constructors. -``` -example {p q : Prop} (h : q) : p ∨ q := by - right - exact h -``` --/ -elab "right" : tactic => liftMetaTactic (nthConstructor `right 1 (some 2)) diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean index f5829ef49d..64079d3b85 100644 --- a/Std/Tactic/LibrarySearch.lean +++ b/Std/Tactic/LibrarySearch.lean @@ -3,6 +3,7 @@ Copyright (c) 2021-2023 Gabriel Ebner and Lean FRO. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gabriel Ebner, Joe Hendrix, Scott Morrison -/ +import Lean.Meta.Tactic.TryThis import Std.Lean.CoreM import Std.Lean.Expr import Std.Lean.Meta.DiscrTree @@ -10,7 +11,6 @@ import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Parser import Std.Data.Option.Basic import Std.Tactic.SolveByElim -import Std.Tactic.TryThis import Std.Util.Pickle /-! @@ -34,7 +34,7 @@ we are ready to replace the corresponding implementations in Mathlib. namespace Std.Tactic.LibrarySearch -open Lean Meta Std.Tactic.TryThis +open Lean Meta Tactic.TryThis initialize registerTraceClass `Tactic.stdLibrarySearch initialize registerTraceClass `Tactic.stdLibrarySearch.lemmas diff --git a/Std/Tactic/Omega/Int.lean b/Std/Tactic/Omega/Int.lean index 147de0ec31..2fd621c6d9 100644 --- a/Std/Tactic/Omega/Int.lean +++ b/Std/Tactic/Omega/Int.lean @@ -6,7 +6,6 @@ Authors: Scott Morrison import Std.Classes.Order import Std.Data.Int.Init.Order import Std.Data.Prod.Lex -import Std.Tactic.LeftRight /-! # Lemmas about `Nat` and `Int` needed internally by `omega`. diff --git a/Std/Tactic/Omega/IntList.lean b/Std/Tactic/Omega/IntList.lean index 8aaaa1942e..e4eac5f771 100644 --- a/Std/Tactic/Omega/IntList.lean +++ b/Std/Tactic/Omega/IntList.lean @@ -7,7 +7,6 @@ import Std.Data.List.Init.Lemmas import Std.Data.Nat.Gcd import Std.Data.Int.Init.DivMod import Std.Data.Option.Lemmas -import Std.Tactic.Replace import Std.Tactic.Simpa /-- diff --git a/Std/Tactic/Omega/MinNatAbs.lean b/Std/Tactic/Omega/MinNatAbs.lean index c5725be026..274d2c6ddc 100644 --- a/Std/Tactic/Omega/MinNatAbs.lean +++ b/Std/Tactic/Omega/MinNatAbs.lean @@ -6,7 +6,6 @@ Authors: Scott Morrison import Std.Data.List.Init.Lemmas import Std.Data.Int.Init.Order import Std.Data.Option.Lemmas -import Std.Tactic.LeftRight /-! # `List.nonzeroMinimum`, `List.minNatAbs`, `List.maxNatAbs` diff --git a/Std/Tactic/Replace.lean b/Std/Tactic/Replace.lean deleted file mode 100644 index 77238ac5ad..0000000000 --- a/Std/Tactic/Replace.lean +++ /dev/null @@ -1,55 +0,0 @@ -/- -Copyright (c) 2017 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Arthur Paulino, Mario Carneiro --/ -import Lean.Elab.Tactic.Basic -import Lean.Elab.Do -import Lean.Meta.Tactic.Clear - -namespace Std.Tactic - -open Lean Elab.Tactic - -/-- -Acts like `have`, but removes a hypothesis with the same name as -this one if possible. For example, if the state is: - -```lean -f : α → β -h : α -⊢ goal -``` - -Then after `replace h := f h` the state will be: - -```lean -f : α → β -h : β -⊢ goal -``` - -whereas `have h := f h` would result in: - -```lean -f : α → β -h† : α -h : β -⊢ goal -``` - -This can be used to simulate the `specialize` and `apply at` tactics of Coq. --/ -syntax "replace" haveDecl : tactic - -elab_rules : tactic - | `(tactic| replace $decl:haveDecl) => - withMainContext do - let vars ← Elab.Term.Do.getDoHaveVars <| mkNullNode #[.missing, decl] - let origLCtx ← getLCtx - evalTactic $ ← `(tactic| have $decl:haveDecl) - let mut toClear := #[] - for fv in vars do - if let some ldecl := origLCtx.findFromUserName? fv.getId then - toClear := toClear.push ldecl.fvarId - liftMetaTactic1 (·.tryClearMany toClear) diff --git a/Std/Tactic/RunCmd.lean b/Std/Tactic/RunCmd.lean index 9c8eb39389..e2887935ac 100644 --- a/Std/Tactic/RunCmd.lean +++ b/Std/Tactic/RunCmd.lean @@ -5,6 +5,7 @@ Authors: Sebastian Ullrich, Mario Carneiro -/ import Lean.Elab.Eval import Lean.Elab.Command +import Std.Tactic.Lint.Misc /-! Defines commands to compile and execute a command / term / tactic on the spot: @@ -67,7 +68,8 @@ elab (name := runTac) "run_tac " e:doSeq : tactic => do syntax (name := byElab) "by_elab " doSeq : term /-- Elaborator for `by_elab`. -/ -@[term_elab byElab] def elabRunElab : TermElab := fun +@[term_elab byElab, nolint unusedHavesSuffices] +def elabRunElab : TermElab := fun | `(by_elab $cmds:doSeq), expectedType? => do if let `(Lean.Parser.Term.doSeq| $e:term) := cmds then if e matches `(Lean.Parser.Term.doSeq| fun $[$_args]* => $_) then diff --git a/Std/Tactic/ShowTerm.lean b/Std/Tactic/ShowTerm.lean index d460f52869..f554cb7d64 100644 --- a/Std/Tactic/ShowTerm.lean +++ b/Std/Tactic/ShowTerm.lean @@ -4,10 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Mario Carneiro -/ import Lean.Elab.ElabRules -import Std.Tactic.TryThis +import Lean.Meta.Tactic.TryThis namespace Std.Tactic -open Lean Elab Tactic TryThis +open Lean Elab Tactic Meta.Tactic.TryThis /-- `show_term tac` runs `tac`, then prints the generated term in the form diff --git a/Std/Tactic/SimpTrace.lean b/Std/Tactic/SimpTrace.lean index 59f9e85425..30f1edbea1 100644 --- a/Std/Tactic/SimpTrace.lean +++ b/Std/Tactic/SimpTrace.lean @@ -5,8 +5,8 @@ Authors: Mario Carneiro -/ import Lean.Elab.ElabRules import Lean.Elab.Tactic.Simp +import Lean.Meta.Tactic.TryThis import Std.Lean.Parser -import Std.Tactic.TryThis /-! # `simp?` tactic @@ -14,7 +14,7 @@ import Std.Tactic.TryThis The `simp?` tactic is a simple wrapper around the simp with trace behavior implemented in core. -/ namespace Std.Tactic -open Lean Elab Parser Tactic Meta Simp +open Lean Elab Parser Tactic Meta Simp Meta.Tactic /-- The common arguments of `simp?` and `simp?!`. -/ syntax simpTraceArgsRest := (config)? (discharger)? (&" only")? (simpArgs)? (ppSpace location)? diff --git a/Std/Tactic/Simpa.lean b/Std/Tactic/Simpa.lean index b50b740388..b333ef73d5 100644 --- a/Std/Tactic/Simpa.lean +++ b/Std/Tactic/Simpa.lean @@ -4,11 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Gabriel Ebner, Mario Carneiro -/ import Lean.Meta.Tactic.Assumption +import Lean.Meta.Tactic.TryThis import Lean.Elab.Tactic.Simp import Lean.Linter.Util import Std.Lean.Parser import Std.Tactic.OpenPrivate -import Std.Tactic.TryThis /-- Enables the 'unnecessary `simpa`' linter. This will report if a use of diff --git a/Std/Tactic/SolveByElim.lean b/Std/Tactic/SolveByElim.lean index 7983129a3b..104d4c7ab7 100644 --- a/Std/Tactic/SolveByElim.lean +++ b/Std/Tactic/SolveByElim.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, David Renshaw -/ import Lean.Elab.Tactic.Config +import Lean.Meta.Tactic.Repeat import Std.Data.Sum.Basic import Std.Tactic.LabelAttr import Std.Tactic.Relation.Symm diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 520fa5b2e8..49b8853680 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Lean.Elab.Tactic.Simp +import Lean.Meta.Tactic.TryThis import Std.Tactic.SimpTrace /-! @@ -14,7 +15,7 @@ but in different branches of execution, such as in `cases x <;> simp`. The reported `simp` call covers all simp lemmas used by this syntax. -/ namespace Std.Tactic -open Lean Elab Parser Tactic +open Lean Elab Parser Tactic Meta.Tactic /-- `squeeze_scope a => tacs` is part of the implementation of `squeeze_scope`. diff --git a/Std/Tactic/TryThis.lean b/Std/Tactic/TryThis.lean deleted file mode 100644 index 865aaea851..0000000000 --- a/Std/Tactic/TryThis.lean +++ /dev/null @@ -1,582 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro, Thomas Murrills --/ -import Lean.Server.CodeActions -import Lean.Widget.UserWidget -import Std.Lean.Name -import Std.Lean.Position -import Std.Lean.Syntax - -/-! -# "Try this" support - -This implements a mechanism for tactics to print a message saying `Try this: `, -where `` is a link to a replacement tactic. Users can either click on the link -in the suggestion (provided by a widget), or use a code action which applies the suggestion. --/ -namespace Std.Tactic.TryThis - -open Lean Elab PrettyPrinter Meta Server RequestM - -/-! # Raw widget -/ - -/-- -This is a widget which is placed by `TryThis.addSuggestion` and `TryThis.addSuggestions`. - -When placed by `addSuggestion`, it says `Try this: ` -where `` is a link which will perform the replacement. - -When placed by `addSuggestions`, it says: -``` -Try these: -``` -* `` -* `` -* `` -* ... - -where `` is a link which will perform the replacement. --/ -@[widget_module] def tryThisWidget : Widget.Module where - javascript := " -import * as React from 'react'; -import { EditorContext } from '@leanprover/infoview'; -const e = React.createElement; -export default function ({ pos, suggestions, range, header, isInline, style }) { - const editorConnection = React.useContext(EditorContext) - const defStyle = style || { - className: 'link pointer dim', - style: { color: 'var(--vscode-textLink-foreground)' } - } - - // Construct the children of the HTML element for a given suggestion. - function makeSuggestion({ suggestion, preInfo, postInfo, style }) { - function onClick() { - editorConnection.api.applyEdit({ - changes: { [pos.uri]: [{ range, newText: suggestion }] } - }) - } - return [ - preInfo, - e('span', { onClick, title: 'Apply suggestion', ...style || defStyle }, suggestion), - postInfo - ] - } - - // Choose between an inline 'Try this'-like display and a list-based 'Try these'-like display. - let inner = null - if (isInline) { - inner = e('div', { className: 'ml1' }, - e('pre', { className: 'font-code pre-wrap' }, header, makeSuggestion(suggestions[0]))) - } else { - inner = e('div', { className: 'ml1' }, - e('pre', { className: 'font-code pre-wrap' }, header), - e('ul', { style: { paddingInlineStart: '20px' } }, suggestions.map(s => - e('li', { className: 'font-code pre-wrap' }, makeSuggestion(s))))) - } - return e('details', { open: true }, - e('summary', { className: 'mv2 pointer' }, 'Suggestions'), - inner) -}" - -/-! # Code action -/ - -/-- A packet of information about a "Try this" suggestion -that we store in the infotree for the associated code action to retrieve. -/ -structure TryThisInfo : Type where - /-- The textual range to be replaced by one of the suggestions. -/ - range : Lsp.Range - /-- - A list of suggestions for the user to choose from. - Each suggestion may optionally come with an override for the code action title. - -/ - suggestionTexts : Array (String × Option String) - /-- The prefix to display before the code action for a "Try this" suggestion if no custom code - action title is provided. If not provided, `"Try this: "` is used. -/ - codeActionPrefix? : Option String - deriving TypeName - -/-- -This is a code action provider that looks for `TryThisInfo` nodes and supplies a code action to -apply the replacement. --/ -@[code_action_provider] def tryThisProvider : CodeActionProvider := fun params snap => do - let doc ← readDoc - pure <| snap.infoTree.foldInfo (init := #[]) fun _ctx info result => Id.run do - let .ofCustomInfo { stx, value } := info | result - let some { range, suggestionTexts, codeActionPrefix? } := - value.get? TryThisInfo | result - let some stxRange := stx.getRange? | result - let stxRange := doc.meta.text.utf8RangeToLspRange stxRange - unless stxRange.start.line ≤ params.range.end.line do return result - unless params.range.start.line ≤ stxRange.end.line do return result - let mut result := result - for h : i in [:suggestionTexts.size] do - let (newText, title?) := suggestionTexts[i]'h.2 - let title := title?.getD <| (codeActionPrefix?.getD "Try this: ") ++ newText - result := result.push { - eager.title := title - eager.kind? := "quickfix" - -- Only make the first option preferred - eager.isPreferred? := if i = 0 then true else none - eager.edit? := some <| .ofTextEdit doc.versionedIdentifier { range, newText } - } - result - -/-! # Formatting -/ - -/-- Yields `(indent, column)` given a `FileMap` and a `String.Range`, where `indent` is the number -of spaces by which the line that first includes `range` is initially indented, and `column` is the -column `range` starts at in that line. -/ -def getIndentAndColumn (map : FileMap) (range : String.Range) : Nat × Nat := - let start := findLineStart map.source range.start - let body := map.source.findAux (· ≠ ' ') range.start start - ((body - start).1, (range.start - start).1) - -/-- Replace subexpressions like `?m.1234` with `?_` so it can be copy-pasted. -/ -partial def replaceMVarsByUnderscores [Monad m] [MonadQuotation m] - (s : Syntax) : m Syntax := - s.replaceM fun s => do - let `(?$id:ident) := s | pure none - if id.getId.hasNum || id.getId.isInternal then `(?_) else pure none - -/-- Delaborate `e` into syntax suitable for use by `refine`. -/ -def delabToRefinableSyntax (e : Expr) : MetaM Term := - return ⟨← replaceMVarsByUnderscores (← delab e)⟩ - -/-- The default maximum width of an ideal line in source code, 100 is the current convention. -/ -def inputWidth : Nat := 100 - -/-- An option allowing the user to customize the ideal input width, this controls output format when -the output is intended to be copied back into a lean file -/ -register_option format.inputWidth : Nat := { - defValue := inputWidth - descr := "ideal input width" -} - -/-- Get the input width specified in the options -/ -def getInputWidth (o : Options) : Nat := format.inputWidth.get o - -/-! # `Suggestion` data -/ - --- TODO: we could also support `Syntax` and `Format` -/-- Text to be used as a suggested replacement in the infoview. This can be either a `TSyntax kind` -for a single `kind : SyntaxNodeKind` or a raw `String`. - -Instead of using constructors directly, there are coercions available from these types to -`SuggestionText`. -/ -inductive SuggestionText where - /-- `TSyntax kind` used as suggested replacement text in the infoview. Note that while `TSyntax` - is in general parameterized by a list of `SyntaxNodeKind`s, we only allow one here; this - unambiguously guides pretty-printing. -/ - | tsyntax {kind : SyntaxNodeKind} : TSyntax kind → SuggestionText - /-- A raw string to be used as suggested replacement text in the infoview. -/ - | string : String → SuggestionText - deriving Inhabited - -instance : ToMessageData SuggestionText where - toMessageData - | .tsyntax stx => stx - | .string s => s - -instance {kind : SyntaxNodeKind} : CoeHead (TSyntax kind) SuggestionText where - coe := .tsyntax - -instance : Coe String SuggestionText where - coe := .string - -namespace SuggestionText - -/-- Pretty-prints a `SuggestionText` as a `Format`. If the `SuggestionText` is some `TSyntax kind`, -we use the appropriate pretty-printer; strings are coerced to `Format`s as-is. -/ -def pretty : SuggestionText → CoreM Format - | .tsyntax (kind := kind) stx => ppCategory kind stx - | .string text => return text - -/- Note that this is essentially `return (← s.pretty).prettyExtra w indent column`, but we -special-case strings to avoid converting them to `Format`s and back. -/ -/-- Pretty-prints a `SuggestionText` as a `String` and wraps with respect to the pane width, -indentation, and column, via `Format.prettyExtra`. If `w := none`, then -`w := getInputWidth (← getOptions)` is used. Raw `String`s are returned as-is. -/ -def prettyExtra (s : SuggestionText) (w : Option Nat := none) - (indent column : Nat := 0) : CoreM String := - match s with - | .tsyntax (kind := kind) stx => do - let w ← match w with | none => do pure <| getInputWidth (← getOptions) | some n => pure n - return (← ppCategory kind stx).pretty w indent column - | .string text => return text - -end SuggestionText - -/-- -Style hooks for `Suggestion`s. See `SuggestionStyle.error`, `.warning`, `.success`, `.value`, -and other definitions here for style presets. This is an arbitrary `Json` object, with the following -interesting fields: -* `title`: the hover text in the suggestion link -* `className`: the CSS classes applied to the link -* `style`: A `Json` object with additional inline CSS styles such as `color` or `textDecoration`. --/ -def SuggestionStyle := Json deriving Inhabited, ToJson - -/-- Style as an error. By default, decorates the text with an undersquiggle; providing the argument -`decorated := false` turns this off. -/ -def SuggestionStyle.error (decorated := true) : SuggestionStyle := - let style := if decorated then - json% { - -- The VS code error foreground theme color (`--vscode-errorForeground`). - color: "var(--vscode-errorForeground)", - textDecoration: "underline wavy var(--vscode-editorError-foreground) 1pt" - } - else json% { color: "var(--vscode-errorForeground)" } - json% { className: "pointer dim", style: $style } - -/-- Style as a warning. By default, decorates the text with an undersquiggle; providing the -argument `decorated := false` turns this off. -/ -def SuggestionStyle.warning (decorated := true) : SuggestionStyle := - if decorated then - json% { - -- The `.gold` CSS class, which the infoview uses when e.g. building a file. - className: "gold pointer dim", - style: { textDecoration: "underline wavy var(--vscode-editorWarning-foreground) 1pt" } - } - else json% { className: "gold pointer dim" } - -/-- Style as a success. -/ -def SuggestionStyle.success : SuggestionStyle := - -- The `.information` CSS class, which the infoview uses on successes. - json% { className: "information pointer dim" } - -/-- Style the same way as a hypothesis appearing in the infoview. -/ -def SuggestionStyle.asHypothesis : SuggestionStyle := - json% { className: "goal-hyp pointer dim" } - -/-- Style the same way as an inaccessible hypothesis appearing in the infoview. -/ -def SuggestionStyle.asInaccessible : SuggestionStyle := - json% { className: "goal-inaccessible pointer dim" } - -/-- Draws the color from a red-yellow-green color gradient with red at `0.0`, yellow at `0.5`, and -green at `1.0`. Values outside the range `[0.0, 1.0]` are clipped to lie within this range. - -With `showValueInHoverText := true` (the default), the value `t` will be included in the `title` of -the HTML element (which appears on hover). -/ -def SuggestionStyle.value (t : Float) (showValueInHoverText := true) : SuggestionStyle := - let t := min (max t 0) 1 - json% { - className: "pointer dim", - -- interpolates linearly from 0º to 120º with 95% saturation and lightness - -- varying around 50% in HSL space - style: { color: $(s!"hsl({(t * 120).round} 95% {60 * ((t - 0.5)^2 + 0.75)}%)") }, - title: $(if showValueInHoverText then s!"Apply suggestion ({t})" else "Apply suggestion") - } - -/-- Holds a `suggestion` for replacement, along with `preInfo` and `postInfo` strings to be printed -immediately before and after that suggestion, respectively. It also includes an optional -`MessageData` to represent the suggestion in logs; by default, this is `none`, and `suggestion` is -used. -/ -structure Suggestion where - /-- Text to be used as a replacement via a code action. -/ - suggestion : SuggestionText - /-- Optional info to be printed immediately before replacement text in a widget. -/ - preInfo? : Option String := none - /-- Optional info to be printed immediately after replacement text in a widget. -/ - postInfo? : Option String := none - /-- Optional style specification for the suggestion. If `none` (the default), the suggestion is - styled as a text link. Otherwise, the suggestion can be styled as: - * a status: `.error`, `.warning`, `.success` - * a hypothesis name: `.asHypothesis`, `.asInaccessible` - * a variable color: `.value (t : Float)`, which draws from a red-yellow-green gradient, with red - at `0.0` and green at `1.0`. - - See `SuggestionStyle` for details. -/ - style? : Option SuggestionStyle := none - /-- How to represent the suggestion as `MessageData`. This is used only in the info diagnostic. - If `none`, we use `suggestion`. Use `toMessageData` to render a `Suggestion` in this manner. -/ - messageData? : Option MessageData := none - /-- How to construct the text that appears in the lightbulb menu from the suggestion text. If - `none`, we use `fun ppSuggestionText => "Try this: " ++ ppSuggestionText`. Only the pretty-printed - `suggestion : SuggestionText` is used here. -/ - toCodeActionTitle? : Option (String → String) := none - deriving Inhabited - -/-- Converts a `Suggestion` to `Json` in `CoreM`. We need `CoreM` in order to pretty-print syntax. - -This also returns a `String × Option String` consisting of the pretty-printed text and any custom -code action title if `toCodeActionTitle?` is provided. - -If `w := none`, then `w := getInputWidth (← getOptions)` is used. --/ -def Suggestion.toJsonAndInfoM (s : Suggestion) (w : Option Nat := none) (indent column : Nat := 0) : - CoreM (Json × String × Option String) := do - let text ← s.suggestion.prettyExtra w indent column - let mut json := [("suggestion", (text : Json))] - if let some preInfo := s.preInfo? then json := ("preInfo", preInfo) :: json - if let some postInfo := s.postInfo? then json := ("postInfo", postInfo) :: json - if let some style := s.style? then json := ("style", toJson style) :: json - return (Json.mkObj json, text, s.toCodeActionTitle?.map (· text)) - -/- If `messageData?` is specified, we use that; otherwise (by default), we use `toMessageData` of -the suggestion text. -/ -instance : ToMessageData Suggestion where - toMessageData s := s.messageData?.getD (toMessageData s.suggestion) - -instance : Coe SuggestionText Suggestion where - coe t := { suggestion := t } - -/-- Delaborate `e` into a suggestion suitable for use by `refine`. -/ -def delabToRefinableSuggestion (e : Expr) : MetaM Suggestion := - return { suggestion := ← delabToRefinableSyntax e, messageData? := e } - -/-! # Widget hooks -/ - -/-- Core of `addSuggestion` and `addSuggestions`. Whether we use an inline display for a single -element or a list display is controlled by `isInline`. -/ -private def addSuggestionCore (ref : Syntax) (suggestions : Array Suggestion) - (header : String) (isInline : Bool) (origSpan? : Option Syntax := none) - (style? : Option SuggestionStyle := none) - (codeActionPrefix? : Option String := none) : CoreM Unit := do - if let some range := (origSpan?.getD ref).getRange? then - let map ← getFileMap - -- FIXME: this produces incorrect results when `by` is at the beginning of the line, i.e. - -- replacing `tac` in `by tac`, because the next line will only be 2 space indented - -- (less than `tac` which starts at column 3) - let (indent, column) := getIndentAndColumn map range - let suggestions ← suggestions.mapM (·.toJsonAndInfoM (indent := indent) (column := column)) - let suggestionTexts := suggestions.map (·.2) - let suggestions := suggestions.map (·.1) - let ref := Syntax.ofRange <| ref.getRange?.getD range - let range := map.utf8RangeToLspRange range - pushInfoLeaf <| .ofCustomInfo { - stx := ref - value := Dynamic.mk - { range, suggestionTexts, codeActionPrefix? : TryThisInfo } - } - Widget.savePanelWidgetInfo (hash tryThisWidget.javascript) ref - (props := return json% { - suggestions: $suggestions, - range: $range, - header: $header, - isInline: $isInline, - style: $style? - }) - -/-- Add a "try this" suggestion. This has three effects: - -* An info diagnostic is displayed saying `Try this: ` -* A widget is registered, saying `Try this: ` with a link on `` to apply - the suggestion -* A code action is added, which will apply the suggestion. - -The parameters are: -* `ref`: the span of the info diagnostic -* `s`: a `Suggestion`, which contains - * `suggestion`: the replacement text; - * `preInfo?`: an optional string shown immediately after the replacement text in the widget - message (only) - * `postInfo?`: an optional string shown immediately after the replacement text in the widget - message (only) - * `style?`: an optional `Json` object used as the value of the `style` attribute of the - suggestion text's element (not the whole suggestion element). - * `messageData?`: an optional message to display in place of `suggestion` in the info diagnostic - (only). The widget message uses only `suggestion`. If `messageData?` is `none`, we simply use - `suggestion` instead. - * `toCodeActionTitle?`: an optional function `String → String` describing how to transform the - pretty-printed suggestion text into the code action text which appears in the lightbulb menu. - If `none`, we simply prepend `"Try This: "` to the suggestion text. -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `header`: a string that begins the display. By default, it is `"Try this: "`. -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text if the - suggestion does not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is used. --/ -def addSuggestion (ref : Syntax) (s : Suggestion) (origSpan? : Option Syntax := none) - (header : String := "Try this: ") (codeActionPrefix? : Option String := none) : MetaM Unit := do - logInfoAt ref m!"{header}{s}" - addSuggestionCore ref #[s] header (isInline := true) origSpan? - (codeActionPrefix? := codeActionPrefix?) - -/-- Add a list of "try this" suggestions as a single "try these" suggestion. This has three effects: - -* An info diagnostic is displayed saying `Try these: ` -* A widget is registered, saying `Try these: ` with a link on each - `` to apply the suggestion -* A code action for each suggestion is added, which will apply the suggestion. - -The parameters are: -* `ref`: the span of the info diagnostic -* `suggestions`: an array of `Suggestion`s, which each contain - * `suggestion`: the replacement text; - * `preInfo?`: an optional string shown immediately after the replacement text in the widget - message (only) - * `postInfo?`: an optional string shown immediately after the replacement text in the widget - message (only) - * `style?`: an optional `Json` object used as the value of the `style` attribute of the - suggestion text's element (not the whole suggestion element). - * `messageData?`: an optional message to display in place of `suggestion` in the info diagnostic - (only). The widget message uses only `suggestion`. If `messageData?` is `none`, we simply use - `suggestion` instead. - * `toCodeActionTitle?`: an optional function `String → String` describing how to transform the - pretty-printed suggestion text into the code action text which appears in the lightbulb menu. - If `none`, we simply prepend `"Try This: "` to the suggestion text. -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `header`: a string that precedes the list. By default, it is `"Try these:"`. -* `style?`: a default style for all suggestions which do not have a custom `style?` set. -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text for all - suggestions which do not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is - used. --/ -def addSuggestions (ref : Syntax) (suggestions : Array Suggestion) - (origSpan? : Option Syntax := none) (header : String := "Try these:") - (style? : Option SuggestionStyle := none) - (codeActionPrefix? : Option String := none) : MetaM Unit := do - if suggestions.isEmpty then throwErrorAt ref "no suggestions available" - let msgs := suggestions.map toMessageData - let msgs := msgs.foldl (init := MessageData.nil) (fun msg m => msg ++ m!"\n• " ++ m) - logInfoAt ref m!"{header}{msgs}" - addSuggestionCore ref suggestions header (isInline := false) origSpan? style? codeActionPrefix? - -private def addExactSuggestionCore (addSubgoalsMsg : Bool) (e : Expr) : MetaM Suggestion := do - let stx ← delabToRefinableSyntax e - let mvars ← getMVars e - let suggestion ← if mvars.isEmpty then `(tactic| exact $stx) else `(tactic| refine $stx) - let messageData? := if mvars.isEmpty then m!"exact {e}" else m!"refine {e}" - let postInfo? ← if !addSubgoalsMsg || mvars.isEmpty then pure none else - let mut str := "\nRemaining subgoals:" - for g in mvars do - -- TODO: use a MessageData.ofExpr instead of rendering to string - let e ← PrettyPrinter.ppExpr (← instantiateMVars (← g.getType)) - str := str ++ Format.pretty ("\n⊢ " ++ e) - pure str - pure { suggestion, postInfo?, messageData? } - -/-- Add an `exact e` or `refine e` suggestion. - -The parameters are: -* `ref`: the span of the info diagnostic -* `e`: the replacement expression -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `addSubgoalsMsg`: if true (default false), any remaining subgoals will be shown after - `Remaining subgoals:` -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text if the - suggestion does not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is used. --/ -def addExactSuggestion (ref : Syntax) (e : Expr) - (origSpan? : Option Syntax := none) (addSubgoalsMsg := false) - (codeActionPrefix? : Option String := none): MetaM Unit := do - addSuggestion ref (← addExactSuggestionCore addSubgoalsMsg e) - (origSpan? := origSpan?) (codeActionPrefix? := codeActionPrefix?) - -/-- Add `exact e` or `refine e` suggestions. - -The parameters are: -* `ref`: the span of the info diagnostic -* `es`: the array of replacement expressions -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `addSubgoalsMsg`: if true (default false), any remaining subgoals will be shown after - `Remaining subgoals:` -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text for all - suggestions which do not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is - used. --/ -def addExactSuggestions (ref : Syntax) (es : Array Expr) - (origSpan? : Option Syntax := none) (addSubgoalsMsg := false) - (codeActionPrefix? : Option String := none) : MetaM Unit := do - let suggestions ← es.mapM <| addExactSuggestionCore addSubgoalsMsg - addSuggestions ref suggestions (origSpan? := origSpan?) (codeActionPrefix? := codeActionPrefix?) - -/-- Add a term suggestion. - -The parameters are: -* `ref`: the span of the info diagnostic -* `e`: the replacement expression -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `header`: a string which precedes the suggestion. By default, it's `"Try this: "`. -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text if the - suggestion does not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is used. --/ -def addTermSuggestion (ref : Syntax) (e : Expr) - (origSpan? : Option Syntax := none) (header : String := "Try this: ") - (codeActionPrefix? : Option String := none) : MetaM Unit := do - addSuggestion ref (← delabToRefinableSuggestion e) (origSpan? := origSpan?) (header := header) - (codeActionPrefix? := codeActionPrefix?) - -/-- Add term suggestions. - -The parameters are: -* `ref`: the span of the info diagnostic -* `es`: an array of the replacement expressions -* `origSpan?`: a syntax object whose span is the actual text to be replaced by `suggestion`. - If not provided it defaults to `ref`. -* `header`: a string which precedes the list of suggestions. By default, it's `"Try these:"`. -* `codeActionPrefix?`: an optional string to be used as the prefix of the replacement text for all - suggestions which do not have a custom `toCodeActionTitle?`. If not provided, `"Try this: "` is - used. --/ -def addTermSuggestions (ref : Syntax) (es : Array Expr) - (origSpan? : Option Syntax := none) (header : String := "Try these:") - (codeActionPrefix? : Option String := none) : MetaM Unit := do - addSuggestions ref (← es.mapM delabToRefinableSuggestion) - (origSpan? := origSpan?) (header := header) (codeActionPrefix? := codeActionPrefix?) - -open Lean Elab Elab.Tactic PrettyPrinter Meta Std.Tactic.TryThis - -/-- Add a suggestion for `have h : t := e`. -/ -def addHaveSuggestion (ref : Syntax) (h? : Option Name) (t? : Option Expr) (e : Expr) - (origSpan? : Option Syntax := none) : TermElabM Unit := do - let estx ← delabToRefinableSyntax e - let prop ← isProp (← inferType e) - let tac ← if let some t := t? then - let tstx ← delabToRefinableSyntax t - if prop then - match h? with - | some h => `(tactic| have $(mkIdent h) : $tstx := $estx) - | none => `(tactic| have : $tstx := $estx) - else - `(tactic| let $(mkIdent (h?.getD `_)) : $tstx := $estx) - else - if prop then - match h? with - | some h => `(tactic| have $(mkIdent h) := $estx) - | none => `(tactic| have := $estx) - else - `(tactic| let $(mkIdent (h?.getD `_)) := $estx) - addSuggestion ref tac origSpan? - -open Lean.Parser.Tactic -open Lean.Syntax - -/-- Add a suggestion for `rw [h₁, ← h₂] at loc`. -/ -def addRewriteSuggestion (ref : Syntax) (rules : List (Expr × Bool)) - (type? : Option Expr := none) (loc? : Option Expr := none) - (origSpan? : Option Syntax := none) : - TermElabM Unit := do - let rules_stx := TSepArray.ofElems <| ← rules.toArray.mapM fun ⟨e, symm⟩ => do - let t ← delabToRefinableSyntax e - if symm then `(rwRule| ← $t:term) else `(rwRule| $t:term) - let tac ← do - let loc ← loc?.mapM fun loc => do `(location| at $(← delab loc):term) - `(tactic| rw [$rules_stx,*] $(loc)?) - - -- We don't simply write `let mut tacMsg := m!"{tac}"` here - -- but instead rebuild it, so that there are embedded `Expr`s in the message, - -- thus giving more information in the hovers. - -- Perhaps in future we will have a better way to attach elaboration information to - -- `Syntax` embedded in a `MessageData`. - let mut tacMsg := - let rulesMsg := MessageData.sbracket <| MessageData.joinSep - (rules.map fun ⟨e, symm⟩ => (if symm then "← " else "") ++ m!"{e}") ", " - if let some loc := loc? then - m!"rw {rulesMsg} at {loc}" - else - m!"rw {rulesMsg}" - let mut extraMsg := "" - if let some type := type? then - tacMsg := tacMsg ++ m!"\n-- {type}" - extraMsg := extraMsg ++ s!"\n-- {← PrettyPrinter.ppExpr type}" - addSuggestion ref (s := { suggestion := tac, postInfo? := extraMsg, messageData? := tacMsg }) - origSpan? diff --git a/lean-toolchain b/lean-toolchain index fc840ba55a..2d47fabe49 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-13 +leanprover/lean4:nightly-2024-02-14 diff --git a/test/add_suggestion.lean b/test/add_suggestion.lean index 91e54f0cfc..6604c092d9 100644 --- a/test/add_suggestion.lean +++ b/test/add_suggestion.lean @@ -1,4 +1,4 @@ -import Std.Tactic.TryThis +import Lean.Meta.Tactic.TryThis import Std.Tactic.GuardMsgs set_option linter.unusedVariables false @@ -14,7 +14,7 @@ def longdef (a b : Nat) (h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h : a = b) : 2 * a = 2 * b := by rw [h] -namespace Std.Tactic.TryThis +namespace Lean.Meta.Tactic.TryThis open Lean Elab Tactic set_option hygiene false in @@ -25,7 +25,7 @@ elab "test" : tactic => do h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h)) -end Std.Tactic.TryThis +end Lean.Meta.Tactic.TryThis #guard_msgs (drop info, drop warning) in -- ideally we would have a #guard_widgets or #guard_infos too, but instead we can simply check by diff --git a/test/left_right.lean b/test/left_right.lean index bc7b18e432..fcff731b06 100644 --- a/test/left_right.lean +++ b/test/left_right.lean @@ -1,4 +1,3 @@ -import Std.Tactic.LeftRight import Std.Tactic.GuardMsgs /-- Construct a natural number using `left`. -/ @@ -17,7 +16,7 @@ example : two = 2 := rfl set_option linter.missingDocs false /-- -error: tactic 'constructor' failed, +error: tactic 'left' failed, left tactic works for inductive types with exactly 2 constructors ⊢ Unit -/ @@ -29,7 +28,7 @@ inductive F | a | b | c /-- -error: tactic 'constructor' failed, +error: tactic 'left' failed, left tactic works for inductive types with exactly 2 constructors ⊢ F -/ @@ -44,7 +43,7 @@ example : G := by left /-- -error: tactic 'constructor' failed, target is not an inductive datatype +error: tactic 'left' failed, target is not an inductive datatype ⊢ Type -/ #guard_msgs in diff --git a/test/replace.lean b/test/replace.lean index c75d390b8d..99cfd227fe 100644 --- a/test/replace.lean +++ b/test/replace.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Arthur Paulino. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino -/ -import Std.Tactic.Replace set_option linter.unusedVariables false diff --git a/test/tryThis.lean b/test/tryThis.lean index 861de6eb07..e616193b62 100644 --- a/test/tryThis.lean +++ b/test/tryThis.lean @@ -3,10 +3,10 @@ Copyright (c) 2023 Thomas Murrills. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Murrills -/ -import Std.Tactic.TryThis import Std.Tactic.GuardMsgs +import Lean.Meta.Tactic.TryThis -open Std.Tactic.TryThis +open Lean.Meta.Tactic.TryThis /-! This test file demonstrates the `Try This:` widget and describes how certain examples should From 7f53caa7524c69ac850c92769aa1a1e5c2080e3c Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Wed, 14 Feb 2024 12:31:10 -0800 Subject: [PATCH 036/213] chore: remove ExtendedBinder --- Std.lean | 1 - Std/Classes/SetNotation.lean | 1 - Std/Util/ExtendedBinder.lean | 140 ----------------------------------- 3 files changed, 142 deletions(-) delete mode 100644 Std/Util/ExtendedBinder.lean diff --git a/Std.lean b/Std.lean index 9756ff2841..b93a5f12ca 100644 --- a/Std.lean +++ b/Std.lean @@ -135,7 +135,6 @@ import Std.Tactic.Where import Std.Test.Internal.DummyLabelAttr import Std.Util.Cache import Std.Util.CheckTactic -import Std.Util.ExtendedBinder import Std.Util.LibraryNote import Std.Util.Pickle import Std.Util.ProofWanted diff --git a/Std/Classes/SetNotation.lean b/Std/Classes/SetNotation.lean index 7e46916cc9..2439ae4f7c 100644 --- a/Std/Classes/SetNotation.lean +++ b/Std/Classes/SetNotation.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Util.ExtendedBinder /-- Notation type class for the subset relation `⊆`. -/ class HasSubset (α : Type u) where diff --git a/Std/Util/ExtendedBinder.lean b/Std/Util/ExtendedBinder.lean deleted file mode 100644 index dfdbcc62ff..0000000000 --- a/Std/Util/ExtendedBinder.lean +++ /dev/null @@ -1,140 +0,0 @@ -/- -Copyright (c) 2021 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ -import Lean.Elab.MacroArgUtil -import Lean.Linter.MissingDocs - -/-! -Defines an extended binder syntax supporting `∀ ε > 0, ...` etc. --/ - -namespace Std.ExtendedBinder -open Lean - -/-- -The syntax category of binder predicates contains predicates like `> 0`, `∈ s`, etc. -(`: t` should not be a binder predicate because it would clash with the built-in syntax for ∀/∃.) --/ -declare_syntax_cat binderPred - -/-- -`satisfies_binder_pred% t pred` expands to a proposition expressing that `t` satisfies `pred`. --/ -syntax "satisfies_binder_pred% " term:max binderPred : term - --- Extend ∀ and ∃ to binder predicates. - -/-- -The notation `∃ x < 2, p x` is shorthand for `∃ x, x < 2 ∧ p x`, -and similarly for other binary operators. --/ -syntax "∃ " binderIdent binderPred ", " term : term -/-- -The notation `∀ x < 2, p x` is shorthand for `∀ x, x < 2 → p x`, -and similarly for other binary operators. --/ -syntax "∀ " binderIdent binderPred ", " term : term - -macro_rules - | `(∃ $x:ident $pred:binderPred, $p) => - `(∃ $x:ident, satisfies_binder_pred% $x $pred ∧ $p) - | `(∃ _ $pred:binderPred, $p) => - `(∃ x, satisfies_binder_pred% x $pred ∧ $p) - -macro_rules - | `(∀ $x:ident $pred:binderPred, $p) => - `(∀ $x:ident, satisfies_binder_pred% $x $pred → $p) - | `(∀ _ $pred:binderPred, $p) => - `(∀ x, satisfies_binder_pred% x $pred → $p) - --- We also provide special versions of ∀/∃ that take a list of extended binders. --- The built-in binders are not reused because that results in overloaded syntax. - -/-- -An extended binder has the form `x`, `x : ty`, or `x pred` -where `pred` is a `binderPred` like `< 2`. --/ -syntax extBinder := binderIdent ((" : " term) <|> binderPred)? -/-- A extended binder in parentheses -/ -syntax extBinderParenthesized := " (" extBinder ")" -- TODO: inlining this definition breaks -/-- A list of parenthesized binders -/ -syntax extBinderCollection := extBinderParenthesized* -/-- A single (unparenthesized) binder, or a list of parenthesized binders -/ -syntax extBinders := (ppSpace extBinder) <|> extBinderCollection - -/-- The syntax `∃ᵉ (x < 2) (y < 3), p x y` is shorthand for `∃ x < 2, ∃ y < 3, p x y`. -/ -syntax "∃ᵉ" extBinders ", " term : term -macro_rules - | `(∃ᵉ, $b) => pure b - | `(∃ᵉ ($p:extBinder) $[($ps:extBinder)]*, $b) => - `(∃ᵉ $p:extBinder, ∃ᵉ $[($ps:extBinder)]*, $b) -macro_rules -- TODO: merging the two macro_rules breaks expansion - | `(∃ᵉ $x:binderIdent, $b) => `(∃ $x:binderIdent, $b) - | `(∃ᵉ $x:binderIdent : $ty:term, $b) => `(∃ $x:binderIdent : $ty:term, $b) - | `(∃ᵉ $x:binderIdent $p:binderPred, $b) => `(∃ $x:binderIdent $p:binderPred, $b) - -/-- The syntax `∀ᵉ (x < 2) (y < 3), p x y` is shorthand for `∀ x < 2, ∀ y < 3, p x y`. -/ -syntax "∀ᵉ" extBinders ", " term : term -macro_rules - | `(∀ᵉ, $b) => pure b - | `(∀ᵉ ($p:extBinder) $[($ps:extBinder)]*, $b) => - `(∀ᵉ $p:extBinder, ∀ᵉ $[($ps:extBinder)]*, $b) -macro_rules -- TODO: merging the two macro_rules breaks expansion - | `(∀ᵉ _, $b) => `(∀ _, $b) - | `(∀ᵉ $x:ident, $b) => `(∀ $x:ident, $b) - | `(∀ᵉ _ : $ty:term, $b) => `(∀ _ : $ty:term, $b) - | `(∀ᵉ $x:ident : $ty:term, $b) => `(∀ $x:ident : $ty:term, $b) - | `(∀ᵉ $x:binderIdent $p:binderPred, $b) => `(∀ $x:binderIdent $p:binderPred, $b) - -open Parser.Command in -/-- -Declares a binder predicate. For example: -``` -binder_predicate x " > " y:term => `($x > $y) -``` --/ -syntax (name := binderPredicate) (docComment)? (Parser.Term.attributes)? (attrKind)? - "binder_predicate" optNamedName optNamedPrio ppSpace ident (ppSpace macroArg)* " => " - term : command - --- adapted from the macro macro -open Elab Command in -elab_rules : command - | `($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind binder_predicate%$tk - $[(name := $name?)]? $[(priority := $prio?)]? $x $args:macroArg* => $rhs) => do - let prio ← liftMacroM do evalOptPrio prio? - let (stxParts, patArgs) := (← args.mapM expandMacroArg).unzip - let name ← match name? with - | some name => pure name.getId - | none => liftMacroM do mkNameFromParserSyntax `binderTerm (mkNullNode stxParts) - let nameTk := name?.getD (mkIdentFrom tk name) - /- The command `syntax [] ...` adds the current namespace to the syntax node kind. - So, we must include current namespace when we create a pattern for the following - `macro_rules` commands. -/ - let pat : TSyntax `binderPred := ⟨(mkNode ((← getCurrNamespace) ++ name) patArgs).1⟩ - elabCommand <|<- - `($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind syntax%$tk - (name := $nameTk) (priority := $(quote prio)) $[$stxParts]* : binderPred - $[$doc?:docComment]? macro_rules%$tk - | `(satisfies_binder_pred% $$($x):term $pat:binderPred) => $rhs) - -open Linter.MissingDocs Parser Term in -/-- Missing docs handler for `binder_predicate` -/ -@[missing_docs_handler binderPredicate] -def checkBinderPredicate : SimpleHandler := fun stx => do - if stx[0].isNone && stx[2][0][0].getKind != ``«local» then - if stx[4].isNone then lint stx[3] "binder predicate" - else lintNamed stx[4][0][3] "binder predicate" - -/-- Declare `∃ x > y, ...` as syntax for `∃ x, x > y ∧ ...` -/ -binder_predicate x " > " y:term => `($x > $y) -/-- Declare `∃ x ≥ y, ...` as syntax for `∃ x, x ≥ y ∧ ...` -/ -binder_predicate x " ≥ " y:term => `($x ≥ $y) -/-- Declare `∃ x < y, ...` as syntax for `∃ x, x < y ∧ ...` -/ -binder_predicate x " < " y:term => `($x < $y) -/-- Declare `∃ x ≤ y, ...` as syntax for `∃ x, x ≤ y ∧ ...` -/ -binder_predicate x " ≤ " y:term => `($x ≤ $y) -/-- Declare `∃ x ≠ y, ...` as syntax for `∃ x, x ≠ y ∧ ...` -/ -binder_predicate x " ≠ " y:term => `($x ≠ $y) From b7f952156281f7ba92b5c5e87bf8f5201d9dc389 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Tue, 13 Feb 2024 23:11:49 -0800 Subject: [PATCH 037/213] chore: fix imports --- Std/Data/Nat.lean | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Std/Data/Nat.lean b/Std/Data/Nat.lean index 4983ff4773..959a5fe27d 100644 --- a/Std/Data/Nat.lean +++ b/Std/Data/Nat.lean @@ -1,5 +1,8 @@ import Std.Data.Nat.Basic import Std.Data.Nat.Bitwise import Std.Data.Nat.Gcd +import Std.Data.Nat.Init.Basic +import Std.Data.Nat.Init.Dvd +import Std.Data.Nat.Init.Gcd import Std.Data.Nat.Init.Lemmas import Std.Data.Nat.Lemmas From fce9fc3f20ff1fc1e21f1813dafff0df630cd050 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Wed, 14 Feb 2024 12:45:24 -0800 Subject: [PATCH 038/213] chore: migrate many omega lemmaas to Nat.Init --- Std/Data/Int/DivMod.lean | 1 + Std/Data/Int/Init/DivMod.lean | 1 + Std/Data/Int/Init/Lemmas.lean | 2 +- Std/Data/List/Basic.lean | 1 - Std/Data/Nat/Basic.lean | 6 - Std/Data/Nat/Gcd.lean | 32 +--- Std/Data/Nat/Init/Basic.lean | 9 + Std/Data/Nat/Init/Dvd.lean | 90 ++++++++++ Std/Data/Nat/Init/Gcd.lean | 37 ++++ Std/Data/Nat/Init/Lemmas.lean | 250 ++++++++++++++++++++++++-- Std/Data/Nat/Lemmas.lean | 293 +------------------------------ Std/Lean/Meta/LazyDiscrTree.lean | 1 - Std/Tactic/Omega/Constraint.lean | 2 +- Std/Tactic/Omega/IntList.lean | 5 +- Std/Tactic/Omega/MinNatAbs.lean | 1 + 15 files changed, 386 insertions(+), 345 deletions(-) create mode 100644 Std/Data/Nat/Init/Basic.lean create mode 100644 Std/Data/Nat/Init/Dvd.lean create mode 100644 Std/Data/Nat/Init/Gcd.lean diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 9d710f2204..b14b0bc114 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -3,6 +3,7 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ +import Std.Data.Nat.Lemmas import Std.Data.Int.Order import Std.Data.Int.Init.DivMod diff --git a/Std/Data/Int/Init/DivMod.lean b/Std/Data/Int/Init/DivMod.lean index a0eeb55ae8..cf7c35e507 100644 --- a/Std/Data/Int/Init/DivMod.lean +++ b/Std/Data/Int/Init/DivMod.lean @@ -3,6 +3,7 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ +import Std.Data.Nat.Init.Dvd import Std.Data.Int.Init.Order /-! diff --git a/Std/Data/Int/Init/Lemmas.lean b/Std/Data/Int/Init/Lemmas.lean index e4faa67afa..97ead4750d 100644 --- a/Std/Data/Int/Init/Lemmas.lean +++ b/Std/Data/Int/Init/Lemmas.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Classes.Cast -import Std.Data.Nat.Lemmas +import Std.Data.Nat.Init.Lemmas import Std.Data.Int.Basic import Std.Tactic.NormCast.Lemmas diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index 37bd012a46..bdab46df03 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -203,7 +203,6 @@ def enumFromTR (n : Nat) (l : List α) : List (Nat × α) := | a::as, n => by rw [← show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as] simp [enumFrom] - rfl rw [Array.foldr_eq_foldr_data]; simp [go] theorem replicateTR_loop_eq : ∀ n, replicateTR.loop a n acc = replicate n a ++ acc diff --git a/Std/Data/Nat/Basic.lean b/Std/Data/Nat/Basic.lean index f72796e1b9..155bf0d2c9 100644 --- a/Std/Data/Nat/Basic.lean +++ b/Std/Data/Nat/Basic.lean @@ -100,12 +100,6 @@ protected def casesDiagOn {motive : Nat → Nat → Sort _} (m n : Nat) Nat.recDiag zero_zero (fun _ _ => zero_succ _) (fun _ _ => succ_zero _) (fun _ _ _ => succ_succ _ _) m n -/-- -Divisibility of natural numbers. `a ∣ b` (typed as `\|`) says that -there is some `c` such that `b = a * c`. --/ -instance : Dvd Nat := ⟨fun a b => ∃ c, b = a * c⟩ - /-- The least common multiple of `m` and `n`, defined using `gcd`. -/ def lcm (m n : Nat) : Nat := m * n / gcd m n diff --git a/Std/Data/Nat/Gcd.lean b/Std/Data/Nat/Gcd.lean index 063b34b284..a2a91694e1 100644 --- a/Std/Data/Nat/Gcd.lean +++ b/Std/Data/Nat/Gcd.lean @@ -3,6 +3,7 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro -/ +import Std.Data.Nat.Init.Gcd import Std.Data.Nat.Lemmas /-! @@ -12,42 +13,11 @@ import Std.Data.Nat.Lemmas namespace Nat -theorem gcd_rec (m n : Nat) : gcd m n = gcd (n % m) m := - match m with - | 0 => by have := (mod_zero n).symm; rwa [gcd_zero_right] - | _ + 1 => by simp [gcd_succ] - -@[elab_as_elim] theorem gcd.induction {P : Nat → Nat → Prop} (m n : Nat) - (H0 : ∀n, P 0 n) (H1 : ∀ m n, 0 < m → P (n % m) m → P m n) : P m n := - Nat.strongInductionOn (motive := fun m => ∀ n, P m n) m - (fun - | 0, _ => H0 - | _+1, IH => fun _ => H1 _ _ (succ_pos _) (IH _ (mod_lt _ (succ_pos _)) _) ) - n - /-- `m` and `n` are coprime, or relatively prime, if their `gcd` is 1. -/ @[reducible] def Coprime (m n : Nat) : Prop := gcd m n = 1 --- -theorem gcd_dvd (m n : Nat) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) := by - induction m, n using gcd.induction with - | H0 n => rw [gcd_zero_left]; exact ⟨Nat.dvd_zero n, Nat.dvd_refl n⟩ - | H1 m n _ IH => rw [← gcd_rec] at IH; exact ⟨IH.2, (dvd_mod_iff IH.2).1 IH.1⟩ - -theorem gcd_dvd_left (m n : Nat) : gcd m n ∣ m := (gcd_dvd m n).left - -theorem gcd_dvd_right (m n : Nat) : gcd m n ∣ n := (gcd_dvd m n).right - -theorem gcd_le_left (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h <| gcd_dvd_left m n - -theorem gcd_le_right (n) (h : 0 < n) : gcd m n ≤ n := le_of_dvd h <| gcd_dvd_right m n - -theorem dvd_gcd : k ∣ m → k ∣ n → k ∣ gcd m n := by - induction m, n using gcd.induction with intro km kn - | H0 n => rw [gcd_zero_left]; exact kn - | H1 n m _ IH => rw [gcd_rec]; exact IH ((dvd_mod_iff km).2 kn) km - theorem dvd_gcd_iff : k ∣ gcd m n ↔ k ∣ m ∧ k ∣ n := ⟨fun h => let ⟨h₁, h₂⟩ := gcd_dvd m n; ⟨Nat.dvd_trans h h₁, Nat.dvd_trans h h₂⟩, fun ⟨h₁, h₂⟩ => dvd_gcd h₁ h₂⟩ diff --git a/Std/Data/Nat/Init/Basic.lean b/Std/Data/Nat/Init/Basic.lean new file mode 100644 index 0000000000..77d9112496 --- /dev/null +++ b/Std/Data/Nat/Init/Basic.lean @@ -0,0 +1,9 @@ +namespace Nat + +/-- +Divisibility of natural numbers. `a ∣ b` (typed as `\|`) says that +there is some `c` such that `b = a * c`. +-/ +instance : Dvd Nat := ⟨fun a b => ∃ c, b = a * c⟩ + +end Nat diff --git a/Std/Data/Nat/Init/Dvd.lean b/Std/Data/Nat/Init/Dvd.lean new file mode 100644 index 0000000000..c4a4f9ca9d --- /dev/null +++ b/Std/Data/Nat/Init/Dvd.lean @@ -0,0 +1,90 @@ +import Std.Data.Nat.Init.Basic +import Std.Data.Nat.Init.Lemmas + +namespace Nat + +protected theorem dvd_refl (a : Nat) : a ∣ a := ⟨1, by simp⟩ + +protected theorem dvd_zero (a : Nat) : a ∣ 0 := ⟨0, by simp⟩ + +protected theorem dvd_mul_left (a b : Nat) : a ∣ b * a := ⟨b, Nat.mul_comm b a⟩ + +protected theorem dvd_mul_right (a b : Nat) : a ∣ a * b := ⟨b, rfl⟩ + +protected theorem dvd_trans {a b c : Nat} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c := + match h₁, h₂ with + | ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ => + ⟨d * e, show c = a * (d * e) by simp[h₃,h₄, Nat.mul_assoc]⟩ + +protected theorem eq_zero_of_zero_dvd {a : Nat} (h : 0 ∣ a) : a = 0 := + let ⟨c, H'⟩ := h; H'.trans c.zero_mul + +@[simp] protected theorem zero_dvd {n : Nat} : 0 ∣ n ↔ n = 0 := + ⟨Nat.eq_zero_of_zero_dvd, fun h => h.symm ▸ Nat.dvd_zero 0⟩ + +protected theorem dvd_add {a b c : Nat} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := + let ⟨d, hd⟩ := h₁; let ⟨e, he⟩ := h₂; ⟨d + e, by simp [Nat.left_distrib, hd, he]⟩ + +protected theorem dvd_add_iff_right {k m n : Nat} (h : k ∣ m) : k ∣ n ↔ k ∣ m + n := + ⟨Nat.dvd_add h, + match m, h with + | _, ⟨d, rfl⟩ => fun ⟨e, he⟩ => + ⟨e - d, by rw [Nat.mul_sub_left_distrib, ← he, Nat.add_sub_cancel_left]⟩⟩ + +protected theorem dvd_add_iff_left {k m n : Nat} (h : k ∣ n) : k ∣ m ↔ k ∣ m + n := by + rw [Nat.add_comm]; exact Nat.dvd_add_iff_right h + +theorem dvd_mod_iff {k m n : Nat} (h: k ∣ n) : k ∣ m % n ↔ k ∣ m := + have := Nat.dvd_add_iff_left <| Nat.dvd_trans h <| Nat.dvd_mul_right n (m / n) + by rwa [mod_add_div] at this + +theorem le_of_dvd {m n : Nat} (h : 0 < n) : m ∣ n → m ≤ n + | ⟨k, e⟩ => by + revert h + rw [e] + match k with + | 0 => intro hn; simp at hn + | pk+1 => + intro + have := Nat.mul_le_mul_left m (succ_pos pk) + rwa [Nat.mul_one] at this + +protected theorem dvd_antisymm : ∀ {m n : Nat}, m ∣ n → n ∣ m → m = n + | _, 0, _, h₂ => Nat.eq_zero_of_zero_dvd h₂ + | 0, _, h₁, _ => (Nat.eq_zero_of_zero_dvd h₁).symm + | _+1, _+1, h₁, h₂ => Nat.le_antisymm (le_of_dvd (succ_pos _) h₁) (le_of_dvd (succ_pos _) h₂) + +theorem pos_of_dvd_of_pos {m n : Nat} (H1 : m ∣ n) (H2 : 0 < n) : 0 < m := + Nat.pos_of_ne_zero fun m0 => Nat.ne_of_gt H2 <| Nat.eq_zero_of_zero_dvd (m0 ▸ H1) + +@[simp] protected theorem one_dvd (n : Nat) : 1 ∣ n := ⟨n, n.one_mul.symm⟩ + +theorem eq_one_of_dvd_one {n : Nat} (H : n ∣ 1) : n = 1 := Nat.dvd_antisymm H n.one_dvd + +theorem mod_eq_zero_of_dvd {m n : Nat} (H : m ∣ n) : n % m = 0 := by + let ⟨z, H⟩ := H; rw [H, mul_mod_right] + +theorem dvd_of_mod_eq_zero {m n : Nat} (H : n % m = 0) : m ∣ n := by + exists n / m + have := (mod_add_div n m).symm + rwa [H, Nat.zero_add] at this + +theorem dvd_iff_mod_eq_zero (m n : Nat) : m ∣ n ↔ n % m = 0 := + ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ + +instance decidable_dvd : @DecidableRel Nat (·∣·) := + fun _ _ => decidable_of_decidable_of_iff (dvd_iff_mod_eq_zero _ _).symm + +theorem emod_pos_of_not_dvd {a b : Nat} (h : ¬ a ∣ b) : 0 < b % a := by + rw [dvd_iff_mod_eq_zero] at h + exact Nat.pos_of_ne_zero h + + +protected theorem mul_div_cancel' {n m : Nat} (H : n ∣ m) : n * (m / n) = m := by + have := mod_add_div m n + rwa [mod_eq_zero_of_dvd H, Nat.zero_add] at this + +protected theorem div_mul_cancel {n m : Nat} (H : n ∣ m) : m / n * n = m := by + rw [Nat.mul_comm, Nat.mul_div_cancel' H] + +end Nat diff --git a/Std/Data/Nat/Init/Gcd.lean b/Std/Data/Nat/Init/Gcd.lean new file mode 100644 index 0000000000..27dbc299ca --- /dev/null +++ b/Std/Data/Nat/Init/Gcd.lean @@ -0,0 +1,37 @@ +import Std.Data.Nat.Init.Basic +import Std.Data.Nat.Init.Dvd + +namespace Nat + +theorem gcd_rec (m n : Nat) : gcd m n = gcd (n % m) m := + match m with + | 0 => by have := (mod_zero n).symm; rwa [gcd_zero_right] + | _ + 1 => by simp [gcd_succ] + +@[elab_as_elim] theorem gcd.induction {P : Nat → Nat → Prop} (m n : Nat) + (H0 : ∀n, P 0 n) (H1 : ∀ m n, 0 < m → P (n % m) m → P m n) : P m n := + Nat.strongInductionOn (motive := fun m => ∀ n, P m n) m + (fun + | 0, _ => H0 + | _+1, IH => fun _ => H1 _ _ (succ_pos _) (IH _ (mod_lt _ (succ_pos _)) _) ) + n + +theorem gcd_dvd (m n : Nat) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) := by + induction m, n using gcd.induction with + | H0 n => rw [gcd_zero_left]; exact ⟨Nat.dvd_zero n, Nat.dvd_refl n⟩ + | H1 m n _ IH => rw [← gcd_rec] at IH; exact ⟨IH.2, (dvd_mod_iff IH.2).1 IH.1⟩ + +theorem gcd_dvd_left (m n : Nat) : gcd m n ∣ m := (gcd_dvd m n).left + +theorem gcd_dvd_right (m n : Nat) : gcd m n ∣ n := (gcd_dvd m n).right + +theorem gcd_le_left (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h <| gcd_dvd_left m n + +theorem gcd_le_right (n) (h : 0 < n) : gcd m n ≤ n := le_of_dvd h <| gcd_dvd_right m n + +theorem dvd_gcd : k ∣ m → k ∣ n → k ∣ gcd m n := by + induction m, n using gcd.induction with intro km kn + | H0 n => rw [gcd_zero_left]; exact kn + | H1 n m _ IH => rw [gcd_rec]; exact IH ((dvd_mod_iff km).2 kn) km + +end Nat diff --git a/Std/Data/Nat/Init/Lemmas.lean b/Std/Data/Nat/Init/Lemmas.lean index ea21d5d0af..46fab00550 100644 --- a/Std/Data/Nat/Init/Lemmas.lean +++ b/Std/Data/Nat/Init/Lemmas.lean @@ -7,14 +7,98 @@ import Std.Tactic.Alias namespace Nat +/-! ### le/lt -/ + +theorem ne_of_gt {a b : Nat} (h : b < a) : a ≠ b := (ne_of_lt h).symm + +protected theorem pos_of_ne_zero {n : Nat} : n ≠ 0 → 0 < n := (eq_zero_or_pos n).resolve_left + +@[simp] protected theorem not_le {a b : Nat} : ¬ a ≤ b ↔ b < a := + ⟨Nat.gt_of_not_le, Nat.not_le_of_gt⟩ + +protected alias ⟨lt_of_not_ge, _⟩ := Nat.not_le +protected alias ⟨lt_of_not_le, not_le_of_lt⟩ := Nat.not_le +protected alias ⟨_, lt_le_asymm⟩ := Nat.not_le + +@[simp] protected theorem not_lt {a b : Nat} : ¬ a < b ↔ b ≤ a := + ⟨Nat.ge_of_not_lt, flip Nat.not_le_of_gt⟩ + +protected alias ⟨le_of_not_gt, not_lt_of_ge⟩ := Nat.not_lt +protected alias ⟨le_of_not_lt, not_lt_of_le⟩ := Nat.not_lt +protected alias ⟨_, le_lt_asymm⟩ := Nat.not_lt + +alias ne_of_lt' := ne_of_gt + +protected theorem le_of_not_le {a b : Nat} (h : ¬ b ≤ a) : a ≤ b := Nat.le_of_lt (Nat.not_le.1 h) +protected alias le_of_not_ge := Nat.le_of_not_le + +protected theorem le_antisymm_iff {a b : Nat} : a = b ↔ a ≤ b ∧ b ≤ a := + ⟨fun | rfl => ⟨Nat.le_refl _, Nat.le_refl _⟩, fun ⟨hle, hge⟩ => Nat.le_antisymm hle hge⟩ +protected alias eq_iff_le_and_ge := Nat.le_antisymm_iff + +protected theorem lt_or_gt_of_ne {a b : Nat} : a ≠ b → a < b ∨ b < a := by + rw [← Nat.not_le, ← Nat.not_le, ← Decidable.not_and_iff_or_not_not, and_comm] + exact mt Nat.le_antisymm_iff.2 +protected alias lt_or_lt_of_ne := Nat.lt_or_gt_of_ne +@[deprecated] protected alias lt_connex := Nat.lt_or_gt_of_ne + + + +/-! ## zero/one/two -/ + +protected theorem pos_iff_ne_zero : 0 < n ↔ n ≠ 0 := ⟨ne_of_gt, Nat.pos_of_ne_zero⟩ + +/-! ### succ/pred -/ + +theorem succ_pred_eq_of_pos : ∀ {n}, 0 < n → succ (pred n) = n + | _+1, _ => rfl + +theorem exists_eq_succ_of_ne_zero : ∀ {n}, n ≠ 0 → ∃ k, n = succ k + | _+1, _ => ⟨_, rfl⟩ + +/-! ### add -/ + +protected theorem add_le_add_iff_right {n : Nat} : m + n ≤ k + n ↔ m ≤ k := + ⟨Nat.le_of_add_le_add_right, fun h => Nat.add_le_add_right h _⟩ + +theorem eq_zero_of_add_eq_zero : ∀ {n m}, n + m = 0 → n = 0 ∧ m = 0 + | 0, 0, _ => ⟨rfl, rfl⟩ + | _+1, 0, h => Nat.noConfusion h + +protected theorem eq_zero_of_add_eq_zero_left (h : n + m = 0) : m = 0 := + (Nat.eq_zero_of_add_eq_zero h).2 + +/-! ### sub -/ + +attribute [simp] Nat.zero_sub Nat.add_sub_cancel succ_sub_succ_eq_sub + theorem succ_sub {m n : Nat} (h : n ≤ m) : succ m - n = succ (m - n) := by let ⟨k, hk⟩ := Nat.le.dest h rw [← hk, Nat.add_sub_cancel_left, ← add_succ, Nat.add_sub_cancel_left] +protected theorem sub_pos_of_lt (h : m < n) : 0 < n - m := + Nat.pos_iff_ne_zero.2 (Nat.sub_ne_zero_of_lt h) + +protected theorem sub_le_sub_left (h : n ≤ m) (k : Nat) : k - m ≤ k - n := + match m, le.dest h with + | _, ⟨a, rfl⟩ => by rw [← Nat.sub_sub]; apply sub_le + protected theorem sub_le_sub_right {n m : Nat} (h : n ≤ m) : ∀ k, n - k ≤ m - k | 0 => h | z+1 => pred_le_pred (Nat.sub_le_sub_right h z) +protected theorem lt_of_sub_ne_zero (h : n - m ≠ 0) : m < n := + Nat.not_le.1 (mt Nat.sub_eq_zero_of_le h) + +protected theorem sub_ne_zero_iff_lt : n - m ≠ 0 ↔ m < n := + ⟨Nat.lt_of_sub_ne_zero, Nat.sub_ne_zero_of_lt⟩ + +protected theorem lt_of_sub_pos (h : 0 < n - m) : m < n := + Nat.lt_of_sub_ne_zero (Nat.pos_iff_ne_zero.1 h) + +protected theorem lt_of_sub_eq_succ (h : m - n = succ l) : n < m := + Nat.lt_of_sub_pos (h ▸ Nat.zero_lt_succ _) + protected theorem sub_lt_left_of_lt_add {n k m : Nat} (H : n ≤ k) (h : k < n + m) : k - n < m := by have := Nat.sub_le_sub_right (succ_le_of_lt h) n rwa [Nat.add_sub_cancel_left, Nat.succ_sub H] at this @@ -22,7 +106,27 @@ protected theorem sub_lt_left_of_lt_add {n k m : Nat} (H : n ≤ k) (h : k < n + protected theorem sub_lt_right_of_lt_add {n k m : Nat} (H : n ≤ k) (h : k < m + n) : k - n < m := Nat.sub_lt_left_of_lt_add H (Nat.add_comm .. ▸ h) -protected theorem pos_of_ne_zero {n : Nat} : n ≠ 0 → 0 < n := (eq_zero_or_pos n).resolve_left +protected theorem le_of_sub_eq_zero : ∀ {n m}, n - m = 0 → n ≤ m + | 0, _, _ => Nat.zero_le .. + | _+1, _+1, h => Nat.succ_le_succ <| Nat.le_of_sub_eq_zero (Nat.succ_sub_succ .. ▸ h) + +protected theorem le_of_sub_le_sub_right : ∀ {n m k : Nat}, k ≤ m → n - k ≤ m - k → n ≤ m + | 0, _, _, _, _ => Nat.zero_le .. + | _+1, _, 0, _, h₁ => h₁ + | _+1, _+1, _+1, h₀, h₁ => by + simp only [Nat.succ_sub_succ] at h₁ + exact succ_le_succ <| Nat.le_of_sub_le_sub_right (le_of_succ_le_succ h₀) h₁ + +protected theorem sub_le_sub_iff_right {n : Nat} (h : k ≤ m) : n - k ≤ m - k ↔ n ≤ m := + ⟨Nat.le_of_sub_le_sub_right h, fun h => Nat.sub_le_sub_right h _⟩ + +protected theorem sub_eq_iff_eq_add {c : Nat} (h : b ≤ a) : a - b = c ↔ a = c + b := + ⟨fun | rfl => by rw [Nat.sub_add_cancel h], fun heq => by rw [heq, Nat.add_sub_cancel]⟩ + +protected theorem sub_eq_iff_eq_add' {c : Nat} (h : b ≤ a) : a - b = c ↔ a = b + c := by + rw [Nat.add_comm, Nat.sub_eq_iff_eq_add h] + +/-! ### min/max -/ protected theorem min_eq_min (a : Nat) : Nat.min a b = min a b := rfl @@ -52,15 +156,6 @@ protected theorem le_max_left (a b : Nat) : a ≤ max a b := by rw [Nat.max_def] protected theorem le_max_right (a b : Nat) : b ≤ max a b := Nat.max_comm .. ▸ Nat.le_max_left .. -protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide) -@[deprecated] alias pow_two_pos := Nat.two_pow_pos -- deprecated 2024-02-09 - -@[simp] protected theorem not_le {a b : Nat} : ¬ a ≤ b ↔ b < a := - ⟨Nat.gt_of_not_le, Nat.not_le_of_gt⟩ - -@[simp] protected theorem not_lt {a b : Nat} : ¬ a < b ↔ b ≤ a := - ⟨Nat.ge_of_not_lt, flip Nat.not_le_of_gt⟩ - protected theorem le_min_of_le_of_le {a b c : Nat} : a ≤ b → a ≤ c → a ≤ min b c := by intros; cases Nat.le_total b c with | inl h => rw [Nat.min_eq_left h]; assumption @@ -71,3 +166,138 @@ protected theorem le_min {a b c : Nat} : a ≤ min b c ↔ a ≤ b ∧ a ≤ c : fun ⟨h₁, h₂⟩ => Nat.le_min_of_le_of_le h₁ h₂⟩ protected theorem lt_min {a b c : Nat} : a < min b c ↔ a < b ∧ a < c := Nat.le_min + +/-! ### div/mod -/ + +theorem div_eq_sub_div (h₁ : 0 < b) (h₂ : b ≤ a) : a / b = (a - b) / b + 1 := by + rw [div_eq a, if_pos]; constructor <;> assumption + + +theorem mod_add_div (m k : Nat) : m % k + k * (m / k) = m := by + induction m, k using mod.inductionOn with rw [div_eq, mod_eq] + | base x y h => simp [h] + | ind x y h IH => simp [h]; rw [Nat.mul_succ, ← Nat.add_assoc, IH, Nat.sub_add_cancel h.2] + +@[simp] protected theorem div_one (n : Nat) : n / 1 = n := by + have := mod_add_div n 1 + rwa [mod_one, Nat.zero_add, Nat.one_mul] at this + +@[simp] protected theorem div_zero (n : Nat) : n / 0 = 0 := by + rw [div_eq]; simp [Nat.lt_irrefl] + +@[simp] protected theorem zero_div (b : Nat) : 0 / b = 0 := + (div_eq 0 b).trans <| if_neg <| And.rec Nat.not_le_of_gt + +theorem le_div_iff_mul_le (k0 : 0 < k) : x ≤ y / k ↔ x * k ≤ y := by + induction y, k using mod.inductionOn generalizing x with + (rw [div_eq]; simp [h]; cases x with | zero => simp [zero_le] | succ x => ?_) + | base y k h => + simp [not_succ_le_zero x, succ_mul, Nat.add_comm] + refine Nat.lt_of_lt_of_le ?_ (Nat.le_add_right ..) + exact Nat.not_le.1 fun h' => h ⟨k0, h'⟩ + | ind y k h IH => + rw [← add_one, Nat.add_le_add_iff_right, IH k0, succ_mul, + ← Nat.add_sub_cancel (x*k) k, Nat.sub_le_sub_iff_right h.2, Nat.add_sub_cancel] + +theorem div_mul_le_self : ∀ (m n : Nat), m / n * n ≤ m + | m, 0 => by simp + | m, n+1 => (le_div_iff_mul_le (Nat.succ_pos _)).1 (Nat.le_refl _) + +theorem div_lt_iff_lt_mul (Hk : 0 < k) : x / k < y ↔ x < y * k := by + rw [← Nat.not_le, ← Nat.not_le]; exact not_congr (le_div_iff_mul_le Hk) + +@[simp] theorem add_div_right (x : Nat) {z : Nat} (H : 0 < z) : (x + z) / z = succ (x / z) := by + rw [div_eq_sub_div H (Nat.le_add_left _ _), Nat.add_sub_cancel] + +@[simp] theorem add_div_left (x : Nat) {z : Nat} (H : 0 < z) : (z + x) / z = succ (x / z) := by + rw [Nat.add_comm, add_div_right x H] + +theorem add_mul_div_left (x z : Nat) {y : Nat} (H : 0 < y) : (x + y * z) / y = x / y + z := by + induction z with + | zero => rw [Nat.mul_zero, Nat.add_zero, Nat.add_zero] + | succ z ih => rw [mul_succ, ← Nat.add_assoc, add_div_right _ H, ih]; rfl + +theorem add_mul_div_right (x y : Nat) {z : Nat} (H : 0 < z) : (x + y * z) / z = x / z + y := by + rw [Nat.mul_comm, add_mul_div_left _ _ H] + +@[simp] theorem add_mod_right (x z : Nat) : (x + z) % z = x % z := by + rw [mod_eq_sub_mod (Nat.le_add_left ..), Nat.add_sub_cancel] + +@[simp] theorem add_mod_left (x z : Nat) : (x + z) % x = z % x := by + rw [Nat.add_comm, add_mod_right] + +@[simp] theorem add_mul_mod_self_left (x y z : Nat) : (x + y * z) % y = x % y := by + match z with + | 0 => rw [Nat.mul_zero, Nat.add_zero] + | succ z => rw [mul_succ, ← Nat.add_assoc, add_mod_right, add_mul_mod_self_left (z := z)] + +@[simp] theorem add_mul_mod_self_right (x y z : Nat) : (x + y * z) % z = x % z := by + rw [Nat.mul_comm, add_mul_mod_self_left] + +@[simp] theorem mul_mod_right (m n : Nat) : (m * n) % m = 0 := by + rw [← Nat.zero_add (m * n), add_mul_mod_self_left, zero_mod] + +@[simp] theorem mul_mod_left (m n : Nat) : (m * n) % n = 0 := by + rw [Nat.mul_comm, mul_mod_right] + +protected theorem div_eq_of_lt_le (lo : k * n ≤ m) (hi : m < succ k * n) : m / n = k := +have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun hn => by + rw [hn, Nat.mul_zero] at hi lo; exact absurd lo (Nat.not_le_of_gt hi) +Nat.le_antisymm + (le_of_lt_succ ((Nat.div_lt_iff_lt_mul npos).2 hi)) + ((Nat.le_div_iff_mul_le npos).2 lo) + +theorem sub_mul_div (x n p : Nat) (h₁ : n*p ≤ x) : (x - n*p) / n = x / n - p := by + match eq_zero_or_pos n with + | .inl h₀ => rw [h₀, Nat.div_zero, Nat.div_zero, Nat.zero_sub] + | .inr h₀ => induction p with + | zero => rw [Nat.mul_zero, Nat.sub_zero, Nat.sub_zero] + | succ p IH => + have h₂ : n * p ≤ x := Nat.le_trans (Nat.mul_le_mul_left _ (le_succ _)) h₁ + have h₃ : x - n * p ≥ n := by + apply Nat.le_of_add_le_add_right + rw [Nat.sub_add_cancel h₂, Nat.add_comm] + rw [mul_succ] at h₁ + exact h₁ + rw [sub_succ, ← IH h₂, div_eq_sub_div h₀ h₃] + simp [add_one, Nat.pred_succ, mul_succ, Nat.sub_sub] + +theorem mul_sub_div (x n p : Nat) (h₁ : x < n*p) : (n * p - succ x) / n = p - succ (x / n) := by + have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun n0 => by + rw [n0, Nat.zero_mul] at h₁; exact not_lt_zero _ h₁ + apply Nat.div_eq_of_lt_le + · rw [Nat.mul_sub_right_distrib, Nat.mul_comm] + exact Nat.sub_le_sub_left ((div_lt_iff_lt_mul npos).1 (lt_succ_self _)) _ + · show succ (pred (n * p - x)) ≤ (succ (pred (p - x / n))) * n + rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁), + fun h => succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)] -- TODO: why is the function needed? + · rw [Nat.mul_sub_right_distrib, Nat.mul_comm] + exact Nat.sub_le_sub_left (div_mul_le_self ..) _ + · rwa [div_lt_iff_lt_mul npos, Nat.mul_comm] + +theorem mul_mod_mul_left (z x y : Nat) : (z * x) % (z * y) = z * (x % y) := + if y0 : y = 0 then by + rw [y0, Nat.mul_zero, mod_zero, mod_zero] + else if z0 : z = 0 then by + rw [z0, Nat.zero_mul, Nat.zero_mul, Nat.zero_mul, mod_zero] + else by + induction x using Nat.strongInductionOn with + | _ n IH => + have y0 : y > 0 := Nat.pos_of_ne_zero y0 + have z0 : z > 0 := Nat.pos_of_ne_zero z0 + cases Nat.lt_or_ge n y with + | inl yn => rw [mod_eq_of_lt yn, mod_eq_of_lt (Nat.mul_lt_mul_of_pos_left yn z0)] + | inr yn => + rw [mod_eq_sub_mod yn, mod_eq_sub_mod (Nat.mul_le_mul_left z yn), + ← Nat.mul_sub_left_distrib] + exact IH _ (sub_lt (Nat.lt_of_lt_of_le y0 yn) y0) + +theorem div_eq_of_lt (h₀ : a < b) : a / b = 0 := by + rw [div_eq a, if_neg] + intro h₁ + apply Nat.not_le_of_gt h₀ h₁.right + +/-! ### pow -/ + +protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide) +@[deprecated] alias pow_two_pos := Nat.two_pow_pos -- deprecated 2024-02-09 diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index cf1799d664..223f7b7273 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -6,6 +6,7 @@ Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro import Std.Tactic.Alias import Std.Tactic.Init import Std.Data.Nat.Init.Lemmas +import Std.Data.Nat.Init.Dvd import Std.Data.Nat.Basic import Std.Data.Ord @@ -141,20 +142,6 @@ theorem recDiagOn_succ_succ {motive : Nat → Nat → Sort _} (zero_zero : motiv /-! ### le/lt -/ -theorem ne_of_gt {a b : Nat} (h : b < a) : a ≠ b := (ne_of_lt h).symm -alias ne_of_lt' := ne_of_gt - -protected alias ⟨lt_of_not_ge, _⟩ := Nat.not_le -protected alias ⟨lt_of_not_le, not_le_of_lt⟩ := Nat.not_le -protected alias ⟨_, lt_le_asymm⟩ := Nat.not_le - -protected alias ⟨le_of_not_gt, not_lt_of_ge⟩ := Nat.not_lt -protected alias ⟨le_of_not_lt, not_lt_of_le⟩ := Nat.not_lt -protected alias ⟨_, le_lt_asymm⟩ := Nat.not_lt - -protected theorem le_of_not_le {a b : Nat} (h : ¬ b ≤ a) : a ≤ b := Nat.le_of_lt (Nat.not_le.1 h) -protected alias le_of_not_ge := Nat.le_of_not_le - protected theorem lt_asymm {a b : Nat} (h : a < b) : ¬ b < a := Nat.not_lt.2 (Nat.le_of_lt h) protected alias not_lt_of_gt := Nat.lt_asymm protected alias not_lt_of_lt := Nat.lt_asymm @@ -166,16 +153,6 @@ protected alias lt_iff_le_and_not_ge := Nat.lt_iff_le_not_le protected theorem lt_iff_le_and_ne {m n : Nat} : m < n ↔ m ≤ n ∧ m ≠ n := ⟨fun h => ⟨Nat.le_of_lt h, Nat.ne_of_lt h⟩, fun h => Nat.lt_of_le_of_ne h.1 h.2⟩ -protected theorem le_antisymm_iff {a b : Nat} : a = b ↔ a ≤ b ∧ b ≤ a := - ⟨fun | rfl => ⟨Nat.le_refl _, Nat.le_refl _⟩, fun ⟨hle, hge⟩ => Nat.le_antisymm hle hge⟩ -protected alias eq_iff_le_and_ge := Nat.le_antisymm_iff - -protected theorem lt_or_gt_of_ne {a b : Nat} : a ≠ b → a < b ∨ b < a := by - rw [← Nat.not_le, ← Nat.not_le, ← Decidable.not_and_iff_or_not_not, and_comm] - exact mt Nat.le_antisymm_iff.2 -protected alias lt_or_lt_of_ne := Nat.lt_or_gt_of_ne -@[deprecated] protected alias lt_connex := Nat.lt_or_gt_of_ne - protected theorem ne_iff_lt_or_gt {a b : Nat} : a ≠ b ↔ a < b ∨ b < a := ⟨Nat.lt_or_gt_of_ne, fun | .inl h => Nat.ne_of_lt h | .inr h => Nat.ne_of_gt h⟩ protected alias lt_or_gt := Nat.ne_iff_lt_or_gt @@ -264,8 +241,6 @@ protected def sum_trichotomy (a b : Nat) : a < b ⊕' a = b ⊕' b < a := /-! ## zero/one/two -/ -protected theorem pos_iff_ne_zero : 0 < n ↔ n ≠ 0 := ⟨ne_of_gt, Nat.pos_of_ne_zero⟩ - theorem le_zero : i ≤ 0 ↔ i = 0 := ⟨Nat.eq_zero_of_le_zero, fun | rfl => Nat.le_refl _⟩ protected alias one_pos := Nat.zero_lt_one @@ -295,9 +270,6 @@ theorem lt_succ : m < succ n ↔ m ≤ n := ⟨le_of_lt_succ, lt_succ_of_le⟩ theorem lt_succ_of_lt (h : a < b) : a < succ b := le_succ_of_le h -theorem succ_pred_eq_of_pos : ∀ {n}, 0 < n → succ (pred n) = n - | _+1, _ => rfl - theorem succ_pred_eq_of_ne_zero : ∀ {n}, n ≠ 0 → succ (pred n) = n | _+1, _ => rfl @@ -305,9 +277,6 @@ theorem eq_zero_or_eq_succ_pred : ∀ n, n = 0 ∨ n = succ (pred n) | 0 => .inl rfl | _+1 => .inr rfl -theorem exists_eq_succ_of_ne_zero : ∀ {n}, n ≠ 0 → ∃ k, n = succ k - | _+1, _ => ⟨_, rfl⟩ - theorem succ_inj' : succ a = succ b ↔ a = b := ⟨succ.inj, congrArg _⟩ theorem succ_le_succ_iff : succ a ≤ succ b ↔ a ≤ b := ⟨le_of_succ_le_succ, succ_le_succ⟩ @@ -362,16 +331,9 @@ theorem succ_eq_one_add (n) : succ n = 1 + n := (one_add _).symm theorem succ_add_eq_add_succ (a b) : succ a + b = a + succ b := Nat.succ_add .. @[deprecated] alias succ_add_eq_succ_add := Nat.succ_add_eq_add_succ -theorem eq_zero_of_add_eq_zero : ∀ {n m}, n + m = 0 → n = 0 ∧ m = 0 - | 0, 0, _ => ⟨rfl, rfl⟩ - | _+1, 0, h => Nat.noConfusion h - protected theorem eq_zero_of_add_eq_zero_right (h : n + m = 0) : n = 0 := (Nat.eq_zero_of_add_eq_zero h).1 -protected theorem eq_zero_of_add_eq_zero_left (h : n + m = 0) : m = 0 := - (Nat.eq_zero_of_add_eq_zero h).2 - protected theorem add_eq_zero_iff : n + m = 0 ↔ n = 0 ∧ m = 0 := ⟨Nat.eq_zero_of_add_eq_zero, fun ⟨h₁, h₂⟩ => h₂.symm ▸ h₁⟩ @@ -384,9 +346,6 @@ protected theorem add_right_cancel_iff {n : Nat} : m + n = k + n ↔ m = k := protected theorem add_le_add_iff_left {n : Nat} : n + m ≤ n + k ↔ m ≤ k := ⟨Nat.le_of_add_le_add_left, fun h => Nat.add_le_add_left h _⟩ -protected theorem add_le_add_iff_right {n : Nat} : m + n ≤ k + n ↔ m ≤ k := - ⟨Nat.le_of_add_le_add_right, fun h => Nat.add_le_add_right h _⟩ - protected theorem lt_of_add_lt_add_right : ∀ {n : Nat}, k + n < m + n → k < m | 0, h => h | _+1, h => Nat.lt_of_add_lt_add_right (Nat.lt_of_succ_lt_succ h) @@ -443,8 +402,6 @@ protected theorem add_self_ne_one : ∀ n, n + n ≠ 1 /-! ## sub -/ -attribute [simp] Nat.zero_sub Nat.add_sub_cancel succ_sub_succ_eq_sub - protected theorem sub_one (n) : n - 1 = pred n := rfl protected theorem one_sub : ∀ n, 1 - n = if n = 0 then 1 else 0 @@ -468,12 +425,6 @@ protected theorem add_one_sub_one (n : Nat) : (n + 1) - 1 = n := rfl protected theorem one_add_sub_one (n : Nat) : (1 + n) - 1 = n := Nat.add_sub_cancel_left 1 _ -protected theorem sub_eq_iff_eq_add {c : Nat} (h : b ≤ a) : a - b = c ↔ a = c + b := - ⟨fun | rfl => by rw [Nat.sub_add_cancel h], fun heq => by rw [heq, Nat.add_sub_cancel]⟩ - -protected theorem sub_eq_iff_eq_add' {c : Nat} (h : b ≤ a) : a - b = c ↔ a = b + c := by - rw [Nat.add_comm, Nat.sub_eq_iff_eq_add h] - protected theorem sub_sub_self {n m : Nat} (h : m ≤ n) : n - (n - m) = m := (Nat.sub_eq_iff_eq_add (Nat.sub_le ..)).2 (Nat.add_sub_of_le h).symm @@ -481,31 +432,12 @@ protected theorem sub_add_comm {n m k : Nat} (h : k ≤ n) : n + m - k = n - k + rw [Nat.sub_eq_iff_eq_add (Nat.le_trans h (Nat.le_add_right ..))] rwa [Nat.add_right_comm, Nat.sub_add_cancel] -protected theorem le_of_sub_eq_zero : ∀ {n m}, n - m = 0 → n ≤ m - | 0, _, _ => Nat.zero_le .. - | _+1, _+1, h => Nat.succ_le_succ <| Nat.le_of_sub_eq_zero (Nat.succ_sub_succ .. ▸ h) - protected theorem sub_eq_zero_iff_le : n - m = 0 ↔ n ≤ m := ⟨Nat.le_of_sub_eq_zero, Nat.sub_eq_zero_of_le⟩ -protected theorem lt_of_sub_ne_zero (h : n - m ≠ 0) : m < n := - Nat.not_le.1 (mt Nat.sub_eq_zero_of_le h) - -protected theorem sub_ne_zero_iff_lt : n - m ≠ 0 ↔ m < n := - ⟨Nat.lt_of_sub_ne_zero, Nat.sub_ne_zero_of_lt⟩ - -protected theorem sub_pos_of_lt (h : m < n) : 0 < n - m := - Nat.pos_iff_ne_zero.2 (Nat.sub_ne_zero_of_lt h) - -protected theorem lt_of_sub_pos (h : 0 < n - m) : m < n := - Nat.lt_of_sub_ne_zero (Nat.pos_iff_ne_zero.1 h) - protected theorem sub_pos_iff_lt : 0 < n - m ↔ m < n := ⟨Nat.lt_of_sub_pos, Nat.sub_pos_of_lt⟩ -protected theorem lt_of_sub_eq_succ (h : m - n = succ l) : n < m := - Nat.lt_of_sub_pos (h ▸ Nat.zero_lt_succ _) - protected theorem sub_le_iff_le_add {a b c : Nat} : a - b ≤ c ↔ a ≤ c + b := ⟨Nat.le_add_of_sub_le, sub_le_of_le_add⟩ @@ -532,21 +464,8 @@ protected theorem le_sub_of_add_le' {n k m : Nat} : m + n ≤ k → n ≤ k - m protected theorem le_sub_iff_add_le' {n : Nat} (h : k ≤ m) : n ≤ m - k ↔ k + n ≤ m := ⟨Nat.add_le_of_le_sub' h, Nat.le_sub_of_add_le'⟩ -protected theorem le_of_sub_le_sub_right : ∀ {n m k : Nat}, k ≤ m → n - k ≤ m - k → n ≤ m - | 0, _, _, _, _ => Nat.zero_le .. - | _+1, _, 0, _, h₁ => h₁ - | _+1, _+1, _+1, h₀, h₁ => by - simp only [Nat.succ_sub_succ] at h₁ - exact succ_le_succ <| Nat.le_of_sub_le_sub_right (le_of_succ_le_succ h₀) h₁ @[deprecated] protected alias le_of_le_of_sub_le_sub_right := Nat.le_of_sub_le_sub_right -protected theorem sub_le_sub_iff_right {n : Nat} (h : k ≤ m) : n - k ≤ m - k ↔ n ≤ m := - ⟨Nat.le_of_sub_le_sub_right h, fun h => Nat.sub_le_sub_right h _⟩ - -protected theorem sub_le_sub_left (h : n ≤ m) (k : Nat) : k - m ≤ k - n := - match m, le.dest h with - | _, ⟨a, rfl⟩ => by rw [← Nat.sub_sub]; apply sub_le - protected theorem le_of_sub_le_sub_left : ∀ {n k m : Nat}, n ≤ k → k - m ≤ k - n → n ≤ m | 0, _, _, _, _ => Nat.zero_le .. | _+1, _, 0, h₀, h₁ => @@ -883,32 +802,6 @@ protected theorem pos_of_mul_pos_right {a b : Nat} (h : 0 < a * b) : 0 < a := by -- TODO div_core_congr, div_def -theorem mod_add_div (m k : Nat) : m % k + k * (m / k) = m := by - induction m, k using mod.inductionOn with rw [div_eq, mod_eq] - | base x y h => simp [h] - | ind x y h IH => simp [h]; rw [Nat.mul_succ, ← Nat.add_assoc, IH, Nat.sub_add_cancel h.2] - -@[simp] protected theorem div_one (n : Nat) : n / 1 = n := by - have := mod_add_div n 1 - rwa [mod_one, Nat.zero_add, Nat.one_mul] at this - -@[simp] protected theorem div_zero (n : Nat) : n / 0 = 0 := by - rw [div_eq]; simp [Nat.lt_irrefl] - -@[simp] protected theorem zero_div (b : Nat) : 0 / b = 0 := - (div_eq 0 b).trans <| if_neg <| And.rec Nat.not_le_of_gt - -theorem le_div_iff_mul_le (k0 : 0 < k) : x ≤ y / k ↔ x * k ≤ y := by - induction y, k using mod.inductionOn generalizing x with - (rw [div_eq]; simp [h]; cases x with | zero => simp [zero_le] | succ x => ?_) - | base y k h => - simp [not_succ_le_zero x, succ_mul, Nat.add_comm] - refine Nat.lt_of_lt_of_le ?_ (Nat.le_add_right ..) - exact Nat.not_le.1 fun h' => h ⟨k0, h'⟩ - | ind y k h IH => - rw [← add_one, Nat.add_le_add_iff_right, IH k0, succ_mul, - ← Nat.add_sub_cancel (x*k) k, Nat.sub_le_sub_iff_right h.2, Nat.add_sub_cancel] - protected theorem div_le_of_le_mul {m n : Nat} : ∀ {k}, m ≤ k * n → m / k ≤ n | 0, _ => by simp [Nat.div_zero, n.zero_le] | succ k, h => by @@ -920,42 +813,6 @@ protected theorem div_le_of_le_mul {m n : Nat} : ∀ {k}, m ≤ k * n → m / k rw [← h2] at h3 exact Nat.le_trans h1 h3 -theorem div_eq_sub_div (h₁ : 0 < b) (h₂ : b ≤ a) : a / b = (a - b) / b + 1 := by - rw [div_eq a, if_pos]; constructor <;> assumption - -theorem div_eq_of_lt (h₀ : a < b) : a / b = 0 := by - rw [div_eq a, if_neg] - intro h₁ - apply Nat.not_le_of_gt h₀ h₁.right - -theorem div_lt_iff_lt_mul (Hk : 0 < k) : x / k < y ↔ x < y * k := by - rw [← Nat.not_le, ← Nat.not_le]; exact not_congr (le_div_iff_mul_le Hk) - -theorem sub_mul_div (x n p : Nat) (h₁ : n*p ≤ x) : (x - n*p) / n = x / n - p := by - match eq_zero_or_pos n with - | .inl h₀ => rw [h₀, Nat.div_zero, Nat.div_zero, Nat.zero_sub] - | .inr h₀ => induction p with - | zero => rw [Nat.mul_zero, Nat.sub_zero, Nat.sub_zero] - | succ p IH => - have h₂ : n * p ≤ x := Nat.le_trans (Nat.mul_le_mul_left _ (le_succ _)) h₁ - have h₃ : x - n * p ≥ n := by - apply Nat.le_of_add_le_add_right - rw [Nat.sub_add_cancel h₂, Nat.add_comm] - rw [mul_succ] at h₁ - exact h₁ - rw [sub_succ, ← IH h₂, div_eq_sub_div h₀ h₃] - simp [add_one, Nat.pred_succ, mul_succ, Nat.sub_sub] - -theorem div_mul_le_self : ∀ (m n : Nat), m / n * n ≤ m - | m, 0 => by simp - | m, n+1 => (le_div_iff_mul_le (Nat.succ_pos _)).1 (Nat.le_refl _) - -@[simp] theorem add_div_right (x : Nat) {z : Nat} (H : 0 < z) : (x + z) / z = succ (x / z) := by - rw [div_eq_sub_div H (Nat.le_add_left _ _), Nat.add_sub_cancel] - -@[simp] theorem add_div_left (x : Nat) {z : Nat} (H : 0 < z) : (z + x) / z = succ (x / z) := by - rw [Nat.add_comm, add_div_right x H] - @[simp] theorem mul_div_right (n : Nat) {m : Nat} (H : 0 < m) : m * n / m = n := by induction n <;> simp_all [mul_succ] @@ -966,14 +823,6 @@ protected theorem div_self (H : 0 < n) : n / n = 1 := by let t := add_div_right 0 H rwa [Nat.zero_add, Nat.zero_div] at t -theorem add_mul_div_left (x z : Nat) {y : Nat} (H : 0 < y) : (x + y * z) / y = x / y + z := by - induction z with - | zero => rw [Nat.mul_zero, Nat.add_zero, Nat.add_zero] - | succ z ih => rw [mul_succ, ← Nat.add_assoc, add_div_right _ H, ih]; rfl - -theorem add_mul_div_right (x y : Nat) {z : Nat} (H : 0 < z) : (x + y * z) / z = x / z + y := by - rw [Nat.mul_comm, add_mul_div_left _ _ H] - protected theorem mul_div_cancel (m : Nat) {n : Nat} (H : 0 < n) : m * n / n = m := by let t := add_mul_div_right 0 m H rwa [Nat.zero_add, Nat.zero_div, Nat.zero_add] at t @@ -987,25 +836,6 @@ by rw [H2, Nat.mul_div_cancel _ H1] protected theorem div_eq_of_eq_mul_right (H1 : 0 < n) (H2 : m = n * k) : m / n = k := by rw [H2, Nat.mul_div_cancel_left _ H1] -protected theorem div_eq_of_lt_le (lo : k * n ≤ m) (hi : m < succ k * n) : m / n = k := -have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun hn => by - rw [hn, Nat.mul_zero] at hi lo; exact absurd lo (Nat.not_le_of_gt hi) -Nat.le_antisymm - (le_of_lt_succ ((Nat.div_lt_iff_lt_mul npos).2 hi)) - ((Nat.le_div_iff_mul_le npos).2 lo) - -theorem mul_sub_div (x n p : Nat) (h₁ : x < n*p) : (n * p - succ x) / n = p - succ (x / n) := by - have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun n0 => by - rw [n0, Nat.zero_mul] at h₁; exact not_lt_zero _ h₁ - apply Nat.div_eq_of_lt_le - · rw [Nat.mul_sub_right_distrib, Nat.mul_comm] - exact Nat.sub_le_sub_left ((div_lt_iff_lt_mul npos).1 (lt_succ_self _)) _ - · show succ (pred (n * p - x)) ≤ (succ (pred (p - x / n))) * n - rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁), - fun h => succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)] -- TODO: why is the function needed? - · rw [Nat.mul_sub_right_distrib, Nat.mul_comm] - exact Nat.sub_le_sub_left (div_mul_le_self ..) _ - · rwa [div_lt_iff_lt_mul npos, Nat.mul_comm] protected theorem div_div_eq_div_mul (m n k : Nat) : m / n / k = m / (n * k) := by cases eq_zero_or_pos k with @@ -1043,43 +873,6 @@ theorem mod_two_eq_zero_or_one (n : Nat) : n % 2 = 0 ∨ n % 2 = 1 := theorem le_of_mod_lt {a b : Nat} (h : a % b < a) : b ≤ a := Nat.not_lt.1 fun hf => (ne_of_lt h).elim (Nat.mod_eq_of_lt hf) -@[simp] theorem add_mod_right (x z : Nat) : (x + z) % z = x % z := by - rw [mod_eq_sub_mod (Nat.le_add_left ..), Nat.add_sub_cancel] - -@[simp] theorem add_mod_left (x z : Nat) : (x + z) % x = z % x := by - rw [Nat.add_comm, add_mod_right] - -@[simp] theorem add_mul_mod_self_left (x y z : Nat) : (x + y * z) % y = x % y := by - match z with - | 0 => rw [Nat.mul_zero, Nat.add_zero] - | succ z => rw [mul_succ, ← Nat.add_assoc, add_mod_right, add_mul_mod_self_left (z := z)] - -@[simp] theorem add_mul_mod_self_right (x y z : Nat) : (x + y * z) % z = x % z := by - rw [Nat.mul_comm, add_mul_mod_self_left] - -@[simp] theorem mul_mod_right (m n : Nat) : (m * n) % m = 0 := by - rw [← Nat.zero_add (m * n), add_mul_mod_self_left, zero_mod] - -@[simp] theorem mul_mod_left (m n : Nat) : (m * n) % n = 0 := by - rw [Nat.mul_comm, mul_mod_right] - -theorem mul_mod_mul_left (z x y : Nat) : (z * x) % (z * y) = z * (x % y) := - if y0 : y = 0 then by - rw [y0, Nat.mul_zero, mod_zero, mod_zero] - else if z0 : z = 0 then by - rw [z0, Nat.zero_mul, Nat.zero_mul, Nat.zero_mul, mod_zero] - else by - induction x using Nat.strongInductionOn with - | _ n IH => - have y0 : y > 0 := Nat.pos_of_ne_zero y0 - have z0 : z > 0 := Nat.pos_of_ne_zero z0 - cases Nat.lt_or_ge n y with - | inl yn => rw [mod_eq_of_lt yn, mod_eq_of_lt (Nat.mul_lt_mul_of_pos_left yn z0)] - | inr yn => - rw [mod_eq_sub_mod yn, mod_eq_sub_mod (Nat.mul_le_mul_left z yn), - ← Nat.mul_sub_left_distrib] - exact IH _ (sub_lt (Nat.lt_of_lt_of_le y0 yn) y0) - theorem mul_mod_mul_right (z x y : Nat) : (x * z) % (y * z) = (x % y) * z := by rw [Nat.mul_comm x z, Nat.mul_comm y z, Nat.mul_comm (x % y) z]; apply mul_mod_mul_left @@ -1276,37 +1069,6 @@ theorem lt_log2_self : n < 2 ^ (n.log2 + 1) := /-! ### dvd -/ -protected theorem dvd_refl (a : Nat) : a ∣ a := ⟨1, by simp⟩ - -protected theorem dvd_zero (a : Nat) : a ∣ 0 := ⟨0, by simp⟩ - -protected theorem dvd_mul_left (a b : Nat) : a ∣ b * a := ⟨b, Nat.mul_comm b a⟩ - -protected theorem dvd_mul_right (a b : Nat) : a ∣ a * b := ⟨b, rfl⟩ - -protected theorem dvd_trans {a b c : Nat} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c := - match h₁, h₂ with - | ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ => - ⟨d * e, show c = a * (d * e) by simp[h₃,h₄, Nat.mul_assoc]⟩ - -protected theorem eq_zero_of_zero_dvd {a : Nat} (h : 0 ∣ a) : a = 0 := - let ⟨c, H'⟩ := h; H'.trans c.zero_mul - -@[simp] protected theorem zero_dvd {n : Nat} : 0 ∣ n ↔ n = 0 := - ⟨Nat.eq_zero_of_zero_dvd, fun h => h.symm ▸ Nat.dvd_zero 0⟩ - -protected theorem dvd_add {a b c : Nat} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := - let ⟨d, hd⟩ := h₁; let ⟨e, he⟩ := h₂; ⟨d + e, by simp [Nat.left_distrib, hd, he]⟩ - -protected theorem dvd_add_iff_right {k m n : Nat} (h : k ∣ m) : k ∣ n ↔ k ∣ m + n := - ⟨Nat.dvd_add h, - match m, h with - | _, ⟨d, rfl⟩ => fun ⟨e, he⟩ => - ⟨e - d, by rw [Nat.mul_sub_left_distrib, ← he, Nat.add_sub_cancel_left]⟩⟩ - -protected theorem dvd_add_iff_left {k m n : Nat} (h : k ∣ n) : k ∣ m ↔ k ∣ m + n := by - rw [Nat.add_comm]; exact Nat.dvd_add_iff_right h - theorem dvd_sub {k m n : Nat} (H : n ≤ m) (h₁ : k ∣ m) (h₂ : k ∣ n) : k ∣ m - n := (Nat.dvd_add_iff_left h₂).2 <| by rwa [Nat.sub_add_cancel H] @@ -1320,62 +1082,9 @@ protected theorem mul_dvd_mul_left (a : Nat) (h : b ∣ c) : a * b ∣ a * c := protected theorem mul_dvd_mul_right (h: a ∣ b) (c : Nat) : a * c ∣ b * c := Nat.mul_dvd_mul h (Nat.dvd_refl c) -theorem dvd_mod_iff {k m n : Nat} (h: k ∣ n) : k ∣ m % n ↔ k ∣ m := - have := Nat.dvd_add_iff_left <| Nat.dvd_trans h <| Nat.dvd_mul_right n (m / n) - by rwa [mod_add_div] at this - -theorem le_of_dvd {m n : Nat} (h : 0 < n) : m ∣ n → m ≤ n - | ⟨k, e⟩ => by - revert h - rw [e] - match k with - | 0 => intro hn; simp at hn - | pk+1 => - intro - have := Nat.mul_le_mul_left m (succ_pos pk) - rwa [Nat.mul_one] at this - -protected theorem dvd_antisymm : ∀ {m n : Nat}, m ∣ n → n ∣ m → m = n - | _, 0, _, h₂ => Nat.eq_zero_of_zero_dvd h₂ - | 0, _, h₁, _ => (Nat.eq_zero_of_zero_dvd h₁).symm - | _+1, _+1, h₁, h₂ => Nat.le_antisymm (le_of_dvd (succ_pos _) h₁) (le_of_dvd (succ_pos _) h₂) - -theorem pos_of_dvd_of_pos {m n : Nat} (H1 : m ∣ n) (H2 : 0 < n) : 0 < m := - Nat.pos_of_ne_zero fun m0 => Nat.ne_of_gt H2 <| Nat.eq_zero_of_zero_dvd (m0 ▸ H1) - -@[simp] protected theorem one_dvd (n : Nat) : 1 ∣ n := ⟨n, n.one_mul.symm⟩ - -theorem eq_one_of_dvd_one {n : Nat} (H : n ∣ 1) : n = 1 := - Nat.dvd_antisymm H n.one_dvd - @[simp] theorem dvd_one {n : Nat} : n ∣ 1 ↔ n = 1 := ⟨eq_one_of_dvd_one, fun h => h.symm ▸ Nat.dvd_refl _⟩ -theorem dvd_of_mod_eq_zero {m n : Nat} (H : n % m = 0) : m ∣ n := by - exists n / m - have := (mod_add_div n m).symm - rwa [H, Nat.zero_add] at this - -theorem mod_eq_zero_of_dvd {m n : Nat} (H : m ∣ n) : n % m = 0 := by - let ⟨z, H⟩ := H; rw [H, mul_mod_right] - -theorem dvd_iff_mod_eq_zero (m n : Nat) : m ∣ n ↔ n % m = 0 := - ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ - -theorem emod_pos_of_not_dvd {a b : Nat} (h : ¬ a ∣ b) : 0 < b % a := by - rw [dvd_iff_mod_eq_zero] at h - exact Nat.pos_of_ne_zero h - -instance decidable_dvd : @DecidableRel Nat (·∣·) := - fun _ _ => decidable_of_decidable_of_iff (dvd_iff_mod_eq_zero _ _).symm - -protected theorem mul_div_cancel' {n m : Nat} (H : n ∣ m) : n * (m / n) = m := by - have := mod_add_div m n - rwa [mod_eq_zero_of_dvd H, Nat.zero_add] at this - -protected theorem div_mul_cancel {n m : Nat} (H : n ∣ m) : m / n * n = m := by - rw [Nat.mul_comm, Nat.mul_div_cancel' H] - protected theorem mul_div_assoc (m : Nat) (H : k ∣ n) : m * n / k = m * (n / k) := by match Nat.eq_zero_or_pos k with | .inl h0 => rw [h0, Nat.div_zero, Nat.div_zero, Nat.mul_zero] diff --git a/Std/Lean/Meta/LazyDiscrTree.lean b/Std/Lean/Meta/LazyDiscrTree.lean index f8b0adadd8..75818cd497 100644 --- a/Std/Lean/Meta/LazyDiscrTree.lean +++ b/Std/Lean/Meta/LazyDiscrTree.lean @@ -6,7 +6,6 @@ Authors: Joe Hendrix, Scott Morrison import Lean.Meta.DiscrTree import Std.Lean.Name -import Std.Data.Nat.Init.Lemmas /-! # Lazy Discrimination Tree diff --git a/Std/Tactic/Omega/Constraint.lean b/Std/Tactic/Omega/Constraint.lean index dde6b031bd..1bdcb00fd6 100644 --- a/Std/Tactic/Omega/Constraint.lean +++ b/Std/Tactic/Omega/Constraint.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Classes.Order +import Std.Data.Option.Lemmas import Std.Tactic.Omega.Coeffs.IntList - /-! A `Constraint` consists of an optional lower and upper bound (inclusive), constraining a value to a set of the form `∅`, `{x}`, `[x, y]`, `[x, ∞)`, `(-∞, y]`, or `(-∞, ∞)`. diff --git a/Std/Tactic/Omega/IntList.lean b/Std/Tactic/Omega/IntList.lean index e4eac5f771..8ba59d285f 100644 --- a/Std/Tactic/Omega/IntList.lean +++ b/Std/Tactic/Omega/IntList.lean @@ -4,9 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.List.Init.Lemmas -import Std.Data.Nat.Gcd +import Std.Data.Nat.Init.Gcd import Std.Data.Int.Init.DivMod -import Std.Data.Option.Lemmas +import Std.Data.Option.Init.Lemmas +--import Std.Tactic.Replace import Std.Tactic.Simpa /-- diff --git a/Std/Tactic/Omega/MinNatAbs.lean b/Std/Tactic/Omega/MinNatAbs.lean index 274d2c6ddc..88621f0709 100644 --- a/Std/Tactic/Omega/MinNatAbs.lean +++ b/Std/Tactic/Omega/MinNatAbs.lean @@ -6,6 +6,7 @@ Authors: Scott Morrison import Std.Data.List.Init.Lemmas import Std.Data.Int.Init.Order import Std.Data.Option.Lemmas +import Std.Tactic.Init /-! # `List.nonzeroMinimum`, `List.minNatAbs`, `List.maxNatAbs` From 1035b74fe345abbd2e3b6ff9d3a79655ac46ecbb Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Wed, 14 Feb 2024 11:55:51 -0800 Subject: [PATCH 039/213] chore: remove Std.Data.Nat.Init.Lemmas due to upstream --- Std/Data/Array/Init/Lemmas.lean | 1 - Std/Data/Fin/Basic.lean | 1 - Std/Data/Int/Init/Lemmas.lean | 1 - Std/Data/Int/Init/Order.lean | 1 + Std/Data/Int/Order.lean | 1 + Std/Data/List/Init/Lemmas.lean | 1 - Std/Data/Nat.lean | 3 - Std/Data/Nat/Init/Basic.lean | 9 - Std/Data/Nat/Init/Dvd.lean | 3 - Std/Data/Nat/Init/Gcd.lean | 1 - Std/Data/Nat/Init/Lemmas.lean | 303 -------------------------------- Std/Data/Nat/Lemmas.lean | 13 +- Std/Data/UInt.lean | 1 - test.lean | 9 + 14 files changed, 17 insertions(+), 331 deletions(-) delete mode 100644 Std/Data/Nat/Init/Basic.lean delete mode 100644 Std/Data/Nat/Init/Lemmas.lean create mode 100644 test.lean diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index c5ba59a600..5469109a5d 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -7,7 +7,6 @@ import Std.Tactic.HaveI import Std.Data.Bool import Std.Classes.LawfulMonad import Std.Data.Fin.Init.Lemmas -import Std.Data.Nat.Init.Lemmas import Std.Data.List.Init.Lemmas /-! diff --git a/Std/Data/Fin/Basic.lean b/Std/Data/Fin/Basic.lean index 109f92892f..b3f65ed516 100644 --- a/Std/Data/Fin/Basic.lean +++ b/Std/Data/Fin/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2017 Robert Y. Lewis. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Robert Y. Lewis, Keeley Hoek, Mario Carneiro -/ -import Std.Data.Nat.Init.Lemmas namespace Fin diff --git a/Std/Data/Int/Init/Lemmas.lean b/Std/Data/Int/Init/Lemmas.lean index 97ead4750d..8ea82a6871 100644 --- a/Std/Data/Int/Init/Lemmas.lean +++ b/Std/Data/Int/Init/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Classes.Cast -import Std.Data.Nat.Init.Lemmas import Std.Data.Int.Basic import Std.Tactic.NormCast.Lemmas diff --git a/Std/Data/Int/Init/Order.lean b/Std/Data/Int/Init/Order.lean index ff7c8ce21a..d2902119bb 100644 --- a/Std/Data/Int/Init/Order.lean +++ b/Std/Data/Int/Init/Order.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Data.Int.Init.Lemmas +import Std.Tactic.Alias /-! # Results about the order properties of the integers, and the integers as an ordered ring. diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 8bb6b5f89f..3066450b91 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -3,6 +3,7 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ +import Std.Data.Nat.Lemmas import Std.Data.Int.Init.Order import Std.Data.Option.Basic import Std.Tactic.Omega diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean index bb7948de08..2baceaceb4 100644 --- a/Std/Data/List/Init/Lemmas.lean +++ b/Std/Data/List/Init/Lemmas.lean @@ -4,7 +4,6 @@ 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 -/ import Std.Classes.SetNotation -import Std.Data.Nat.Init.Lemmas import Std.Data.List.Init.Basic namespace List diff --git a/Std/Data/Nat.lean b/Std/Data/Nat.lean index 959a5fe27d..5527f9c7df 100644 --- a/Std/Data/Nat.lean +++ b/Std/Data/Nat.lean @@ -1,8 +1,5 @@ -import Std.Data.Nat.Basic import Std.Data.Nat.Bitwise import Std.Data.Nat.Gcd -import Std.Data.Nat.Init.Basic import Std.Data.Nat.Init.Dvd import Std.Data.Nat.Init.Gcd -import Std.Data.Nat.Init.Lemmas import Std.Data.Nat.Lemmas diff --git a/Std/Data/Nat/Init/Basic.lean b/Std/Data/Nat/Init/Basic.lean deleted file mode 100644 index 77d9112496..0000000000 --- a/Std/Data/Nat/Init/Basic.lean +++ /dev/null @@ -1,9 +0,0 @@ -namespace Nat - -/-- -Divisibility of natural numbers. `a ∣ b` (typed as `\|`) says that -there is some `c` such that `b = a * c`. --/ -instance : Dvd Nat := ⟨fun a b => ∃ c, b = a * c⟩ - -end Nat diff --git a/Std/Data/Nat/Init/Dvd.lean b/Std/Data/Nat/Init/Dvd.lean index c4a4f9ca9d..4250e8ef64 100644 --- a/Std/Data/Nat/Init/Dvd.lean +++ b/Std/Data/Nat/Init/Dvd.lean @@ -1,6 +1,3 @@ -import Std.Data.Nat.Init.Basic -import Std.Data.Nat.Init.Lemmas - namespace Nat protected theorem dvd_refl (a : Nat) : a ∣ a := ⟨1, by simp⟩ diff --git a/Std/Data/Nat/Init/Gcd.lean b/Std/Data/Nat/Init/Gcd.lean index 27dbc299ca..d1e77b1d45 100644 --- a/Std/Data/Nat/Init/Gcd.lean +++ b/Std/Data/Nat/Init/Gcd.lean @@ -1,4 +1,3 @@ -import Std.Data.Nat.Init.Basic import Std.Data.Nat.Init.Dvd namespace Nat diff --git a/Std/Data/Nat/Init/Lemmas.lean b/Std/Data/Nat/Init/Lemmas.lean deleted file mode 100644 index 46fab00550..0000000000 --- a/Std/Data/Nat/Init/Lemmas.lean +++ /dev/null @@ -1,303 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro --/ -import Std.Tactic.Alias - -namespace Nat - -/-! ### le/lt -/ - -theorem ne_of_gt {a b : Nat} (h : b < a) : a ≠ b := (ne_of_lt h).symm - -protected theorem pos_of_ne_zero {n : Nat} : n ≠ 0 → 0 < n := (eq_zero_or_pos n).resolve_left - -@[simp] protected theorem not_le {a b : Nat} : ¬ a ≤ b ↔ b < a := - ⟨Nat.gt_of_not_le, Nat.not_le_of_gt⟩ - -protected alias ⟨lt_of_not_ge, _⟩ := Nat.not_le -protected alias ⟨lt_of_not_le, not_le_of_lt⟩ := Nat.not_le -protected alias ⟨_, lt_le_asymm⟩ := Nat.not_le - -@[simp] protected theorem not_lt {a b : Nat} : ¬ a < b ↔ b ≤ a := - ⟨Nat.ge_of_not_lt, flip Nat.not_le_of_gt⟩ - -protected alias ⟨le_of_not_gt, not_lt_of_ge⟩ := Nat.not_lt -protected alias ⟨le_of_not_lt, not_lt_of_le⟩ := Nat.not_lt -protected alias ⟨_, le_lt_asymm⟩ := Nat.not_lt - -alias ne_of_lt' := ne_of_gt - -protected theorem le_of_not_le {a b : Nat} (h : ¬ b ≤ a) : a ≤ b := Nat.le_of_lt (Nat.not_le.1 h) -protected alias le_of_not_ge := Nat.le_of_not_le - -protected theorem le_antisymm_iff {a b : Nat} : a = b ↔ a ≤ b ∧ b ≤ a := - ⟨fun | rfl => ⟨Nat.le_refl _, Nat.le_refl _⟩, fun ⟨hle, hge⟩ => Nat.le_antisymm hle hge⟩ -protected alias eq_iff_le_and_ge := Nat.le_antisymm_iff - -protected theorem lt_or_gt_of_ne {a b : Nat} : a ≠ b → a < b ∨ b < a := by - rw [← Nat.not_le, ← Nat.not_le, ← Decidable.not_and_iff_or_not_not, and_comm] - exact mt Nat.le_antisymm_iff.2 -protected alias lt_or_lt_of_ne := Nat.lt_or_gt_of_ne -@[deprecated] protected alias lt_connex := Nat.lt_or_gt_of_ne - - - -/-! ## zero/one/two -/ - -protected theorem pos_iff_ne_zero : 0 < n ↔ n ≠ 0 := ⟨ne_of_gt, Nat.pos_of_ne_zero⟩ - -/-! ### succ/pred -/ - -theorem succ_pred_eq_of_pos : ∀ {n}, 0 < n → succ (pred n) = n - | _+1, _ => rfl - -theorem exists_eq_succ_of_ne_zero : ∀ {n}, n ≠ 0 → ∃ k, n = succ k - | _+1, _ => ⟨_, rfl⟩ - -/-! ### add -/ - -protected theorem add_le_add_iff_right {n : Nat} : m + n ≤ k + n ↔ m ≤ k := - ⟨Nat.le_of_add_le_add_right, fun h => Nat.add_le_add_right h _⟩ - -theorem eq_zero_of_add_eq_zero : ∀ {n m}, n + m = 0 → n = 0 ∧ m = 0 - | 0, 0, _ => ⟨rfl, rfl⟩ - | _+1, 0, h => Nat.noConfusion h - -protected theorem eq_zero_of_add_eq_zero_left (h : n + m = 0) : m = 0 := - (Nat.eq_zero_of_add_eq_zero h).2 - -/-! ### sub -/ - -attribute [simp] Nat.zero_sub Nat.add_sub_cancel succ_sub_succ_eq_sub - -theorem succ_sub {m n : Nat} (h : n ≤ m) : succ m - n = succ (m - n) := by - let ⟨k, hk⟩ := Nat.le.dest h - rw [← hk, Nat.add_sub_cancel_left, ← add_succ, Nat.add_sub_cancel_left] - -protected theorem sub_pos_of_lt (h : m < n) : 0 < n - m := - Nat.pos_iff_ne_zero.2 (Nat.sub_ne_zero_of_lt h) - -protected theorem sub_le_sub_left (h : n ≤ m) (k : Nat) : k - m ≤ k - n := - match m, le.dest h with - | _, ⟨a, rfl⟩ => by rw [← Nat.sub_sub]; apply sub_le - -protected theorem sub_le_sub_right {n m : Nat} (h : n ≤ m) : ∀ k, n - k ≤ m - k - | 0 => h - | z+1 => pred_le_pred (Nat.sub_le_sub_right h z) - -protected theorem lt_of_sub_ne_zero (h : n - m ≠ 0) : m < n := - Nat.not_le.1 (mt Nat.sub_eq_zero_of_le h) - -protected theorem sub_ne_zero_iff_lt : n - m ≠ 0 ↔ m < n := - ⟨Nat.lt_of_sub_ne_zero, Nat.sub_ne_zero_of_lt⟩ - -protected theorem lt_of_sub_pos (h : 0 < n - m) : m < n := - Nat.lt_of_sub_ne_zero (Nat.pos_iff_ne_zero.1 h) - -protected theorem lt_of_sub_eq_succ (h : m - n = succ l) : n < m := - Nat.lt_of_sub_pos (h ▸ Nat.zero_lt_succ _) - -protected theorem sub_lt_left_of_lt_add {n k m : Nat} (H : n ≤ k) (h : k < n + m) : k - n < m := by - have := Nat.sub_le_sub_right (succ_le_of_lt h) n - rwa [Nat.add_sub_cancel_left, Nat.succ_sub H] at this - -protected theorem sub_lt_right_of_lt_add {n k m : Nat} (H : n ≤ k) (h : k < m + n) : k - n < m := - Nat.sub_lt_left_of_lt_add H (Nat.add_comm .. ▸ h) - -protected theorem le_of_sub_eq_zero : ∀ {n m}, n - m = 0 → n ≤ m - | 0, _, _ => Nat.zero_le .. - | _+1, _+1, h => Nat.succ_le_succ <| Nat.le_of_sub_eq_zero (Nat.succ_sub_succ .. ▸ h) - -protected theorem le_of_sub_le_sub_right : ∀ {n m k : Nat}, k ≤ m → n - k ≤ m - k → n ≤ m - | 0, _, _, _, _ => Nat.zero_le .. - | _+1, _, 0, _, h₁ => h₁ - | _+1, _+1, _+1, h₀, h₁ => by - simp only [Nat.succ_sub_succ] at h₁ - exact succ_le_succ <| Nat.le_of_sub_le_sub_right (le_of_succ_le_succ h₀) h₁ - -protected theorem sub_le_sub_iff_right {n : Nat} (h : k ≤ m) : n - k ≤ m - k ↔ n ≤ m := - ⟨Nat.le_of_sub_le_sub_right h, fun h => Nat.sub_le_sub_right h _⟩ - -protected theorem sub_eq_iff_eq_add {c : Nat} (h : b ≤ a) : a - b = c ↔ a = c + b := - ⟨fun | rfl => by rw [Nat.sub_add_cancel h], fun heq => by rw [heq, Nat.add_sub_cancel]⟩ - -protected theorem sub_eq_iff_eq_add' {c : Nat} (h : b ≤ a) : a - b = c ↔ a = b + c := by - rw [Nat.add_comm, Nat.sub_eq_iff_eq_add h] - -/-! ### min/max -/ - -protected theorem min_eq_min (a : Nat) : Nat.min a b = min a b := rfl - -protected theorem max_eq_max (a : Nat) : Nat.max a b = max a b := rfl - -protected theorem min_comm (a b : Nat) : min a b = min b a := by - simp [Nat.min_def]; split <;> split <;> try simp [*] - · next h₁ h₂ => exact Nat.le_antisymm h₁ h₂ - · next h₁ h₂ => cases not_or_intro h₁ h₂ <| Nat.le_total .. - -protected theorem min_le_right (a b : Nat) : min a b ≤ b := by rw [Nat.min_def]; split <;> simp [*] - -protected theorem min_le_left (a b : Nat) : min a b ≤ a := Nat.min_comm .. ▸ Nat.min_le_right .. - -protected theorem min_eq_left {a b : Nat} (h : a ≤ b) : min a b = a := if_pos h - -protected theorem min_eq_right {a b : Nat} (h : b ≤ a) : min a b = b := by - rw [Nat.min_comm]; exact Nat.min_eq_left h - -protected theorem max_comm (a b : Nat) : max a b = max b a := by - simp only [Nat.max_def] - by_cases h₁ : a ≤ b <;> by_cases h₂ : b ≤ a <;> simp [h₁, h₂] - · exact Nat.le_antisymm h₂ h₁ - · cases not_or_intro h₁ h₂ <| Nat.le_total .. - -protected theorem le_max_left (a b : Nat) : a ≤ max a b := by rw [Nat.max_def]; split <;> simp [*] - -protected theorem le_max_right (a b : Nat) : b ≤ max a b := Nat.max_comm .. ▸ Nat.le_max_left .. - -protected theorem le_min_of_le_of_le {a b c : Nat} : a ≤ b → a ≤ c → a ≤ min b c := by - intros; cases Nat.le_total b c with - | inl h => rw [Nat.min_eq_left h]; assumption - | inr h => rw [Nat.min_eq_right h]; assumption - -protected theorem le_min {a b c : Nat} : a ≤ min b c ↔ a ≤ b ∧ a ≤ c := - ⟨fun h => ⟨Nat.le_trans h (Nat.min_le_left ..), Nat.le_trans h (Nat.min_le_right ..)⟩, - fun ⟨h₁, h₂⟩ => Nat.le_min_of_le_of_le h₁ h₂⟩ - -protected theorem lt_min {a b c : Nat} : a < min b c ↔ a < b ∧ a < c := Nat.le_min - -/-! ### div/mod -/ - -theorem div_eq_sub_div (h₁ : 0 < b) (h₂ : b ≤ a) : a / b = (a - b) / b + 1 := by - rw [div_eq a, if_pos]; constructor <;> assumption - - -theorem mod_add_div (m k : Nat) : m % k + k * (m / k) = m := by - induction m, k using mod.inductionOn with rw [div_eq, mod_eq] - | base x y h => simp [h] - | ind x y h IH => simp [h]; rw [Nat.mul_succ, ← Nat.add_assoc, IH, Nat.sub_add_cancel h.2] - -@[simp] protected theorem div_one (n : Nat) : n / 1 = n := by - have := mod_add_div n 1 - rwa [mod_one, Nat.zero_add, Nat.one_mul] at this - -@[simp] protected theorem div_zero (n : Nat) : n / 0 = 0 := by - rw [div_eq]; simp [Nat.lt_irrefl] - -@[simp] protected theorem zero_div (b : Nat) : 0 / b = 0 := - (div_eq 0 b).trans <| if_neg <| And.rec Nat.not_le_of_gt - -theorem le_div_iff_mul_le (k0 : 0 < k) : x ≤ y / k ↔ x * k ≤ y := by - induction y, k using mod.inductionOn generalizing x with - (rw [div_eq]; simp [h]; cases x with | zero => simp [zero_le] | succ x => ?_) - | base y k h => - simp [not_succ_le_zero x, succ_mul, Nat.add_comm] - refine Nat.lt_of_lt_of_le ?_ (Nat.le_add_right ..) - exact Nat.not_le.1 fun h' => h ⟨k0, h'⟩ - | ind y k h IH => - rw [← add_one, Nat.add_le_add_iff_right, IH k0, succ_mul, - ← Nat.add_sub_cancel (x*k) k, Nat.sub_le_sub_iff_right h.2, Nat.add_sub_cancel] - -theorem div_mul_le_self : ∀ (m n : Nat), m / n * n ≤ m - | m, 0 => by simp - | m, n+1 => (le_div_iff_mul_le (Nat.succ_pos _)).1 (Nat.le_refl _) - -theorem div_lt_iff_lt_mul (Hk : 0 < k) : x / k < y ↔ x < y * k := by - rw [← Nat.not_le, ← Nat.not_le]; exact not_congr (le_div_iff_mul_le Hk) - -@[simp] theorem add_div_right (x : Nat) {z : Nat} (H : 0 < z) : (x + z) / z = succ (x / z) := by - rw [div_eq_sub_div H (Nat.le_add_left _ _), Nat.add_sub_cancel] - -@[simp] theorem add_div_left (x : Nat) {z : Nat} (H : 0 < z) : (z + x) / z = succ (x / z) := by - rw [Nat.add_comm, add_div_right x H] - -theorem add_mul_div_left (x z : Nat) {y : Nat} (H : 0 < y) : (x + y * z) / y = x / y + z := by - induction z with - | zero => rw [Nat.mul_zero, Nat.add_zero, Nat.add_zero] - | succ z ih => rw [mul_succ, ← Nat.add_assoc, add_div_right _ H, ih]; rfl - -theorem add_mul_div_right (x y : Nat) {z : Nat} (H : 0 < z) : (x + y * z) / z = x / z + y := by - rw [Nat.mul_comm, add_mul_div_left _ _ H] - -@[simp] theorem add_mod_right (x z : Nat) : (x + z) % z = x % z := by - rw [mod_eq_sub_mod (Nat.le_add_left ..), Nat.add_sub_cancel] - -@[simp] theorem add_mod_left (x z : Nat) : (x + z) % x = z % x := by - rw [Nat.add_comm, add_mod_right] - -@[simp] theorem add_mul_mod_self_left (x y z : Nat) : (x + y * z) % y = x % y := by - match z with - | 0 => rw [Nat.mul_zero, Nat.add_zero] - | succ z => rw [mul_succ, ← Nat.add_assoc, add_mod_right, add_mul_mod_self_left (z := z)] - -@[simp] theorem add_mul_mod_self_right (x y z : Nat) : (x + y * z) % z = x % z := by - rw [Nat.mul_comm, add_mul_mod_self_left] - -@[simp] theorem mul_mod_right (m n : Nat) : (m * n) % m = 0 := by - rw [← Nat.zero_add (m * n), add_mul_mod_self_left, zero_mod] - -@[simp] theorem mul_mod_left (m n : Nat) : (m * n) % n = 0 := by - rw [Nat.mul_comm, mul_mod_right] - -protected theorem div_eq_of_lt_le (lo : k * n ≤ m) (hi : m < succ k * n) : m / n = k := -have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun hn => by - rw [hn, Nat.mul_zero] at hi lo; exact absurd lo (Nat.not_le_of_gt hi) -Nat.le_antisymm - (le_of_lt_succ ((Nat.div_lt_iff_lt_mul npos).2 hi)) - ((Nat.le_div_iff_mul_le npos).2 lo) - -theorem sub_mul_div (x n p : Nat) (h₁ : n*p ≤ x) : (x - n*p) / n = x / n - p := by - match eq_zero_or_pos n with - | .inl h₀ => rw [h₀, Nat.div_zero, Nat.div_zero, Nat.zero_sub] - | .inr h₀ => induction p with - | zero => rw [Nat.mul_zero, Nat.sub_zero, Nat.sub_zero] - | succ p IH => - have h₂ : n * p ≤ x := Nat.le_trans (Nat.mul_le_mul_left _ (le_succ _)) h₁ - have h₃ : x - n * p ≥ n := by - apply Nat.le_of_add_le_add_right - rw [Nat.sub_add_cancel h₂, Nat.add_comm] - rw [mul_succ] at h₁ - exact h₁ - rw [sub_succ, ← IH h₂, div_eq_sub_div h₀ h₃] - simp [add_one, Nat.pred_succ, mul_succ, Nat.sub_sub] - -theorem mul_sub_div (x n p : Nat) (h₁ : x < n*p) : (n * p - succ x) / n = p - succ (x / n) := by - have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun n0 => by - rw [n0, Nat.zero_mul] at h₁; exact not_lt_zero _ h₁ - apply Nat.div_eq_of_lt_le - · rw [Nat.mul_sub_right_distrib, Nat.mul_comm] - exact Nat.sub_le_sub_left ((div_lt_iff_lt_mul npos).1 (lt_succ_self _)) _ - · show succ (pred (n * p - x)) ≤ (succ (pred (p - x / n))) * n - rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁), - fun h => succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)] -- TODO: why is the function needed? - · rw [Nat.mul_sub_right_distrib, Nat.mul_comm] - exact Nat.sub_le_sub_left (div_mul_le_self ..) _ - · rwa [div_lt_iff_lt_mul npos, Nat.mul_comm] - -theorem mul_mod_mul_left (z x y : Nat) : (z * x) % (z * y) = z * (x % y) := - if y0 : y = 0 then by - rw [y0, Nat.mul_zero, mod_zero, mod_zero] - else if z0 : z = 0 then by - rw [z0, Nat.zero_mul, Nat.zero_mul, Nat.zero_mul, mod_zero] - else by - induction x using Nat.strongInductionOn with - | _ n IH => - have y0 : y > 0 := Nat.pos_of_ne_zero y0 - have z0 : z > 0 := Nat.pos_of_ne_zero z0 - cases Nat.lt_or_ge n y with - | inl yn => rw [mod_eq_of_lt yn, mod_eq_of_lt (Nat.mul_lt_mul_of_pos_left yn z0)] - | inr yn => - rw [mod_eq_sub_mod yn, mod_eq_sub_mod (Nat.mul_le_mul_left z yn), - ← Nat.mul_sub_left_distrib] - exact IH _ (sub_lt (Nat.lt_of_lt_of_le y0 yn) y0) - -theorem div_eq_of_lt (h₀ : a < b) : a / b = 0 := by - rw [div_eq a, if_neg] - intro h₁ - apply Nat.not_le_of_gt h₀ h₁.right - -/-! ### pow -/ - -protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide) -@[deprecated] alias pow_two_pos := Nat.two_pow_pos -- deprecated 2024-02-09 diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index 223f7b7273..4a8ffceb78 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -5,7 +5,6 @@ Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import Std.Tactic.Alias import Std.Tactic.Init -import Std.Data.Nat.Init.Lemmas import Std.Data.Nat.Init.Dvd import Std.Data.Nat.Basic import Std.Data.Ord @@ -160,12 +159,6 @@ protected alias lt_or_gt := Nat.ne_iff_lt_or_gt protected alias le_or_ge := Nat.le_total protected alias le_or_le := Nat.le_total -protected theorem lt_trichotomy (a b : Nat) : a < b ∨ a = b ∨ b < a := - if h : a = b then .inr (.inl h) else - match Nat.lt_or_gt_of_ne h with - | .inl h => .inl h - | .inr h => .inr (.inr h) - protected theorem eq_or_lt_of_not_lt {a b : Nat} (hnlt : ¬ a < b) : a = b ∨ b < a := (Nat.lt_trichotomy ..).resolve_left hnlt @@ -319,6 +312,9 @@ theorem lt_of_le_pred (h : 0 < m) : n ≤ pred m → n < m := (le_pred_iff_lt h) theorem le_pred_of_lt (h : n < m) : n ≤ pred m := (le_pred_iff_lt (Nat.zero_lt_of_lt h)).2 h +theorem exists_eq_succ_of_ne_zero : ∀ {n}, n ≠ 0 → ∃ k, n = succ k + | _+1, _ => ⟨_, rfl⟩ + /-! ## add -/ protected theorem add_add_add_comm (a b c d : Nat) : (a + b) + (c + d) = (a + c) + (b + d) := by @@ -1262,3 +1258,6 @@ instance decidableExistsLT [h : DecidablePred p] : DecidablePred fun n => ∃ m instance decidableExistsLE [DecidablePred p] : DecidablePred fun n => ∃ m : Nat, m ≤ n ∧ p m := fun n => decidable_of_iff (∃ m, m < n + 1 ∧ p m) (exists_congr fun _ => and_congr_left' Nat.lt_succ_iff) + +@[deprecated] protected alias lt_connex := Nat.lt_or_gt_of_ne +@[deprecated] alias pow_two_pos := Nat.two_pow_pos -- deprecated 2024-02-09 diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index fe87ee037a..9cf6bf6b2b 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 François G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ -import Std.Data.Nat.Init.Lemmas import Std.Tactic.Ext.Attr /-! ### UInt8 -/ diff --git a/test.lean b/test.lean new file mode 100644 index 0000000000..b3ade4dbd7 --- /dev/null +++ b/test.lean @@ -0,0 +1,9 @@ +import Std + +theorem ofBool_eq_iff_eq (b b' : Bool) : BitVec.ofBool b = BitVec.ofBool b' ↔ b = b' := by + cases b <;> cases b' +--#print ite_t +example (p q : Prop) (h : ¬p) : p → q ↔ true := by + std_apply? + +-- by_cases h : p <;> simp [h] From 41484df7df1c3a946173c97d6ce5800d9cb656c9 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Wed, 14 Feb 2024 13:02:06 -0800 Subject: [PATCH 040/213] chore: upstream Nat.Init.Dvd lemmas --- Std/Data/Int/Init/DivMod.lean | 1 - Std/Data/Nat.lean | 1 - Std/Data/Nat/Init/Dvd.lean | 87 ----------------------------------- Std/Data/Nat/Init/Gcd.lean | 2 - Std/Data/Nat/Lemmas.lean | 1 - Std/Tactic/Omega.lean | 1 - 6 files changed, 93 deletions(-) delete mode 100644 Std/Data/Nat/Init/Dvd.lean diff --git a/Std/Data/Int/Init/DivMod.lean b/Std/Data/Int/Init/DivMod.lean index cf7c35e507..a0eeb55ae8 100644 --- a/Std/Data/Int/Init/DivMod.lean +++ b/Std/Data/Int/Init/DivMod.lean @@ -3,7 +3,6 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ -import Std.Data.Nat.Init.Dvd import Std.Data.Int.Init.Order /-! diff --git a/Std/Data/Nat.lean b/Std/Data/Nat.lean index 5527f9c7df..fcfa034959 100644 --- a/Std/Data/Nat.lean +++ b/Std/Data/Nat.lean @@ -1,5 +1,4 @@ import Std.Data.Nat.Bitwise import Std.Data.Nat.Gcd -import Std.Data.Nat.Init.Dvd import Std.Data.Nat.Init.Gcd import Std.Data.Nat.Lemmas diff --git a/Std/Data/Nat/Init/Dvd.lean b/Std/Data/Nat/Init/Dvd.lean deleted file mode 100644 index 4250e8ef64..0000000000 --- a/Std/Data/Nat/Init/Dvd.lean +++ /dev/null @@ -1,87 +0,0 @@ -namespace Nat - -protected theorem dvd_refl (a : Nat) : a ∣ a := ⟨1, by simp⟩ - -protected theorem dvd_zero (a : Nat) : a ∣ 0 := ⟨0, by simp⟩ - -protected theorem dvd_mul_left (a b : Nat) : a ∣ b * a := ⟨b, Nat.mul_comm b a⟩ - -protected theorem dvd_mul_right (a b : Nat) : a ∣ a * b := ⟨b, rfl⟩ - -protected theorem dvd_trans {a b c : Nat} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c := - match h₁, h₂ with - | ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ => - ⟨d * e, show c = a * (d * e) by simp[h₃,h₄, Nat.mul_assoc]⟩ - -protected theorem eq_zero_of_zero_dvd {a : Nat} (h : 0 ∣ a) : a = 0 := - let ⟨c, H'⟩ := h; H'.trans c.zero_mul - -@[simp] protected theorem zero_dvd {n : Nat} : 0 ∣ n ↔ n = 0 := - ⟨Nat.eq_zero_of_zero_dvd, fun h => h.symm ▸ Nat.dvd_zero 0⟩ - -protected theorem dvd_add {a b c : Nat} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := - let ⟨d, hd⟩ := h₁; let ⟨e, he⟩ := h₂; ⟨d + e, by simp [Nat.left_distrib, hd, he]⟩ - -protected theorem dvd_add_iff_right {k m n : Nat} (h : k ∣ m) : k ∣ n ↔ k ∣ m + n := - ⟨Nat.dvd_add h, - match m, h with - | _, ⟨d, rfl⟩ => fun ⟨e, he⟩ => - ⟨e - d, by rw [Nat.mul_sub_left_distrib, ← he, Nat.add_sub_cancel_left]⟩⟩ - -protected theorem dvd_add_iff_left {k m n : Nat} (h : k ∣ n) : k ∣ m ↔ k ∣ m + n := by - rw [Nat.add_comm]; exact Nat.dvd_add_iff_right h - -theorem dvd_mod_iff {k m n : Nat} (h: k ∣ n) : k ∣ m % n ↔ k ∣ m := - have := Nat.dvd_add_iff_left <| Nat.dvd_trans h <| Nat.dvd_mul_right n (m / n) - by rwa [mod_add_div] at this - -theorem le_of_dvd {m n : Nat} (h : 0 < n) : m ∣ n → m ≤ n - | ⟨k, e⟩ => by - revert h - rw [e] - match k with - | 0 => intro hn; simp at hn - | pk+1 => - intro - have := Nat.mul_le_mul_left m (succ_pos pk) - rwa [Nat.mul_one] at this - -protected theorem dvd_antisymm : ∀ {m n : Nat}, m ∣ n → n ∣ m → m = n - | _, 0, _, h₂ => Nat.eq_zero_of_zero_dvd h₂ - | 0, _, h₁, _ => (Nat.eq_zero_of_zero_dvd h₁).symm - | _+1, _+1, h₁, h₂ => Nat.le_antisymm (le_of_dvd (succ_pos _) h₁) (le_of_dvd (succ_pos _) h₂) - -theorem pos_of_dvd_of_pos {m n : Nat} (H1 : m ∣ n) (H2 : 0 < n) : 0 < m := - Nat.pos_of_ne_zero fun m0 => Nat.ne_of_gt H2 <| Nat.eq_zero_of_zero_dvd (m0 ▸ H1) - -@[simp] protected theorem one_dvd (n : Nat) : 1 ∣ n := ⟨n, n.one_mul.symm⟩ - -theorem eq_one_of_dvd_one {n : Nat} (H : n ∣ 1) : n = 1 := Nat.dvd_antisymm H n.one_dvd - -theorem mod_eq_zero_of_dvd {m n : Nat} (H : m ∣ n) : n % m = 0 := by - let ⟨z, H⟩ := H; rw [H, mul_mod_right] - -theorem dvd_of_mod_eq_zero {m n : Nat} (H : n % m = 0) : m ∣ n := by - exists n / m - have := (mod_add_div n m).symm - rwa [H, Nat.zero_add] at this - -theorem dvd_iff_mod_eq_zero (m n : Nat) : m ∣ n ↔ n % m = 0 := - ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ - -instance decidable_dvd : @DecidableRel Nat (·∣·) := - fun _ _ => decidable_of_decidable_of_iff (dvd_iff_mod_eq_zero _ _).symm - -theorem emod_pos_of_not_dvd {a b : Nat} (h : ¬ a ∣ b) : 0 < b % a := by - rw [dvd_iff_mod_eq_zero] at h - exact Nat.pos_of_ne_zero h - - -protected theorem mul_div_cancel' {n m : Nat} (H : n ∣ m) : n * (m / n) = m := by - have := mod_add_div m n - rwa [mod_eq_zero_of_dvd H, Nat.zero_add] at this - -protected theorem div_mul_cancel {n m : Nat} (H : n ∣ m) : m / n * n = m := by - rw [Nat.mul_comm, Nat.mul_div_cancel' H] - -end Nat diff --git a/Std/Data/Nat/Init/Gcd.lean b/Std/Data/Nat/Init/Gcd.lean index d1e77b1d45..889b9381d7 100644 --- a/Std/Data/Nat/Init/Gcd.lean +++ b/Std/Data/Nat/Init/Gcd.lean @@ -1,5 +1,3 @@ -import Std.Data.Nat.Init.Dvd - namespace Nat theorem gcd_rec (m n : Nat) : gcd m n = gcd (n % m) m := diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index 4a8ffceb78..df8f01788a 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -5,7 +5,6 @@ Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import Std.Tactic.Alias import Std.Tactic.Init -import Std.Data.Nat.Init.Dvd import Std.Data.Nat.Basic import Std.Data.Ord diff --git a/Std/Tactic/Omega.lean b/Std/Tactic/Omega.lean index 2e9cff9076..aa637bf4dd 100644 --- a/Std/Tactic/Omega.lean +++ b/Std/Tactic/Omega.lean @@ -5,7 +5,6 @@ Authors: Scott Morrison -/ import Std.Tactic.Omega.Frontend - /-! # `omega` From 285e9f2200ba0d1ba65af042aa579c5cf15ea2e5 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Wed, 14 Feb 2024 13:09:41 -0800 Subject: [PATCH 041/213] chore: upsteam Std.Data.Nat.Init.Gcd --- Std/Data/Nat.lean | 1 - Std/Data/Nat/Gcd.lean | 1 - Std/Data/Nat/Init/Gcd.lean | 34 ---------------------------------- Std/Tactic/Omega/IntList.lean | 2 -- 4 files changed, 38 deletions(-) delete mode 100644 Std/Data/Nat/Init/Gcd.lean diff --git a/Std/Data/Nat.lean b/Std/Data/Nat.lean index fcfa034959..e756fe2023 100644 --- a/Std/Data/Nat.lean +++ b/Std/Data/Nat.lean @@ -1,4 +1,3 @@ import Std.Data.Nat.Bitwise import Std.Data.Nat.Gcd -import Std.Data.Nat.Init.Gcd import Std.Data.Nat.Lemmas diff --git a/Std/Data/Nat/Gcd.lean b/Std/Data/Nat/Gcd.lean index a2a91694e1..27842c51ad 100644 --- a/Std/Data/Nat/Gcd.lean +++ b/Std/Data/Nat/Gcd.lean @@ -3,7 +3,6 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro -/ -import Std.Data.Nat.Init.Gcd import Std.Data.Nat.Lemmas /-! diff --git a/Std/Data/Nat/Init/Gcd.lean b/Std/Data/Nat/Init/Gcd.lean deleted file mode 100644 index 889b9381d7..0000000000 --- a/Std/Data/Nat/Init/Gcd.lean +++ /dev/null @@ -1,34 +0,0 @@ -namespace Nat - -theorem gcd_rec (m n : Nat) : gcd m n = gcd (n % m) m := - match m with - | 0 => by have := (mod_zero n).symm; rwa [gcd_zero_right] - | _ + 1 => by simp [gcd_succ] - -@[elab_as_elim] theorem gcd.induction {P : Nat → Nat → Prop} (m n : Nat) - (H0 : ∀n, P 0 n) (H1 : ∀ m n, 0 < m → P (n % m) m → P m n) : P m n := - Nat.strongInductionOn (motive := fun m => ∀ n, P m n) m - (fun - | 0, _ => H0 - | _+1, IH => fun _ => H1 _ _ (succ_pos _) (IH _ (mod_lt _ (succ_pos _)) _) ) - n - -theorem gcd_dvd (m n : Nat) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) := by - induction m, n using gcd.induction with - | H0 n => rw [gcd_zero_left]; exact ⟨Nat.dvd_zero n, Nat.dvd_refl n⟩ - | H1 m n _ IH => rw [← gcd_rec] at IH; exact ⟨IH.2, (dvd_mod_iff IH.2).1 IH.1⟩ - -theorem gcd_dvd_left (m n : Nat) : gcd m n ∣ m := (gcd_dvd m n).left - -theorem gcd_dvd_right (m n : Nat) : gcd m n ∣ n := (gcd_dvd m n).right - -theorem gcd_le_left (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h <| gcd_dvd_left m n - -theorem gcd_le_right (n) (h : 0 < n) : gcd m n ≤ n := le_of_dvd h <| gcd_dvd_right m n - -theorem dvd_gcd : k ∣ m → k ∣ n → k ∣ gcd m n := by - induction m, n using gcd.induction with intro km kn - | H0 n => rw [gcd_zero_left]; exact kn - | H1 n m _ IH => rw [gcd_rec]; exact IH ((dvd_mod_iff km).2 kn) km - -end Nat diff --git a/Std/Tactic/Omega/IntList.lean b/Std/Tactic/Omega/IntList.lean index 8ba59d285f..b4392fe543 100644 --- a/Std/Tactic/Omega/IntList.lean +++ b/Std/Tactic/Omega/IntList.lean @@ -4,10 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.List.Init.Lemmas -import Std.Data.Nat.Init.Gcd import Std.Data.Int.Init.DivMod import Std.Data.Option.Init.Lemmas ---import Std.Tactic.Replace import Std.Tactic.Simpa /-- From fe796414d57f713b3da8738c5af89a4cab0d5552 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 15 Feb 2024 13:30:52 +1100 Subject: [PATCH 042/213] lint --- Std/Tactic/RunCmd.lean | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Std/Tactic/RunCmd.lean b/Std/Tactic/RunCmd.lean index 9c8eb39389..edda178266 100644 --- a/Std/Tactic/RunCmd.lean +++ b/Std/Tactic/RunCmd.lean @@ -5,6 +5,7 @@ Authors: Sebastian Ullrich, Mario Carneiro -/ import Lean.Elab.Eval import Lean.Elab.Command +import Std.Tactic.Lint /-! Defines commands to compile and execute a command / term / tactic on the spot: @@ -67,7 +68,7 @@ elab (name := runTac) "run_tac " e:doSeq : tactic => do syntax (name := byElab) "by_elab " doSeq : term /-- Elaborator for `by_elab`. -/ -@[term_elab byElab] def elabRunElab : TermElab := fun +@[term_elab byElab, nolint unusedHavesSuffices] def elabRunElab : TermElab := fun | `(by_elab $cmds:doSeq), expectedType? => do if let `(Lean.Parser.Term.doSeq| $e:term) := cmds then if e matches `(Lean.Parser.Term.doSeq| fun $[$_args]* => $_) then From f0df4993433874aee8571f512ad1345886d3c93c Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 15 Feb 2024 19:07:22 +1100 Subject: [PATCH 043/213] ripping stuff out --- Std.lean | 2 - Std/Classes/SetNotation.lean | 110 -------------------------------- Std/Data/Array/Init/Lemmas.lean | 2 - Std/Data/Array/Lemmas.lean | 1 - Std/Data/Fin.lean | 1 - Std/Data/Fin/Init/Lemmas.lean | 7 -- Std/Data/List.lean | 1 - Std/Data/List/Init/Basic.lean | 28 -------- Std/Data/List/Init/Lemmas.lean | 1 - Std/Data/Prod.lean | 1 - Std/Data/Prod/Lex.lean | 32 ---------- Std/Data/RBMap/Basic.lean | 1 - Std/Tactic/HaveI.lean | 63 ------------------ Std/Tactic/Omega/Int.lean | 1 - Std/Util/ExtendedBinder.lean | 67 ------------------- lean-toolchain | 2 +- 16 files changed, 1 insertion(+), 319 deletions(-) delete mode 100644 Std/Data/Fin/Init/Lemmas.lean delete mode 100644 Std/Data/List/Init/Basic.lean delete mode 100644 Std/Data/Prod.lean delete mode 100644 Std/Data/Prod/Lex.lean delete mode 100644 Std/Tactic/HaveI.lean diff --git a/Std.lean b/Std.lean index 9756ff2841..465474f996 100644 --- a/Std.lean +++ b/Std.lean @@ -32,7 +32,6 @@ import Std.Data.Nat import Std.Data.Option import Std.Data.Ord import Std.Data.PairingHeap -import Std.Data.Prod import Std.Data.RBMap import Std.Data.Range import Std.Data.Rat @@ -89,7 +88,6 @@ import Std.Tactic.Ext import Std.Tactic.Ext.Attr import Std.Tactic.FalseOrByContra import Std.Tactic.GuardMsgs -import Std.Tactic.HaveI import Std.Tactic.Init import Std.Tactic.Instances import Std.Tactic.LabelAttr diff --git a/Std/Classes/SetNotation.lean b/Std/Classes/SetNotation.lean index 7e46916cc9..977e1e3df3 100644 --- a/Std/Classes/SetNotation.lean +++ b/Std/Classes/SetNotation.lean @@ -3,109 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Util.ExtendedBinder - -/-- Notation type class for the subset relation `⊆`. -/ -class HasSubset (α : Type u) where - /-- Subset relation: `a ⊆ b` -/ - Subset : α → α → Prop -export HasSubset (Subset) - -/-- Subset relation: `a ⊆ b` -/ -infix:50 " ⊆ " => HasSubset.Subset - -/-- Notation type class for the strict subset relation `⊂`. -/ -class HasSSubset (α : Type u) where - /-- Strict subset relation: `a ⊂ b` -/ - SSubset : α → α → Prop -export HasSSubset (SSubset) - -/-- Strict subset relation: `a ⊂ b` -/ -infix:50 " ⊂ " => HasSSubset.SSubset - -/-- Superset relation: `a ⊇ b` -/ -abbrev Superset [HasSubset α] (a b : α) := b ⊆ a -/-- Superset relation: `a ⊇ b` -/ -infix:50 " ⊇ " => Superset - -/-- Strict superset relation: `a ⊃ b` -/ -abbrev SSuperset [HasSSubset α] (a b : α) := b ⊂ a -/-- Strict superset relation: `a ⊃ b` -/ -infix:50 " ⊃ " => SSuperset - -/-- Notation type class for the union operation `∪`. -/ -class Union (α : Type u) where - /-- `a ∪ b` is the union of`a` and `b`. -/ - union : α → α → α -/-- `a ∪ b` is the union of`a` and `b`. -/ -infixl:65 " ∪ " => Union.union - -/-- Notation type class for the intersection operation `∩`. -/ -class Inter (α : Type u) where - /-- `a ∩ b` is the intersection of`a` and `b`. -/ - inter : α → α → α -/-- `a ∩ b` is the intersection of`a` and `b`. -/ -infixl:70 " ∩ " => Inter.inter - -/-- Notation type class for the set difference `\`. -/ -class SDiff (α : Type u) where - /-- - `a \ b` is the set difference of `a` and `b`, - consisting of all elements in `a` that are not in `b`. - -/ - sdiff : α → α → α -/-- -`a \ b` is the set difference of `a` and `b`, -consisting of all elements in `a` that are not in `b`. --/ -infix:70 " \\ " => SDiff.sdiff - -/-- -Type class for the `insert` operation. -Used to implement the `{ a, b, c }` syntax. --/ -class Insert (α : outParam <| Type u) (γ : Type v) where - /-- `insert x xs` inserts the element `x` into the collection `xs`. -/ - insert : α → γ → γ -export Insert (insert) - -/-- -Type class for the `singleton` operation. -Used to implement the `{ a, b, c }` syntax. --/ -class Singleton (α : outParam <| Type u) (β : Type v) where - /-- `singleton x` is a collection with the single element `x` (notation: `{x}`). -/ - singleton : α → β -export Singleton (singleton) - -/-- Type class used to implement the notation `{ a ∈ c | p a }` -/ -class Sep (α : outParam <| Type u) (γ : Type v) where - /-- Computes `{ a ∈ c | p a }`. -/ - sep : (α → Prop) → γ → γ - -/-- Declare `∀ x ∈ y, ...` as syntax for `∀ x, x ∈ y → ...` and `∃ x ∈ y, ...` as syntax for -`∃ x, x ∈ y ∧ ...` -/ -binder_predicate x " ∈ " y:term => `($x ∈ $y) - -/-- Declare `∀ x ∉ y, ...` as syntax for `∀ x, x ∉ y → ...` and `∃ x ∉ y, ...` as syntax for -`∃ x, x ∉ y ∧ ...` -/ -binder_predicate x " ∉ " y:term => `($x ∉ $y) - -/-- Declare `∀ x ⊆ y, ...` as syntax for `∀ x, x ⊆ y → ...` and `∃ x ⊆ y, ...` as syntax for -`∃ x, x ⊆ y ∧ ...` -/ -binder_predicate x " ⊆ " y:term => `($x ⊆ $y) - -/-- Declare `∀ x ⊂ y, ...` as syntax for `∀ x, x ⊂ y → ...` and `∃ x ⊂ y, ...` as syntax for -`∃ x, x ⊂ y ∧ ...` -/ -binder_predicate x " ⊂ " y:term => `($x ⊂ $y) - -/-- Declare `∀ x ⊇ y, ...` as syntax for `∀ x, x ⊇ y → ...` and `∃ x ⊇ y, ...` as syntax for -`∃ x, x ⊇ y ∧ ...` -/ -binder_predicate x " ⊇ " y:term => `($x ⊇ $y) - -/-- Declare `∀ x ⊃ y, ...` as syntax for `∀ x, x ⊃ y → ...` and `∃ x ⊃ y, ...` as syntax for -`∃ x, x ⊃ y ∧ ...` -/ -binder_predicate x " ⊃ " y:term => `($x ⊃ $y) /-- `{ a, b, c }` is a set with elements `a`, `b`, and `c`. @@ -129,10 +26,3 @@ def singletonUnexpander : Lean.PrettyPrinter.Unexpander def insertUnexpander : Lean.PrettyPrinter.Unexpander | `($_ $a { $ts:term,* }) => `({$a:term, $ts,*}) | _ => throw () - -/-- `insert x ∅ = {x}` -/ -class IsLawfulSingleton (α : Type u) (β : Type v) [EmptyCollection β] [Insert α β] [Singleton α β] : - Prop where - /-- `insert x ∅ = {x}` -/ - insert_emptyc_eq (x : α) : (insert x ∅ : β) = {x} -export IsLawfulSingleton (insert_emptyc_eq) diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index 5833f80ea3..e01222a5d1 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -3,9 +3,7 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.HaveI import Std.Classes.LawfulMonad -import Std.Data.Fin.Init.Lemmas import Std.Data.Nat.Init.Lemmas import Std.Data.List.Init.Lemmas diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 3d8d68f897..7a7c3767ef 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -8,7 +8,6 @@ import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.Array.Basic import Std.Tactic.SeqFocus -import Std.Tactic.HaveI import Std.Tactic.Simpa import Std.Util.ProofWanted diff --git a/Std/Data/Fin.lean b/Std/Data/Fin.lean index bb8df44e80..0b79375e25 100644 --- a/Std/Data/Fin.lean +++ b/Std/Data/Fin.lean @@ -1,4 +1,3 @@ import Std.Data.Fin.Basic -import Std.Data.Fin.Init.Lemmas import Std.Data.Fin.Iterate import Std.Data.Fin.Lemmas diff --git a/Std/Data/Fin/Init/Lemmas.lean b/Std/Data/Fin/Init/Lemmas.lean deleted file mode 100644 index a84047765e..0000000000 --- a/Std/Data/Fin/Init/Lemmas.lean +++ /dev/null @@ -1,7 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ - -@[simp] theorem Fin.zero_eta : (⟨0, Nat.zero_lt_succ _⟩ : Fin (n + 1)) = 0 := rfl diff --git a/Std/Data/List.lean b/Std/Data/List.lean index 2c472a904d..137c762db9 100644 --- a/Std/Data/List.lean +++ b/Std/Data/List.lean @@ -1,7 +1,6 @@ import Std.Data.List.Basic import Std.Data.List.Count import Std.Data.List.Init.Attach -import Std.Data.List.Init.Basic import Std.Data.List.Init.Lemmas import Std.Data.List.Lemmas import Std.Data.List.Pairwise diff --git a/Std/Data/List/Init/Basic.lean b/Std/Data/List/Init/Basic.lean deleted file mode 100644 index 7aa74a0a0c..0000000000 --- a/Std/Data/List/Init/Basic.lean +++ /dev/null @@ -1,28 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura --/ - -namespace List - -/-- -Version of `List.zipWith` that continues to the end of both lists, passing `none` to one argument -once the shorter list has run out. --/ --- TODO We should add a tail-recursive version as we do for other `zip` functions. -def zipWithAll (f : Option α → Option β → γ) : List α → List β → List γ - | [], bs => bs.map fun b => f none (some b) - | a :: as, [] => (a :: as).map fun a => f (some a) none - | a :: as, b :: bs => f a b :: zipWithAll f as bs - -@[simp] theorem zipWithAll_nil_right : - zipWithAll f as [] = as.map fun a => f (some a) none := by - cases as <;> rfl - -@[simp] theorem zipWithAll_nil_left : - zipWithAll f [] bs = bs.map fun b => f none (some b) := by - rw [zipWithAll] - -@[simp] theorem zipWithAll_cons_cons : - zipWithAll f (a :: as) (b :: bs) = f (some a) (some b) :: zipWithAll f as bs := rfl diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean index e651829492..13a8f44e7f 100644 --- a/Std/Data/List/Init/Lemmas.lean +++ b/Std/Data/List/Init/Lemmas.lean @@ -5,7 +5,6 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M -/ import Std.Classes.SetNotation import Std.Data.Nat.Init.Lemmas -import Std.Data.List.Init.Basic import Std.Logic namespace List diff --git a/Std/Data/Prod.lean b/Std/Data/Prod.lean deleted file mode 100644 index 78ce8cfb58..0000000000 --- a/Std/Data/Prod.lean +++ /dev/null @@ -1 +0,0 @@ -import Std.Data.Prod.Lex diff --git a/Std/Data/Prod/Lex.lean b/Std/Data/Prod/Lex.lean deleted file mode 100644 index 2bb21568dc..0000000000 --- a/Std/Data/Prod/Lex.lean +++ /dev/null @@ -1,32 +0,0 @@ -/- -Copyright (c) 2022 Jannis Limperg. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jannis Limperg --/ - -namespace Prod - -theorem lex_def (r : α → α → Prop) (s : β → β → Prop) {p q : α × β} : - Prod.Lex r s p q ↔ r p.1 q.1 ∨ p.1 = q.1 ∧ s p.2 q.2 := - ⟨fun h => by cases h <;> simp [*], fun h => - match p, q, h with - | (a, b), (c, d), Or.inl h => Lex.left _ _ h - | (a, b), (c, d), Or.inr ⟨e, h⟩ => by subst e; exact Lex.right _ h⟩ - -namespace Lex - -instance [αeqDec : DecidableEq α] {r : α → α → Prop} [rDec : DecidableRel r] - {s : β → β → Prop} [sDec : DecidableRel s] : DecidableRel (Prod.Lex r s) - | (a, b), (a', b') => - match rDec a a' with - | isTrue raa' => isTrue $ left b b' raa' - | isFalse nraa' => - match αeqDec a a' with - | isTrue eq => by - subst eq - cases sDec b b' with - | isTrue sbb' => exact isTrue $ right a sbb' - | isFalse nsbb' => - apply isFalse; intro contra; cases contra <;> contradiction - | isFalse neqaa' => by - apply isFalse; intro contra; cases contra <;> contradiction diff --git a/Std/Data/RBMap/Basic.lean b/Std/Data/RBMap/Basic.lean index bf69dc8b5a..a1cd82b7cc 100644 --- a/Std/Data/RBMap/Basic.lean +++ b/Std/Data/RBMap/Basic.lean @@ -6,7 +6,6 @@ Authors: Leonardo de Moura, Mario Carneiro import Std.Classes.Order import Std.Control.ForInStep.Basic import Std.Logic -import Std.Tactic.HaveI /-! # Red-black trees diff --git a/Std/Tactic/HaveI.lean b/Std/Tactic/HaveI.lean deleted file mode 100644 index 91177c3543..0000000000 --- a/Std/Tactic/HaveI.lean +++ /dev/null @@ -1,63 +0,0 @@ -/- -Copyright (c) 2022 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ -import Lean.Elab.ElabRules -open Lean Elab Parser Term Meta Macro - -/-! -Defines variants of `have` and `let` syntax which do not produce `let_fun` or `let` bindings, -but instead inline the value instead. - -This is useful to declare local instances and proofs in theorem statements -and subgoals, where the extra binding is inconvenient. --/ - -namespace Std.Tactic - -/-- `haveI` behaves like `have`, but inlines the value instead of producing a `let_fun` term. -/ -@[term_parser] def «haveI» := leading_parser - withPosition ("haveI " >> haveDecl) >> optSemicolon termParser -/-- `letI` behaves like `let`, but inlines the value instead of producing a `let_fun` term. -/ -@[term_parser] def «letI» := leading_parser - withPosition ("letI " >> haveDecl) >> optSemicolon termParser - -macro_rules - | `(haveI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) => - `(haveI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body) - | `(haveI _ $bs* := $val; $body) => `(haveI x $bs* : _ := $val; $body) - | `(haveI _ $bs* : $ty := $val; $body) => `(haveI x $bs* : $ty := $val; $body) - | `(haveI $x:ident $bs* := $val; $body) => `(haveI $x $bs* : _ := $val; $body) - | `(haveI $_:ident $_* : $_ := $_; $_) => throwUnsupported -- handled by elab - -macro_rules - | `(letI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) => - `(letI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body) - | `(letI _ $bs* := $val; $body) => `(letI x $bs* : _ := $val; $body) - | `(letI _ $bs* : $ty := $val; $body) => `(letI x $bs* : $ty := $val; $body) - | `(letI $x:ident $bs* := $val; $body) => `(letI $x $bs* : _ := $val; $body) - | `(letI $_:ident $_* : $_ := $_; $_) => throwUnsupported -- handled by elab - -elab_rules <= expectedType - | `(haveI $x:ident $bs* : $ty := $val; $body) => do - let (ty, val) ← elabBinders bs fun bs => do - let ty ← elabType ty - let val ← elabTermEnsuringType val ty - pure (← mkForallFVars bs ty, ← mkLambdaFVars bs val) - withLocalDeclD x.getId ty fun x => do - return (← (← elabTerm body expectedType).abstractM #[x]).instantiate #[val] - -elab_rules <= expectedType - | `(letI $x:ident $bs* : $ty := $val; $body) => do - let (ty, val) ← elabBinders bs fun bs => do - let ty ← elabType ty - let val ← elabTermEnsuringType val ty - pure (← mkForallFVars bs ty, ← mkLambdaFVars bs val) - withLetDecl x.getId ty val fun x => do - return (← (← elabTerm body expectedType).abstractM #[x]).instantiate #[val] - -/-- `haveI` behaves like `have`, but inlines the value instead of producing a `let_fun` term. -/ -macro "haveI" d:haveDecl : tactic => `(tactic| refine_lift haveI $d:haveDecl; ?_) -/-- `letI` behaves like `let`, but inlines the value instead of producing a `let_fun` term. -/ -macro "letI" d:haveDecl : tactic => `(tactic| refine_lift letI $d:haveDecl; ?_) diff --git a/Std/Tactic/Omega/Int.lean b/Std/Tactic/Omega/Int.lean index 2fd621c6d9..15615fba7c 100644 --- a/Std/Tactic/Omega/Int.lean +++ b/Std/Tactic/Omega/Int.lean @@ -5,7 +5,6 @@ Authors: Scott Morrison -/ import Std.Classes.Order import Std.Data.Int.Init.Order -import Std.Data.Prod.Lex /-! # Lemmas about `Nat` and `Int` needed internally by `omega`. diff --git a/Std/Util/ExtendedBinder.lean b/Std/Util/ExtendedBinder.lean index dfdbcc62ff..e49b2f3f3c 100644 --- a/Std/Util/ExtendedBinder.lean +++ b/Std/Util/ExtendedBinder.lean @@ -13,41 +13,6 @@ Defines an extended binder syntax supporting `∀ ε > 0, ...` etc. namespace Std.ExtendedBinder open Lean -/-- -The syntax category of binder predicates contains predicates like `> 0`, `∈ s`, etc. -(`: t` should not be a binder predicate because it would clash with the built-in syntax for ∀/∃.) --/ -declare_syntax_cat binderPred - -/-- -`satisfies_binder_pred% t pred` expands to a proposition expressing that `t` satisfies `pred`. --/ -syntax "satisfies_binder_pred% " term:max binderPred : term - --- Extend ∀ and ∃ to binder predicates. - -/-- -The notation `∃ x < 2, p x` is shorthand for `∃ x, x < 2 ∧ p x`, -and similarly for other binary operators. --/ -syntax "∃ " binderIdent binderPred ", " term : term -/-- -The notation `∀ x < 2, p x` is shorthand for `∀ x, x < 2 → p x`, -and similarly for other binary operators. --/ -syntax "∀ " binderIdent binderPred ", " term : term - -macro_rules - | `(∃ $x:ident $pred:binderPred, $p) => - `(∃ $x:ident, satisfies_binder_pred% $x $pred ∧ $p) - | `(∃ _ $pred:binderPred, $p) => - `(∃ x, satisfies_binder_pred% x $pred ∧ $p) - -macro_rules - | `(∀ $x:ident $pred:binderPred, $p) => - `(∀ $x:ident, satisfies_binder_pred% $x $pred → $p) - | `(∀ _ $pred:binderPred, $p) => - `(∀ x, satisfies_binder_pred% x $pred → $p) -- We also provide special versions of ∀/∃ that take a list of extended binders. -- The built-in binders are not reused because that results in overloaded syntax. @@ -99,27 +64,6 @@ syntax (name := binderPredicate) (docComment)? (Parser.Term.attributes)? (attrKi "binder_predicate" optNamedName optNamedPrio ppSpace ident (ppSpace macroArg)* " => " term : command --- adapted from the macro macro -open Elab Command in -elab_rules : command - | `($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind binder_predicate%$tk - $[(name := $name?)]? $[(priority := $prio?)]? $x $args:macroArg* => $rhs) => do - let prio ← liftMacroM do evalOptPrio prio? - let (stxParts, patArgs) := (← args.mapM expandMacroArg).unzip - let name ← match name? with - | some name => pure name.getId - | none => liftMacroM do mkNameFromParserSyntax `binderTerm (mkNullNode stxParts) - let nameTk := name?.getD (mkIdentFrom tk name) - /- The command `syntax [] ...` adds the current namespace to the syntax node kind. - So, we must include current namespace when we create a pattern for the following - `macro_rules` commands. -/ - let pat : TSyntax `binderPred := ⟨(mkNode ((← getCurrNamespace) ++ name) patArgs).1⟩ - elabCommand <|<- - `($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind syntax%$tk - (name := $nameTk) (priority := $(quote prio)) $[$stxParts]* : binderPred - $[$doc?:docComment]? macro_rules%$tk - | `(satisfies_binder_pred% $$($x):term $pat:binderPred) => $rhs) - open Linter.MissingDocs Parser Term in /-- Missing docs handler for `binder_predicate` -/ @[missing_docs_handler binderPredicate] @@ -127,14 +71,3 @@ def checkBinderPredicate : SimpleHandler := fun stx => do if stx[0].isNone && stx[2][0][0].getKind != ``«local» then if stx[4].isNone then lint stx[3] "binder predicate" else lintNamed stx[4][0][3] "binder predicate" - -/-- Declare `∃ x > y, ...` as syntax for `∃ x, x > y ∧ ...` -/ -binder_predicate x " > " y:term => `($x > $y) -/-- Declare `∃ x ≥ y, ...` as syntax for `∃ x, x ≥ y ∧ ...` -/ -binder_predicate x " ≥ " y:term => `($x ≥ $y) -/-- Declare `∃ x < y, ...` as syntax for `∃ x, x < y ∧ ...` -/ -binder_predicate x " < " y:term => `($x < $y) -/-- Declare `∃ x ≤ y, ...` as syntax for `∃ x, x ≤ y ∧ ...` -/ -binder_predicate x " ≤ " y:term => `($x ≤ $y) -/-- Declare `∃ x ≠ y, ...` as syntax for `∃ x, x ≠ y ∧ ...` -/ -binder_predicate x " ≠ " y:term => `($x ≠ $y) diff --git a/lean-toolchain b/lean-toolchain index 2d47fabe49..cb3c234625 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-14 +leanprover/lean4:nightly-2024-02-15 From 582fb2a404a45479f7cc14e51d188fa9d841b609 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 15 Feb 2024 19:09:43 +1100 Subject: [PATCH 044/213] ripping more stuff out --- Std.lean | 2 +- Std/Classes/LawfulMonad.lean | 229 -------------------------------- Std/Data/Array/Init/Lemmas.lean | 1 - 3 files changed, 1 insertion(+), 231 deletions(-) delete mode 100644 Std/Classes/LawfulMonad.lean diff --git a/Std.lean b/Std.lean index 465474f996..de89dd8c4c 100644 --- a/Std.lean +++ b/Std.lean @@ -1,6 +1,6 @@ import Std.Classes.BEq import Std.Classes.Cast -import Std.Classes.LawfulMonad +import Std.Classes.SatisfiesM import Std.Classes.Order import Std.Classes.RatCast import Std.Classes.SetNotation diff --git a/Std/Classes/LawfulMonad.lean b/Std/Classes/LawfulMonad.lean deleted file mode 100644 index 58f98486df..0000000000 --- a/Std/Classes/LawfulMonad.lean +++ /dev/null @@ -1,229 +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 --/ - -/-- -An alternative constructor for `LawfulMonad` which has more -defaultable fields in the common case. --/ -theorem LawfulMonad.mk' (m : Type u → Type v) [Monad m] - (id_map : ∀ {α} (x : m α), id <$> x = x) - (pure_bind : ∀ {α β} (x : α) (f : α → m β), pure x >>= f = f x) - (bind_assoc : ∀ {α β γ} (x : m α) (f : α → m β) (g : β → m γ), - x >>= f >>= g = x >>= fun x => f x >>= g) - (map_const : ∀ {α β} (x : α) (y : m β), - Functor.mapConst x y = Function.const β x <$> y := by intros; rfl) - (seqLeft_eq : ∀ {α β} (x : m α) (y : m β), - x <* y = (x >>= fun a => y >>= fun _ => pure a) := by intros; rfl) - (seqRight_eq : ∀ {α β} (x : m α) (y : m β), x *> y = (x >>= fun _ => y) := by intros; rfl) - (bind_pure_comp : ∀ {α β} (f : α → β) (x : m α), - x >>= (fun y => pure (f y)) = f <$> x := by intros; rfl) - (bind_map : ∀ {α β} (f : m (α → β)) (x : m α), f >>= (. <$> x) = f <*> x := by intros; rfl) - : LawfulMonad m := - have map_pure {α β} (g : α → β) (x : α) : g <$> (pure x : m α) = pure (g x) := by - rw [← bind_pure_comp]; simp [pure_bind] - { id_map, bind_pure_comp, bind_map, pure_bind, bind_assoc, map_pure, - comp_map := by simp [← bind_pure_comp, bind_assoc, pure_bind] - pure_seq := by intros; rw [← bind_map]; simp [pure_bind] - seq_pure := by intros; rw [← bind_map]; simp [map_pure, bind_pure_comp] - seq_assoc := by simp [← bind_pure_comp, ← bind_map, bind_assoc, pure_bind] - map_const := funext fun x => funext (map_const x) - seqLeft_eq := by simp [seqLeft_eq, ← bind_map, ← bind_pure_comp, pure_bind, bind_assoc] - seqRight_eq := fun x y => by - rw [seqRight_eq, ← bind_map, ← bind_pure_comp, bind_assoc]; simp [pure_bind, id_map] } - -instance : LawfulMonad (Except ε) := LawfulMonad.mk' - (id_map := fun x => by cases x <;> rfl) - (pure_bind := fun a f => rfl) - (bind_assoc := fun a f g => by cases a <;> rfl) - -instance : LawfulApplicative (Except ε) := inferInstance -instance : LawfulFunctor (Except ε) := inferInstance - -instance : LawfulMonad Option := LawfulMonad.mk' - (id_map := fun x => by cases x <;> rfl) - (pure_bind := fun x f => rfl) - (bind_assoc := fun x f g => by cases x <;> rfl) - (bind_pure_comp := fun f x => by cases x <;> rfl) - -instance : LawfulApplicative Option := inferInstance -instance : LawfulFunctor Option := inferInstance - -instance : LawfulMonad (EStateM ε σ) := .mk' - (id_map := fun x => funext <| fun s => by - dsimp only [EStateM.instMonadEStateM, EStateM.map] - match x s with - | .ok _ _ => rfl - | .error _ _ => rfl) - (pure_bind := fun _ _ => rfl) - (bind_assoc := fun x _ _ => funext <| fun s => by - dsimp only [EStateM.instMonadEStateM, EStateM.bind] - match x s with - | .ok _ _ => rfl - | .error _ _ => rfl) - (map_const := fun _ _ => rfl) - -/-! -## SatisfiesM - -The `SatisfiesM` predicate works over an arbitrary (lawful) monad / applicative / functor, -and enables Hoare-like reasoning over monadic expressions. For example, given a monadic -function `f : α → m β`, to say that the return value of `f` satisfies `Q` whenever -the input satisfies `P`, we write `∀ a, P a → SatisfiesM Q (f a)`. --/ - -/-- -`SatisfiesM p (x : m α)` lifts propositions over a monad. It asserts that `x` may as well -have the type `x : m {a // p a}`, because there exists some `m {a // p a}` whose image is `x`. -So `p` is the postcondition of the monadic value. --/ -def SatisfiesM {m : Type u → Type v} [Functor m] (p : α → Prop) (x : m α) : Prop := - ∃ x' : m {a // p a}, Subtype.val <$> x' = x - -namespace SatisfiesM - -/-- If `p` is always true, then every `x` satisfies it. -/ -theorem of_true [Applicative m] [LawfulApplicative m] {x : m α} - (h : ∀ a, p a) : SatisfiesM p x := - ⟨(fun a => ⟨a, h a⟩) <$> x, by simp [← comp_map, Function.comp_def]⟩ - -/-- -If `p` is always true, then every `x` satisfies it. -(This is the strongest postcondition version of `of_true`.) --/ -protected theorem trivial [Applicative m] [LawfulApplicative m] {x : m α} : - SatisfiesM (fun _ => True) x := of_true fun _ => trivial - -/-- The `SatisfiesM p x` predicate is monotonic in `p`. -/ -theorem imp [Functor m] [LawfulFunctor m] {x : m α} - (h : SatisfiesM p x) (H : ∀ {a}, p a → q a) : SatisfiesM q x := - let ⟨x, h⟩ := h; ⟨(fun ⟨a, h⟩ => ⟨_, H h⟩) <$> x, by rw [← h, ← comp_map]; rfl⟩ - -/-- `SatisfiesM` distributes over `<$>`, general version. -/ -protected theorem map [Functor m] [LawfulFunctor m] {x : m α} - (hx : SatisfiesM p x) (hf : ∀ {a}, p a → q (f a)) : SatisfiesM q (f <$> x) := by - let ⟨x', hx⟩ := hx - refine ⟨(fun ⟨a, h⟩ => ⟨f a, hf h⟩) <$> x', ?_⟩ - rw [← hx]; simp [← comp_map, Function.comp_def] - -/-- -`SatisfiesM` distributes over `<$>`, strongest postcondition version. -(Use this for reasoning forward from assumptions.) --/ -theorem map_post [Functor m] [LawfulFunctor m] {x : m α} - (hx : SatisfiesM p x) : SatisfiesM (fun b => ∃ a, p a ∧ b = f a) (f <$> x) := - hx.map fun h => ⟨_, h, rfl⟩ - -/-- -`SatisfiesM` distributes over `<$>`, weakest precondition version. -(Use this for reasoning backward from the goal.) --/ -theorem map_pre [Functor m] [LawfulFunctor m] {x : m α} - (hx : SatisfiesM (fun a => p (f a)) x) : SatisfiesM p (f <$> x) := - hx.map fun h => h - -/-- `SatisfiesM` distributes over `mapConst`, general version. -/ -protected theorem mapConst [Functor m] [LawfulFunctor m] {x : m α} - (hx : SatisfiesM q x) (ha : ∀ {b}, q b → p a) : SatisfiesM p (Functor.mapConst a x) := - map_const (f := m) ▸ hx.map ha - -/-- `SatisfiesM` distributes over `pure`, general version / weakest precondition version. -/ -protected theorem pure [Applicative m] [LawfulApplicative m] - (h : p a) : SatisfiesM (m := m) p (pure a) := ⟨pure ⟨_, h⟩, by simp⟩ - -/-- `SatisfiesM` distributes over `<*>`, general version. -/ -protected theorem seq [Applicative m] [LawfulApplicative m] {x : m α} - (hf : SatisfiesM p₁ f) (hx : SatisfiesM p₂ x) - (H : ∀ {f a}, p₁ f → p₂ a → q (f a)) : SatisfiesM q (f <*> x) := by - match f, x, hf, hx with | _, _, ⟨f, rfl⟩, ⟨x, rfl⟩ => ?_ - refine ⟨(fun ⟨a, h₁⟩ ⟨b, h₂⟩ => ⟨a b, H h₁ h₂⟩) <$> f <*> x, ?_⟩ - simp only [← pure_seq]; simp [SatisfiesM, seq_assoc] - simp only [← pure_seq]; simp [seq_assoc, Function.comp_def] - -/-- `SatisfiesM` distributes over `<*>`, strongest postcondition version. -/ -protected theorem seq_post [Applicative m] [LawfulApplicative m] {x : m α} - (hf : SatisfiesM p₁ f) (hx : SatisfiesM p₂ x) : - SatisfiesM (fun c => ∃ f a, p₁ f ∧ p₂ a ∧ c = f a) (f <*> x) := - hf.seq hx fun hf ha => ⟨_, _, hf, ha, rfl⟩ - -/-- -`SatisfiesM` distributes over `<*>`, weakest precondition version 1. -(Use this when `x` and the goal are known and `f` is a subgoal.) --/ -protected theorem seq_pre [Applicative m] [LawfulApplicative m] {x : m α} - (hf : SatisfiesM (fun f => ∀ {a}, p₂ a → q (f a)) f) (hx : SatisfiesM p₂ x) : - SatisfiesM q (f <*> x) := - hf.seq hx fun hf ha => hf ha - -/-- -`SatisfiesM` distributes over `<*>`, weakest precondition version 2. -(Use this when `f` and the goal are known and `x` is a subgoal.) --/ -protected theorem seq_pre' [Applicative m] [LawfulApplicative m] {x : m α} - (hf : SatisfiesM p₁ f) (hx : SatisfiesM (fun a => ∀ {f}, p₁ f → q (f a)) x) : - SatisfiesM q (f <*> x) := - hf.seq hx fun hf ha => ha hf - -/-- `SatisfiesM` distributes over `<*`, general version. -/ -protected theorem seqLeft [Applicative m] [LawfulApplicative m] {x : m α} - (hx : SatisfiesM p₁ x) (hy : SatisfiesM p₂ y) - (H : ∀ {a b}, p₁ a → p₂ b → q a) : SatisfiesM q (x <* y) := - seqLeft_eq x y ▸ (hx.map fun h _ => H h).seq_pre hy - -/-- `SatisfiesM` distributes over `*>`, general version. -/ -protected theorem seqRight [Applicative m] [LawfulApplicative m] {x : m α} - (hx : SatisfiesM p₁ x) (hy : SatisfiesM p₂ y) - (H : ∀ {a b}, p₁ a → p₂ b → q b) : SatisfiesM q (x *> y) := - seqRight_eq x y ▸ (hx.map fun h _ => H h).seq_pre hy - -/-- `SatisfiesM` distributes over `>>=`, general version. -/ -protected theorem bind [Monad m] [LawfulMonad m] {f : α → m β} - (hx : SatisfiesM p x) (hf : ∀ a, p a → SatisfiesM q (f a)) : - SatisfiesM q (x >>= f) := by - match x, hx with | _, ⟨x, rfl⟩ => ?_ - have g a ha := Classical.indefiniteDescription _ (hf a ha) - refine ⟨x >>= fun ⟨a, h⟩ => g a h, ?_⟩ - simp [← bind_pure_comp]; congr; funext ⟨a, h⟩; simp [← (g a h).2, ← bind_pure_comp] - -/-- `SatisfiesM` distributes over `>>=`, weakest precondition version. -/ -protected theorem bind_pre [Monad m] [LawfulMonad m] {f : α → m β} - (hx : SatisfiesM (fun a => SatisfiesM q (f a)) x) : - SatisfiesM q (x >>= f) := hx.bind fun _ h => h - -end SatisfiesM - -@[simp] theorem SatisfiesM_Id_eq : SatisfiesM (m := Id) p x ↔ p x := - ⟨fun ⟨y, eq⟩ => eq ▸ y.2, fun h => ⟨⟨_, h⟩, rfl⟩⟩ - -@[simp] theorem SatisfiesM_Option_eq : SatisfiesM (m := Option) p x ↔ ∀ a, x = some a → p a := - ⟨by revert x; intro | some _, ⟨some ⟨_, h⟩, rfl⟩, _, rfl => exact h, - fun h => match x with | some a => ⟨some ⟨a, h _ rfl⟩, rfl⟩ | none => ⟨none, rfl⟩⟩ - -@[simp] theorem SatisfiesM_Except_eq : SatisfiesM (m := Except ε) p x ↔ ∀ a, x = .ok a → p a := - ⟨by revert x; intro | .ok _, ⟨.ok ⟨_, h⟩, rfl⟩, _, rfl => exact h, - fun h => match x with | .ok a => ⟨.ok ⟨a, h _ rfl⟩, rfl⟩ | .error e => ⟨.error e, rfl⟩⟩ - -@[simp] theorem SatisfiesM_ReaderT_eq [Monad m] : - SatisfiesM (m := ReaderT ρ m) p x ↔ ∀ s, SatisfiesM p (x s) := - (exists_congr fun a => by exact ⟨fun eq _ => eq ▸ rfl, funext⟩).trans Classical.skolem.symm - -theorem SatisfiesM_StateRefT_eq [Monad m] : - SatisfiesM (m := StateRefT' ω σ m) p x ↔ ∀ s, SatisfiesM p (x s) := by simp - -@[simp] theorem SatisfiesM_StateT_eq [Monad m] [LawfulMonad m] : - SatisfiesM (m := StateT ρ m) (α := α) p x ↔ ∀ s, SatisfiesM (m := m) (p ·.1) (x s) := by - refine .trans ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, h⟩ => ?_⟩ Classical.skolem.symm - · refine ⟨fun s => (fun ⟨⟨a, h⟩, s'⟩ => ⟨⟨a, s'⟩, h⟩) <$> f s, fun s => ?_⟩ - rw [← comp_map, map_eq_pure_bind]; rfl - · refine ⟨fun s => (fun ⟨⟨a, s'⟩, h⟩ => ⟨⟨a, h⟩, s'⟩) <$> f s, funext fun s => ?_⟩ - show _ >>= _ = _; simp [map_eq_pure_bind, ← h] - -@[simp] theorem SatisfiesM_ExceptT_eq [Monad m] [LawfulMonad m] : - SatisfiesM (m := ExceptT ρ m) (α := α) p x ↔ SatisfiesM (m := m) (∀ a, · = .ok a → p a) x := by - refine ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, eq⟩ => eq ▸ ?_⟩ - · exists (fun | .ok ⟨a, h⟩ => ⟨.ok a, fun | _, rfl => h⟩ | .error e => ⟨.error e, nofun⟩) <$> f - show _ = _ >>= _; rw [← comp_map, map_eq_pure_bind]; congr; funext a; cases a <;> rfl - · exists ((fun | ⟨.ok a, h⟩ => .ok ⟨a, h _ rfl⟩ | ⟨.error e, _⟩ => .error e) <$> f : m _) - show _ >>= _ = _; simp [← comp_map, map_eq_pure_bind]; congr; funext ⟨a, h⟩; cases a <;> rfl diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index 128b619138..35f9be95d2 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Bool -import Std.Classes.LawfulMonad import Std.Data.Nat.Init.Lemmas import Std.Data.List.Init.Lemmas From e532f57235e3f8a5de118bf92204859654afd144 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 15 Feb 2024 19:24:53 +1100 Subject: [PATCH 045/213] push --- Std/Data/Array/Init/Lemmas.lean | 170 +-------- Std/Data/Array/Lemmas.lean | 1 + Std/Data/HashMap/Basic.lean | 1 + Std/Data/Int/Init/DivMod.lean | 1 - Std/Data/List/Basic.lean | 2 - Std/Data/List/Count.lean | 1 + Std/Data/List/Init/Lemmas.lean | 607 +------------------------------- Std/Data/Nat/Gcd.lean | 1 - Std/Data/Nat/Init/Dvd.lean | 95 ----- Std/Data/Nat/Init/Gcd.lean | 42 --- Std/Tactic/PermuteGoals.lean | 1 + 11 files changed, 6 insertions(+), 916 deletions(-) delete mode 100644 Std/Data/Nat/Init/Dvd.lean delete mode 100644 Std/Data/Nat/Init/Gcd.lean diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index e0bb1bc5a3..4fc2cbd60c 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -5,6 +5,7 @@ Authors: Mario Carneiro -/ import Std.Data.Bool import Std.Data.List.Init.Lemmas +import Std.Classes.SatisfiesM /-! ## Bootstrapping theorems about arrays @@ -14,90 +15,6 @@ This file contains some theorems about `Array` and `List` needed for `Std.List.B namespace Array -attribute [simp] data_toArray uset - -@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl - -@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size] - -@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size] - -theorem getElem_eq_data_get (a : Array α) (h : i < a.size) : a[i] = a.data.get ⟨i, h⟩ := by - by_cases i < a.size <;> (try simp [*]) <;> rfl - -theorem foldlM_eq_foldlM_data.aux [Monad m] - (f : β → α → m β) (arr : Array α) (i j) (H : arr.size ≤ i + j) (b) : - foldlM.loop f arr arr.size (Nat.le_refl _) i j b = (arr.data.drop j).foldlM f b := by - unfold foldlM.loop - split; split - · cases Nat.not_le_of_gt ‹_› (Nat.zero_add _ ▸ H) - · rename_i i; rw [Nat.succ_add] at H - simp [foldlM_eq_foldlM_data.aux f arr i (j+1) H] - conv => rhs; rw [← List.get_drop_eq_drop _ _ ‹_›] - · rw [List.drop_length_le (Nat.ge_of_not_lt ‹_›)]; rfl - -theorem foldlM_eq_foldlM_data [Monad m] - (f : β → α → m β) (init : β) (arr : Array α) : - arr.foldlM f init = arr.data.foldlM f init := by - simp [foldlM, foldlM_eq_foldlM_data.aux] - -theorem foldl_eq_foldl_data (f : β → α → β) (init : β) (arr : Array α) : - arr.foldl f init = arr.data.foldl f init := - List.foldl_eq_foldlM .. ▸ foldlM_eq_foldlM_data .. - -theorem foldrM_eq_reverse_foldlM_data.aux [Monad m] - (f : α → β → m β) (arr : Array α) (init : β) (i h) : - (arr.data.take i).reverse.foldlM (fun x y => f y x) init = foldrM.fold f arr 0 i h init := by - unfold foldrM.fold - match i with - | 0 => simp [List.foldlM, List.take] - | i+1 => rw [← List.take_concat_get _ _ h]; simp [← (aux f arr · i)]; rfl - -theorem foldrM_eq_reverse_foldlM_data [Monad m] (f : α → β → m β) (init : β) (arr : Array α) : - arr.foldrM f init = arr.data.reverse.foldlM (fun x y => f y x) init := by - have : arr = #[] ∨ 0 < arr.size := - match arr with | ⟨[]⟩ => .inl rfl | ⟨a::l⟩ => .inr (Nat.zero_lt_succ _) - match arr, this with | _, .inl rfl => rfl | arr, .inr h => ?_ - simp [foldrM, h, ← foldrM_eq_reverse_foldlM_data.aux, List.take_length] - -theorem foldrM_eq_foldrM_data [Monad m] - (f : α → β → m β) (init : β) (arr : Array α) : - arr.foldrM f init = arr.data.foldrM f init := by - rw [foldrM_eq_reverse_foldlM_data, List.foldlM_reverse] - -theorem foldr_eq_foldr_data (f : α → β → β) (init : β) (arr : Array α) : - arr.foldr f init = arr.data.foldr f init := - List.foldr_eq_foldrM .. ▸ foldrM_eq_foldrM_data .. - -@[simp] theorem push_data (arr : Array α) (a : α) : (arr.push a).data = arr.data ++ [a] := by - simp [push, List.concat_eq_append] - -theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) : - (arr.push a).foldrM f init = f a init >>= arr.foldrM f := by - simp [foldrM_eq_reverse_foldlM_data, -size_push] - -@[simp] theorem foldrM_push' [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) : - (arr.push a).foldrM f init (start := arr.size + 1) = f a init >>= arr.foldrM f := by - simp [← foldrM_push] - -theorem foldr_push (f : α → β → β) (init : β) (arr : Array α) (a : α) : - (arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push .. - -@[simp] theorem foldr_push' (f : α → β → β) (init : β) (arr : Array α) (a : α) : - (arr.push a).foldr f init (start := arr.size + 1) = arr.foldr f (f a init) := foldrM_push' .. - -@[simp] theorem toListAppend_eq (arr : Array α) (l) : arr.toListAppend l = arr.data ++ l := by - simp [toListAppend, foldr_eq_foldr_data] - -@[simp] theorem toList_eq (arr : Array α) : arr.toList = arr.data := by - simp [toList, foldr_eq_foldr_data] - -/-- A more efficient version of `arr.toList.reverse`. -/ -@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) [] - -@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.data.reverse := by - rw [toListRev, foldl_eq_foldl_data, ← List.foldr_reverse, List.foldr_self] - theorem SatisfiesM_foldlM [Monad m] [LawfulMonad m] {as : Array α} (motive : Nat → β → Prop) {init : β} (h0 : motive 0 init) {f : β → α → m β} (hf : ∀ i : Fin as.size, ∀ b, motive i.1 b → SatisfiesM (motive (i.1 + 1)) (f b as[i])) : @@ -120,35 +37,6 @@ theorem foldl_induction simp [SatisfiesM_Id_eq] at this exact this hf -theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) : - haveI : 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_data_get, List.concat_eq_append, List.get_append_left, h] - -@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by - simp only [push, getElem_eq_data_get, List.concat_eq_append] - rw [List.get_append_right] <;> simp [getElem_eq_data_get, Nat.zero_lt_one] - -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 - if h' : i < a.size then - simp [get_push_lt, h'] - else - simp at h - simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')] - -theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α → m β) (arr : Array α) : - arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by - rw [mapM, aux, foldlM_eq_foldlM_data]; rfl -where - aux (i r) : - mapM.map f arr i r = (arr.data.drop i).foldlM (fun bs a => bs.push <$> f a) r := by - unfold mapM.map; split - · rw [← List.get_drop_eq_drop _ i ‹_›] - simp [aux (i+1), map_eq_pure_bind]; rfl - · rw [List.drop_length_le (Nat.ge_of_not_lt ‹_›)]; rfl - termination_by arr.size - i - theorem SatisfiesM_mapM [Monad m] [LawfulMonad m] (as : Array α) (f : α → m β) (motive : Nat → Prop) (h0 : motive 0) (p : Fin as.size → β → Prop) @@ -179,65 +67,12 @@ theorem size_mapM [Monad m] [LawfulMonad m] (f : α → m β) (as : Array α) : SatisfiesM (fun arr => arr.size = as.size) (Array.mapM f as) := (SatisfiesM_mapM' _ _ (fun _ _ => True) (fun _ => .trivial)).imp (·.1) -@[simp] theorem map_data (f : α → β) (arr : Array α) : (arr.map f).data = arr.data.map f := by - rw [map, mapM_eq_foldlM] - apply congrArg data (foldl_eq_foldl_data (fun bs a => push bs (f a)) #[] arr) |>.trans - have H (l arr) : List.foldl (fun bs a => push bs (f a)) arr l = ⟨arr.data ++ l.map f⟩ := by - induction l generalizing arr <;> simp [*] - simp [H] - -@[simp] theorem size_map (f : α → β) (arr : Array α) : (arr.map f).size = arr.size := by - simp [size] - @[simp] theorem getElem_map (f : α → β) (arr : Array α) (i : Nat) (h) : ((arr.map f)[i]'h) = f (arr[i]'(size_map .. ▸ h)) := by have := SatisfiesM_mapM' (m := Id) arr f (fun i b => b = f (arr[i])) simp [SatisfiesM_Id_eq] at this exact this.2 i (size_map .. ▸ h) -@[simp] theorem pop_data (arr : Array α) : arr.pop.data = arr.data.dropLast := rfl - -@[simp] theorem append_eq_append (arr arr' : Array α) : arr.append arr' = arr ++ arr' := rfl - -@[simp] theorem append_data (arr arr' : Array α) : - (arr ++ arr').data = arr.data ++ arr'.data := by - rw [← append_eq_append]; unfold Array.append - rw [foldl_eq_foldl_data] - induction arr'.data generalizing arr <;> simp [*] - -@[simp] theorem appendList_eq_append - (arr : Array α) (l : List α) : arr.appendList l = arr ++ l := rfl - -@[simp] theorem appendList_data (arr : Array α) (l : List α) : - (arr ++ l).data = arr.data ++ l := by - rw [← appendList_eq_append]; unfold Array.appendList - induction l generalizing arr <;> simp [*] - -@[simp] theorem appendList_nil (arr : Array α) : arr ++ ([] : List α) = arr := Array.ext' (by simp) - -@[simp] theorem appendList_cons (arr : Array α) (a : α) (l : List α) : - arr ++ (a :: l) = arr.push a ++ l := Array.ext' (by simp) - -theorem foldl_data_eq_bind (l : List α) (acc : Array β) - (F : Array β → α → Array β) (G : α → List β) - (H : ∀ acc a, (F acc a).data = acc.data ++ G a) : - (l.foldl F acc).data = acc.data ++ l.bind G := by - induction l generalizing acc <;> simp [*, List.bind] - -theorem foldl_data_eq_map (l : List α) (acc : Array β) (G : α → β) : - (l.foldl (fun acc a => acc.push (G a)) acc).data = acc.data ++ l.map G := by - induction l generalizing acc <;> simp [*] - -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 - -theorem anyM_stop_le_start [Monad m] (p : α → m Bool) (as : Array α) (start stop) - (h : min stop as.size ≤ start) : anyM p as start stop = pure false := by - rw [anyM_eq_anyM_loop, anyM.loop, dif_neg (Nat.not_lt.2 h)] - theorem SatisfiesM_anyM [Monad m] [LawfulMonad m] (p : α → m Bool) (as : Array α) (start stop) (hstart : start ≤ min stop as.size) (tru : Prop) (fal : Nat → Prop) (h0 : fal start) (hp : ∀ i : Fin as.size, i.1 < stop → fal i.1 → @@ -296,9 +131,6 @@ theorem any_iff_exists (p : α → Bool) (as : Array α) (start stop) : theorem any_eq_true (p : α → Bool) (as : Array α) : any as p ↔ ∃ i : Fin as.size, p as[i] := by simp [any_iff_exists, Fin.isLt] -theorem mem_def (a : α) (as : Array α) : a ∈ as ↔ a ∈ as.data := - ⟨fun | .mk h => h, Array.Mem.mk⟩ - theorem any_def {p : α → Bool} (as : Array α) : as.any p = as.data.any p := by rw [Bool.eq_iff_iff, any_eq_true, List.any_eq_true]; simp only [List.mem_iff_get] exact ⟨fun ⟨i, h⟩ => ⟨_, ⟨i, rfl⟩, h⟩, fun ⟨_, ⟨i, rfl⟩, h⟩ => ⟨i, h⟩⟩ diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 7a7c3767ef..79a0cc6257 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -6,6 +6,7 @@ Authors: Mario Carneiro, Gabriel Ebner -/ import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas +import Std.Data.Array.Init.Lemmas import Std.Data.Array.Basic import Std.Tactic.SeqFocus import Std.Tactic.Simpa diff --git a/Std/Data/HashMap/Basic.lean b/Std/Data/HashMap/Basic.lean index 9635d17ce3..5a41196e0f 100644 --- a/Std/Data/HashMap/Basic.lean +++ b/Std/Data/HashMap/Basic.lean @@ -5,6 +5,7 @@ Authors: Leonardo de Moura, Mario Carneiro -/ import Std.Data.AssocList import Std.Data.Nat.Basic +import Std.Data.Array.Init.Lemmas import Std.Classes.BEq namespace Std.HashMap diff --git a/Std/Data/Int/Init/DivMod.lean b/Std/Data/Int/Init/DivMod.lean index cf7c35e507..a0eeb55ae8 100644 --- a/Std/Data/Int/Init/DivMod.lean +++ b/Std/Data/Int/Init/DivMod.lean @@ -3,7 +3,6 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ -import Std.Data.Nat.Init.Dvd import Std.Data.Int.Init.Order /-! diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index bdab46df03..a60b09b962 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -3,9 +3,7 @@ Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ -import Std.Classes.SetNotation import Std.Data.Option.Init.Lemmas -import Std.Data.Array.Init.Lemmas namespace List diff --git a/Std/Data/List/Count.lean b/Std/Data/List/Count.lean index 005bf24721..5f966f1fb3 100644 --- a/Std/Data/List/Count.lean +++ b/Std/Data/List/Count.lean @@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M -/ import Std.Data.List.Basic import Std.Data.List.Lemmas +import Std.Data.List.Init.Lemmas /-! # Counting in lists diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean index 4eb3d246d0..9970fa69c9 100644 --- a/Std/Data/List/Init/Lemmas.lean +++ b/Std/Data/List/Init/Lemmas.lean @@ -16,614 +16,9 @@ These are theorems used in the definitions of `Std.Data.List.Basic` and tactics. New theorems should be added to `Std.Data.List.Lemmas` if they are not needed by the bootstrap. -/ -attribute [simp] concat_eq_append append_assoc - -@[simp] theorem get?_nil : @get? α [] n = none := rfl -@[simp] theorem get?_cons_zero : @get? α (a::l) 0 = some a := rfl -@[simp] theorem get?_cons_succ : @get? α (a::l) (n+1) = get? l n := rfl -@[simp] theorem get_cons_zero : get (a::l) (0 : Fin (l.length + 1)) = a := rfl -@[simp] theorem head?_nil : @head? α [] = none := rfl -@[simp] theorem head?_cons : @head? α (a::l) = some a := rfl -@[simp 1100] theorem headD_nil : @headD α [] d = d := rfl -@[simp 1100] theorem headD_cons : @headD α (a::l) d = a := rfl -@[simp] theorem head_cons : @head α (a::l) h = a := rfl -@[simp] theorem tail?_nil : @tail? α [] = none := rfl -@[simp] theorem tail?_cons : @tail? α (a::l) = some l := rfl -@[simp] theorem tail!_cons : @tail! α (a::l) = l := rfl -@[simp 1100] theorem tailD_nil : @tailD α [] l' = l' := rfl -@[simp 1100] theorem tailD_cons : @tailD α (a::l) l' = l := rfl -@[simp] theorem any_nil : [].any f = false := rfl -@[simp] theorem any_cons : (a::l).any f = (f a || l.any f) := rfl -@[simp] theorem all_nil : [].all f = true := rfl -@[simp] theorem all_cons : (a::l).all f = (f a && l.all f) := rfl -@[simp] theorem or_nil : [].or = false := rfl -@[simp] theorem or_cons : (a::l).or = (a || l.or) := rfl -@[simp] theorem and_nil : [].and = true := rfl -@[simp] theorem and_cons : (a::l).and = (a && l.and) := rfl - -/-! ### length -/ - -theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl - -theorem ne_nil_of_length_eq_succ (_ : length l = succ n) : l ≠ [] := fun _ => nomatch l - -theorem length_eq_zero : length l = 0 ↔ l = [] := - ⟨eq_nil_of_length_eq_zero, fun h => h ▸ rfl⟩ - -/-! ### mem -/ - -@[simp] theorem not_mem_nil (a : α) : ¬ a ∈ [] := nofun - -@[simp] theorem mem_cons : a ∈ (b :: l) ↔ a = b ∨ a ∈ l := - ⟨fun h => by cases h <;> simp [Membership.mem, *], - fun | Or.inl rfl => by constructor | Or.inr h => by constructor; assumption⟩ - -theorem mem_cons_self (a : α) (l : List α) : a ∈ a :: l := .head .. - -theorem mem_cons_of_mem (y : α) {a : α} {l : List α} : a ∈ l → a ∈ y :: l := .tail _ - -theorem eq_nil_iff_forall_not_mem {l : List α} : l = [] ↔ ∀ a, a ∉ l := by - cases l <;> simp - -/-! ### append -/ - -@[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl - -theorem append_inj : - ∀ {s₁ s₂ t₁ t₂ : List α}, s₁ ++ t₁ = s₂ ++ t₂ → length s₁ = length s₂ → s₁ = s₂ ∧ t₁ = t₂ - | [], [], t₁, t₂, h, _ => ⟨rfl, h⟩ - | a :: s₁, b :: s₂, t₁, t₂, h, hl => by - simp [append_inj (cons.inj h).2 (Nat.succ.inj hl)] at h ⊢; exact h - -theorem append_inj_right (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : t₁ = t₂ := - (append_inj h hl).right - -theorem append_inj_left (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : s₁ = s₂ := - (append_inj h hl).left - -theorem append_inj' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ ∧ t₁ = t₂ := - append_inj h <| @Nat.add_right_cancel _ (length t₁) _ <| by - let hap := congrArg length h; simp only [length_append, ← hl] at hap; exact hap - -theorem append_inj_right' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : t₁ = t₂ := - (append_inj' h hl).right - -theorem append_inj_left' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ := - (append_inj' h hl).left - -theorem append_right_inj {t₁ t₂ : List α} (s) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ := - ⟨fun h => append_inj_right h rfl, congrArg _⟩ - -theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ := - ⟨fun h => append_inj_left' h rfl, congrArg (· ++ _)⟩ - -@[simp] theorem append_eq_nil : p ++ q = [] ↔ p = [] ∧ q = [] := by - cases p <;> simp - -/-! ### map -/ - -@[simp] theorem map_nil {f : α → β} : map f [] = [] := rfl - -@[simp] theorem map_cons (f : α → β) a l : map f (a :: l) = f a :: map f l := rfl - -@[simp] theorem map_append (f : α → β) : ∀ l₁ l₂, map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by - intro l₁; induction l₁ <;> intros <;> simp_all - -@[simp] theorem map_id (l : List α) : map id l = l := by induction l <;> simp_all - -@[simp] theorem map_id' (l : List α) : map (fun a => a) l = l := by induction l <;> simp_all - -@[simp] theorem mem_map {f : α → β} : ∀ {l : List α}, b ∈ l.map f ↔ ∃ a, a ∈ l ∧ f a = b - | [] => by simp - | _ :: l => by simp [mem_map (l := l), eq_comm (a := b)] - -theorem mem_map_of_mem (f : α → β) (h : a ∈ l) : f a ∈ map f l := mem_map.2 ⟨_, h, rfl⟩ - -@[simp] theorem map_map (g : β → γ) (f : α → β) (l : List α) : - map g (map f l) = map (g ∘ f) l := by induction l <;> simp_all - -/-! ### bind -/ - -@[simp] theorem nil_bind (f : α → List β) : List.bind [] f = [] := by simp [join, List.bind] - -@[simp] theorem cons_bind x xs (f : α → List β) : - List.bind (x :: xs) f = f x ++ List.bind xs f := by simp [join, List.bind] - -@[simp] theorem append_bind xs ys (f : α → List β) : - List.bind (xs ++ ys) f = List.bind xs f ++ List.bind ys f := by - induction xs; {rfl}; simp_all [cons_bind, append_assoc] - -@[simp] theorem bind_id (l : List (List α)) : List.bind l id = l.join := by simp [List.bind] - -/-! ### join -/ - -@[simp] theorem join_nil : List.join ([] : List (List α)) = [] := rfl - -@[simp] theorem join_cons : (l :: ls).join = l ++ ls.join := rfl - -/-! ### bounded quantifiers over Lists -/ - -theorem forall_mem_cons {p : α → Prop} {a : α} {l : List α} : - (∀ x, x ∈ a :: l → p x) ↔ p a ∧ ∀ x, x ∈ l → p x := - ⟨fun H => ⟨H _ (.head ..), fun _ h => H _ (.tail _ h)⟩, - fun ⟨H₁, H₂⟩ _ => fun | .head .. => H₁ | .tail _ h => H₂ _ h⟩ - -/-! ### reverse -/ - -@[simp] theorem reverseAux_nil : reverseAux [] r = r := rfl -@[simp] theorem reverseAux_cons : reverseAux (a::l) r = reverseAux l (a::r) := rfl - -theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs := - reverseAux_eq_append .. - -theorem reverse_map (f : α → β) (l : List α) : (l.map f).reverse = l.reverse.map f := by - induction l <;> simp [*] - -@[simp] theorem reverse_eq_nil_iff {xs : List α} : xs.reverse = [] ↔ xs = [] := by - match xs with - | [] => simp - | x :: xs => simp - -/-! ### nth element -/ - -theorem get_of_mem : ∀ {a} {l : List α}, a ∈ l → ∃ n, get l n = a - | _, _ :: _, .head .. => ⟨⟨0, Nat.succ_pos _⟩, rfl⟩ - | _, _ :: _, .tail _ m => let ⟨⟨n, h⟩, e⟩ := get_of_mem m; ⟨⟨n+1, Nat.succ_lt_succ h⟩, e⟩ - -theorem get_mem : ∀ (l : List α) n h, get l ⟨n, h⟩ ∈ l - | _ :: _, 0, _ => .head .. - | _ :: l, _+1, _ => .tail _ (get_mem l ..) - -theorem mem_iff_get {a} {l : List α} : a ∈ l ↔ ∃ n, get l n = a := - ⟨get_of_mem, fun ⟨_, e⟩ => e ▸ get_mem ..⟩ - -theorem get?_len_le : ∀ {l : List α} {n}, length l ≤ n → l.get? n = none - | [], _, _ => rfl - | _ :: l, _+1, h => get?_len_le (l := l) <| Nat.le_of_succ_le_succ h - -theorem get?_eq_get : ∀ {l : List α} {n} (h : n < l.length), l.get? n = some (get l ⟨n, h⟩) - | _ :: _, 0, _ => rfl - | _ :: l, _+1, _ => get?_eq_get (l := l) _ - -theorem get?_eq_some : l.get? n = some a ↔ ∃ h, get l ⟨n, h⟩ = a := - ⟨fun e => - have : n < length l := Nat.gt_of_not_le fun hn => by cases get?_len_le hn ▸ e - ⟨this, by rwa [get?_eq_get this, Option.some.injEq] at e⟩, - fun ⟨h, e⟩ => e ▸ get?_eq_get _⟩ - -@[simp] theorem get?_eq_none : l.get? n = none ↔ length l ≤ n := - ⟨fun e => Nat.ge_of_not_lt (fun h' => by cases e ▸ get?_eq_some.2 ⟨h', rfl⟩), get?_len_le⟩ - -@[simp] theorem get?_map (f : α → β) : ∀ l n, (map f l).get? n = (l.get? n).map f - | [], _ => rfl - | _ :: _, 0 => rfl - | _ :: l, n+1 => get?_map f l n - -@[simp] theorem get?_concat_length : ∀ (l : List α) (a : α), (l ++ [a]).get? l.length = some a - | [], a => rfl - | b :: l, a => by rw [cons_append, length_cons]; simp only [get?, get?_concat_length] - -theorem getLast_eq_get : ∀ (l : List α) (h : l ≠ []), - getLast l h = l.get ⟨l.length - 1, by - match l with - | [] => contradiction - | a :: l => exact Nat.le_refl _⟩ - | [a], h => rfl - | a :: b :: l, h => by - simp [getLast, get, Nat.succ_sub_succ, getLast_eq_get] - -@[simp] theorem getLast?_nil : @getLast? α [] = none := rfl - -theorem getLast?_eq_getLast : ∀ l h, @getLast? α l = some (getLast l h) - | [], h => nomatch h rfl - | _::_, _ => rfl - -theorem getLast?_eq_get? : ∀ (l : List α), getLast? l = l.get? (l.length - 1) - | [] => rfl - | a::l => by rw [getLast?_eq_getLast (a::l) nofun, getLast_eq_get, get?_eq_get] - -@[simp] theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by - simp [getLast?_eq_get?, Nat.succ_sub_succ] - -/-! ### take and drop -/ - -@[simp] theorem take_append_drop : ∀ (n : Nat) (l : List α), take n l ++ drop n l = l - | 0, _ => rfl - | _+1, [] => rfl - | n+1, x :: xs => congrArg (cons x) <| take_append_drop n xs - -@[simp] theorem length_drop : ∀ (i : Nat) (l : List α), length (drop i l) = length l - i - | 0, _ => rfl - | succ i, [] => Eq.symm (Nat.zero_sub (succ i)) - | succ i, x :: l => calc - length (drop (succ i) (x :: l)) = length l - i := length_drop i l - _ = succ (length l) - succ i := (Nat.succ_sub_succ_eq_sub (length l) i).symm - -theorem drop_length_le {l : List α} (h : l.length ≤ i) : drop i l = [] := - length_eq_zero.1 (length_drop .. ▸ Nat.sub_eq_zero_of_le h) - -theorem take_length_le {l : List α} (h : l.length ≤ i) : take i l = l := by - have := take_append_drop i l - rw [drop_length_le h, append_nil] at this; exact this - -@[simp] theorem take_zero (l : List α) : l.take 0 = [] := rfl - -@[simp] theorem take_nil : ([] : List α).take i = [] := by cases i <;> rfl - -@[simp] theorem take_cons_succ : (a::as).take (i+1) = a :: as.take i := rfl - -@[simp] theorem drop_zero (l : List α) : l.drop 0 = l := rfl - -@[simp] theorem drop_succ_cons : (a :: l).drop (n + 1) = l.drop n := rfl - -@[simp] theorem drop_length (l : List α) : drop l.length l = [] := drop_length_le (Nat.le_refl _) - -@[simp] theorem take_length (l : List α) : take l.length l = l := take_length_le (Nat.le_refl _) - -theorem take_concat_get (l : List α) (i : Nat) (h : i < l.length) : - (l.take i).concat l[i] = l.take (i+1) := - Eq.symm <| (append_left_inj _).1 <| (take_append_drop (i+1) l).trans <| by - rw [concat_eq_append, append_assoc, singleton_append, get_drop_eq_drop, take_append_drop] - -theorem reverse_concat (l : List α) (a : α) : (l.concat a).reverse = a :: l.reverse := by - rw [concat_eq_append, reverse_append]; rfl - -/-! ### takeWhile and dropWhile -/ - -@[simp] theorem dropWhile_nil : ([] : List α).dropWhile p = [] := rfl - -theorem dropWhile_cons : - (x :: xs : List α).dropWhile p = if p x then xs.dropWhile p else x :: xs := by - split <;> simp_all [dropWhile] - -/-! ### foldlM and foldrM -/ - -@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β → α → m β) (b) : - l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl - -@[simp] theorem foldlM_nil [Monad m] (f : β → α → m β) (b) : [].foldlM f b = pure b := rfl - -@[simp] theorem foldlM_cons [Monad m] (f : β → α → m β) (b) (a) (l : List α) : - (a :: l).foldlM f b = f b a >>= l.foldlM f := by - simp [List.foldlM] - -@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : List α) : - (l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by - induction l generalizing b <;> simp [*] - -@[simp] theorem foldrM_nil [Monad m] (f : α → β → m β) (b) : [].foldrM f b = pure b := rfl - -@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α → β → m β) (b) : - (a :: l).foldrM f b = l.foldrM f b >>= f a := by - simp only [foldrM] - induction l <;> simp_all - -@[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α → β → m β) (b) : - l.reverse.foldrM f b = l.foldlM (fun x y => f y x) b := - (foldlM_reverse ..).symm.trans <| by simp - -theorem foldl_eq_foldlM (f : β → α → β) (b) (l : List α) : - l.foldl f b = l.foldlM (m := Id) f b := by - induction l generalizing b <;> simp [*, foldl] - -theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) : - l.foldr f b = l.foldrM (m := Id) f b := by - induction l <;> simp [*, foldr] - -/-! ### foldl and foldr -/ - -@[simp] theorem foldl_reverse (l : List α) (f : β → α → β) (b) : - l.reverse.foldl f b = l.foldr (fun x y => f y x) b := by simp [foldl_eq_foldlM, foldr_eq_foldrM] - -@[simp] theorem foldr_reverse (l : List α) (f : α → β → β) (b) : - l.reverse.foldr f b = l.foldl (fun x y => f y x) b := - (foldl_reverse ..).symm.trans <| by simp - -@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α → β → m β) (b) (l l' : List α) : - (l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by - induction l <;> simp [*] - -@[simp] theorem foldl_append {β : Type _} (f : β → α → β) (b) (l l' : List α) : - (l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM] - -@[simp] theorem foldr_append (f : α → β → β) (b) (l l' : List α) : - (l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM] - -@[simp] theorem foldl_nil : [].foldl f b = b := rfl - -@[simp] theorem foldl_cons (l : List α) (b : β) : (a :: l).foldl f b = l.foldl f (f b a) := rfl - -@[simp] theorem foldr_nil : [].foldr f b = b := rfl - -@[simp] theorem foldr_cons (l : List α) : (a :: l).foldr f b = f a (l.foldr f b) := rfl - -@[simp] theorem foldr_self_append (l : List α) : l.foldr cons l' = l ++ l' := by - induction l <;> simp [*] - -theorem foldr_self (l : List α) : l.foldr cons [] = l := by simp - -/-! ### mapM -/ - -/-- Alternate (non-tail-recursive) form of mapM for proofs. -/ -def mapM' [Monad m] (f : α → m β) : List α → m (List β) - | [] => pure [] - | a :: l => return (← f a) :: (← l.mapM' f) - -@[simp] theorem mapM'_nil [Monad m] {f : α → m β} : mapM' f [] = pure [] := rfl -@[simp] theorem mapM'_cons [Monad m] {f : α → m β} : - mapM' f (a :: l) = return ((← f a) :: (← l.mapM' f)) := - rfl - -theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α) : - mapM' f l = mapM f l := by simp [go, mapM] where - go : ∀ l acc, mapM.loop f l acc = return acc.reverse ++ (← mapM' f l) - | [], acc => by simp [mapM.loop, mapM'] - | a::l, acc => by simp [go l, mapM.loop, mapM'] - -@[simp] theorem mapM_nil [Monad m] (f : α → m β) : [].mapM f = pure [] := rfl - -@[simp] theorem mapM_cons [Monad m] [LawfulMonad m] (f : α → m β) : - (a :: l).mapM f = (return (← f a) :: (← l.mapM f)) := by simp [← mapM'_eq_mapM, mapM'] - -@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α → m β) {l₁ l₂ : List α} : - (l₁ ++ l₂).mapM f = (return (← l₁.mapM f) ++ (← l₂.mapM f)) := by induction l₁ <;> simp [*] - -/-! ### forM -/ - --- We use `List.forM` as the simp normal form, rather that `ForM.forM`. --- As such we need to replace `List.forM_nil` and `List.forM_cons` from Lean: - -@[simp] theorem forM_nil' [Monad m] : ([] : List α).forM f = (pure .unit : m PUnit) := rfl - -@[simp] theorem forM_cons' [Monad m] : - (a::as).forM f = (f a >>= fun _ => as.forM f : m PUnit) := - List.forM_cons _ _ _ - -/-! ### eraseIdx -/ - -@[simp] theorem eraseIdx_nil : ([] : List α).eraseIdx i = [] := rfl -@[simp] theorem eraseIdx_cons_zero : (a::as).eraseIdx 0 = as := rfl -@[simp] theorem eraseIdx_cons_succ : (a::as).eraseIdx (i+1) = a :: as.eraseIdx i := rfl - -/-! ### find? -/ - -@[simp] theorem find?_nil : ([] : List α).find? p = none := rfl -theorem find?_cons : (a::as).find? p = match p a with | true => some a | false => as.find? p := - rfl - -/-! ### filter -/ - -@[simp] theorem filter_nil (p : α → Bool) : filter p [] = [] := rfl - -@[simp] theorem filter_cons_of_pos {p : α → Bool} {a : α} (l) (pa : p a) : - filter p (a :: l) = a :: filter p l := by rw [filter, pa] - -@[simp] theorem filter_cons_of_neg {p : α → Bool} {a : α} (l) (pa : ¬ p a) : - filter p (a :: l) = filter p l := by rw [filter, eq_false_of_ne_true pa] - -theorem filter_cons : - (x :: xs : List α).filter p = if p x then x :: (xs.filter p) else xs.filter p := by - split <;> simp [*] - -theorem mem_filter : x ∈ filter p as ↔ x ∈ as ∧ p x := by - induction as with - | nil => simp [filter] - | cons a as ih => - by_cases h : p a <;> simp [*, or_and_right] - · exact or_congr_left (and_iff_left_of_imp fun | rfl => h).symm - · exact (or_iff_right fun ⟨rfl, h'⟩ => h h').symm - -theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a ∈ l, ¬p a := by +theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a, a ∈ l → ¬p a := by simp only [eq_nil_iff_forall_not_mem, mem_filter, not_and] -/-! ### findSome? -/ - -@[simp] theorem findSome?_nil : ([] : List α).findSome? f = none := rfl -theorem findSome?_cons {f : α → Option β} : - (a::as).findSome? f = match f a with | some b => some b | none => as.findSome? f := - rfl - -/-! ### replace -/ - -@[simp] theorem replace_nil [BEq α] : ([] : List α).replace a b = [] := rfl -theorem replace_cons [BEq α] {a : α} : - (a::as).replace b c = match a == b with | true => c::as | false => a :: replace as b c := - rfl -@[simp] theorem replace_cons_self [BEq α] [LawfulBEq α] {a : α} : (a::as).replace a b = b::as := by - simp [replace_cons] - -/-! ### elem -/ - -@[simp] theorem elem_nil [BEq α] : ([] : List α).elem a = false := rfl -theorem elem_cons [BEq α] {a : α} : - (a::as).elem b = match b == a with | true => true | false => as.elem b := - rfl -@[simp] theorem elem_cons_self [BEq α] [LawfulBEq α] {a : α} : (a::as).elem a = true := by - simp [elem_cons] - -/-! ### lookup -/ - -@[simp] theorem lookup_nil [BEq α] : ([] : List (α × β)).lookup a = none := rfl -theorem lookup_cons [BEq α] {k : α} : - ((k,b)::es).lookup a = match a == k with | true => some b | false => es.lookup a := - rfl -@[simp] theorem lookup_cons_self [BEq α] [LawfulBEq α] {k : α} : ((k,b)::es).lookup k = some b := by - simp [lookup_cons] - -/-! ### zipWith -/ - -@[simp] theorem zipWith_nil_left {f : α → β → γ} : zipWith f [] l = [] := by - rfl - -@[simp] theorem zipWith_nil_right {f : α → β → γ} : zipWith f l [] = [] := by - simp [zipWith] - -@[simp] theorem zipWith_cons_cons {f : α → β → γ} : - zipWith f (a :: as) (b :: bs) = f a b :: zipWith f as bs := by - rfl - -theorem zipWith_get? {f : α → β → γ} : - (List.zipWith f as bs).get? i = match as.get? i, bs.get? i with - | some a, some b => some (f a b) | _, _ => none := by - induction as generalizing bs i with - | nil => cases bs with - | nil => simp - | cons b bs => simp - | cons a as aih => cases bs with - | nil => simp - | cons b bs => cases i <;> simp_all - -/-! ### zipWithAll -/ - -theorem zipWithAll_get? {f : Option α → Option β → γ} : - (zipWithAll f as bs).get? i = match as.get? i, bs.get? i with - | none, none => .none | a?, b? => some (f a? b?) := by - induction as generalizing bs i with - | nil => induction bs generalizing i with - | nil => simp - | cons b bs bih => cases i <;> simp_all - | cons a as aih => cases bs with - | nil => - specialize @aih [] - cases i <;> simp_all - | cons b bs => cases i <;> simp_all - -/-! ### zip -/ - -@[simp] theorem zip_nil_left : zip ([] : List α) (l : List β) = [] := by - rfl - -@[simp] theorem zip_nil_right : zip (l : List α) ([] : List β) = [] := by - simp [zip] - -@[simp] theorem zip_cons_cons : zip (a :: as) (b :: bs) = (a, b) :: zip as bs := by - rfl - -/-! ### unzip -/ - -@[simp] theorem unzip_nil : ([] : List (α × β)).unzip = ([], []) := rfl -@[simp] theorem unzip_cons {h : α × β} : - (h :: t).unzip = match unzip t with | (al, bl) => (h.1::al, h.2::bl) := rfl - -/-! ### all / any -/ - -@[simp] theorem all_eq_true {l : List α} : l.all p ↔ ∀ x ∈ l, p x := by induction l <;> simp [*] - -@[simp] theorem any_eq_true {l : List α} : l.any p ↔ ∃ x ∈ l, p x := by induction l <;> simp [*] - -/-! ### enumFrom -/ - -@[simp] theorem enumFrom_nil : ([] : List α).enumFrom i = [] := rfl -@[simp] theorem enumFrom_cons : (a::as).enumFrom i = (i, a) :: as.enumFrom (i+1) := rfl - -/-! ### iota -/ - -@[simp] theorem iota_zero : iota 0 = [] := rfl -@[simp] theorem iota_succ : iota (i+1) = (i+1) :: iota i := rfl - -/-! ### intersperse -/ - -@[simp] theorem intersperse_nil (sep : α) : ([] : List α).intersperse sep = [] := rfl -@[simp] theorem intersperse_single (sep : α) : [x].intersperse sep = [x] := rfl -@[simp] theorem intersperse_cons₂ (sep : α) : - (x::y::zs).intersperse sep = x::sep::((y::zs).intersperse sep) := rfl - -/-! ### isPrefixOf -/ - -@[simp] theorem isPrefixOf_nil_left [BEq α] : isPrefixOf ([] : List α) l = true := by - simp [isPrefixOf] -@[simp] theorem isPrefixOf_cons_nil [BEq α] : isPrefixOf (a::as) ([] : List α) = false := rfl -theorem isPrefixOf_cons₂ [BEq α] {a : α} : - isPrefixOf (a::as) (b::bs) = (a == b && isPrefixOf as bs) := rfl -@[simp] theorem isPrefixOf_cons₂_self [BEq α] [LawfulBEq α] {a : α} : - isPrefixOf (a::as) (a::bs) = isPrefixOf as bs := by simp [isPrefixOf_cons₂] - -/-! ### isEqv -/ - -@[simp] theorem isEqv_nil_nil : isEqv ([] : List α) [] eqv = true := rfl -@[simp] theorem isEqv_nil_cons : isEqv ([] : List α) (a::as) eqv = false := rfl -@[simp] theorem isEqv_cons_nil : isEqv (a::as : List α) [] eqv = false := rfl -theorem isEqv_cons₂ : isEqv (a::as) (b::bs) eqv = (eqv a b && isEqv as bs eqv) := rfl - -/-! ### dropLast -/ - -@[simp] theorem dropLast_nil : ([] : List α).dropLast = [] := rfl -@[simp] theorem dropLast_single : [x].dropLast = [] := rfl -@[simp] theorem dropLast_cons₂ : - (x::y::zs).dropLast = x :: (y::zs).dropLast := rfl - --- We may want to replace these `simp` attributes with explicit equational lemmas, --- as we already have for all the non-monadic functions. -attribute [simp] mapA forA filterAuxM firstM anyM allM findM? findSomeM? - --- Previously `range.loop`, `mapM.loop`, `filterMapM.loop`, `forIn.loop`, `forIn'.loop` --- had attribute `@[simp]`. --- We don't currently provide simp lemmas, --- as this is an internal implementation and they don't seem to be needed. - -/-! ### minimum? -/ - -@[simp] theorem minimum?_nil [Min α] : ([] : List α).minimum? = none := rfl - --- We don't put `@[simp]` on `minimum?_cons`, --- because the definition in terms of `foldl` is not useful for proofs. -theorem minimum?_cons [Min α] {xs : List α} : (x :: xs).minimum? = foldl min x xs := rfl - -@[simp] theorem minimum?_eq_none_iff {xs : List α} [Min α] : xs.minimum? = none ↔ xs = [] := by - cases xs <;> simp [minimum?] - -theorem minimum?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b) : - {xs : List α} → xs.minimum? = some a → a ∈ xs := by - intro xs - match xs with - | nil => simp - | x :: xs => - simp only [minimum?_cons, Option.some.injEq, List.mem_cons] - intro eq - induction xs generalizing x with - | nil => - simp at eq - simp [eq] - | cons y xs ind => - simp at eq - have p := ind _ eq - cases p with - | inl p => - cases min_eq_or x y with | _ q => simp [p, q] - | inr p => simp [p, mem_cons] - -theorem le_minimum?_iff [Min α] [LE α] - (le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) : - {xs : List α} → xs.minimum? = some a → ∀ x, x ≤ a ↔ ∀ b ∈ xs, x ≤ b - | nil => by simp - | cons x xs => by - rw [minimum?] - intro eq y - simp only [Option.some.injEq] at eq - induction xs generalizing x with - | nil => - simp at eq - simp [eq] - | cons z xs ih => - simp at eq - simp [ih _ eq, le_min_iff, and_assoc] - --- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `min_eq_or`, --- and `le_min_iff`. -theorem minimum?_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 α} : - xs.minimum? = some a ↔ a ∈ xs ∧ ∀ b ∈ xs, a ≤ b := by - refine ⟨fun h => ⟨minimum?_mem min_eq_or h, (le_minimum?_iff le_min_iff h _).1 (le_refl _)⟩, ?_⟩ - intro ⟨h₁, h₂⟩ - cases xs with - | nil => simp at h₁ - | cons x xs => - exact congrArg some <| anti.1 - ((le_minimum?_iff le_min_iff (xs := x::xs) rfl _).1 (le_refl _) _ h₁) - (h₂ _ (minimum?_mem min_eq_or (xs := x::xs) rfl)) - -- A specialization of `minimum?_eq_some_iff` to Nat. theorem minimum?_eq_some_iff' {xs : List Nat} : xs.minimum? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, a ≤ b) := diff --git a/Std/Data/Nat/Gcd.lean b/Std/Data/Nat/Gcd.lean index a2a91694e1..27842c51ad 100644 --- a/Std/Data/Nat/Gcd.lean +++ b/Std/Data/Nat/Gcd.lean @@ -3,7 +3,6 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro -/ -import Std.Data.Nat.Init.Gcd import Std.Data.Nat.Lemmas /-! diff --git a/Std/Data/Nat/Init/Dvd.lean b/Std/Data/Nat/Init/Dvd.lean deleted file mode 100644 index 0950a6541c..0000000000 --- a/Std/Data/Nat/Init/Dvd.lean +++ /dev/null @@ -1,95 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro --/ -import Std.Data.Nat.Init.Basic -import Std.Data.Nat.Init.Lemmas - -namespace Nat - -protected theorem dvd_refl (a : Nat) : a ∣ a := ⟨1, by simp⟩ - -protected theorem dvd_zero (a : Nat) : a ∣ 0 := ⟨0, by simp⟩ - -protected theorem dvd_mul_left (a b : Nat) : a ∣ b * a := ⟨b, Nat.mul_comm b a⟩ - -protected theorem dvd_mul_right (a b : Nat) : a ∣ a * b := ⟨b, rfl⟩ - -protected theorem dvd_trans {a b c : Nat} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c := - match h₁, h₂ with - | ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ => - ⟨d * e, show c = a * (d * e) by simp[h₃,h₄, Nat.mul_assoc]⟩ - -protected theorem eq_zero_of_zero_dvd {a : Nat} (h : 0 ∣ a) : a = 0 := - let ⟨c, H'⟩ := h; H'.trans c.zero_mul - -@[simp] protected theorem zero_dvd {n : Nat} : 0 ∣ n ↔ n = 0 := - ⟨Nat.eq_zero_of_zero_dvd, fun h => h.symm ▸ Nat.dvd_zero 0⟩ - -protected theorem dvd_add {a b c : Nat} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := - let ⟨d, hd⟩ := h₁; let ⟨e, he⟩ := h₂; ⟨d + e, by simp [Nat.left_distrib, hd, he]⟩ - -protected theorem dvd_add_iff_right {k m n : Nat} (h : k ∣ m) : k ∣ n ↔ k ∣ m + n := - ⟨Nat.dvd_add h, - match m, h with - | _, ⟨d, rfl⟩ => fun ⟨e, he⟩ => - ⟨e - d, by rw [Nat.mul_sub_left_distrib, ← he, Nat.add_sub_cancel_left]⟩⟩ - -protected theorem dvd_add_iff_left {k m n : Nat} (h : k ∣ n) : k ∣ m ↔ k ∣ m + n := by - rw [Nat.add_comm]; exact Nat.dvd_add_iff_right h - -theorem dvd_mod_iff {k m n : Nat} (h: k ∣ n) : k ∣ m % n ↔ k ∣ m := - have := Nat.dvd_add_iff_left <| Nat.dvd_trans h <| Nat.dvd_mul_right n (m / n) - by rwa [mod_add_div] at this - -theorem le_of_dvd {m n : Nat} (h : 0 < n) : m ∣ n → m ≤ n - | ⟨k, e⟩ => by - revert h - rw [e] - match k with - | 0 => intro hn; simp at hn - | pk+1 => - intro - have := Nat.mul_le_mul_left m (succ_pos pk) - rwa [Nat.mul_one] at this - -protected theorem dvd_antisymm : ∀ {m n : Nat}, m ∣ n → n ∣ m → m = n - | _, 0, _, h₂ => Nat.eq_zero_of_zero_dvd h₂ - | 0, _, h₁, _ => (Nat.eq_zero_of_zero_dvd h₁).symm - | _+1, _+1, h₁, h₂ => Nat.le_antisymm (le_of_dvd (succ_pos _) h₁) (le_of_dvd (succ_pos _) h₂) - -theorem pos_of_dvd_of_pos {m n : Nat} (H1 : m ∣ n) (H2 : 0 < n) : 0 < m := - Nat.pos_of_ne_zero fun m0 => Nat.ne_of_gt H2 <| Nat.eq_zero_of_zero_dvd (m0 ▸ H1) - -@[simp] protected theorem one_dvd (n : Nat) : 1 ∣ n := ⟨n, n.one_mul.symm⟩ - -theorem eq_one_of_dvd_one {n : Nat} (H : n ∣ 1) : n = 1 := Nat.dvd_antisymm H n.one_dvd - -theorem mod_eq_zero_of_dvd {m n : Nat} (H : m ∣ n) : n % m = 0 := by - let ⟨z, H⟩ := H; rw [H, mul_mod_right] - -theorem dvd_of_mod_eq_zero {m n : Nat} (H : n % m = 0) : m ∣ n := by - exists n / m - have := (mod_add_div n m).symm - rwa [H, Nat.zero_add] at this - -theorem dvd_iff_mod_eq_zero (m n : Nat) : m ∣ n ↔ n % m = 0 := - ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ - -instance decidable_dvd : @DecidableRel Nat (·∣·) := - fun _ _ => decidable_of_decidable_of_iff (dvd_iff_mod_eq_zero _ _).symm - -theorem emod_pos_of_not_dvd {a b : Nat} (h : ¬ a ∣ b) : 0 < b % a := by - rw [dvd_iff_mod_eq_zero] at h - exact Nat.pos_of_ne_zero h - - -protected theorem mul_div_cancel' {n m : Nat} (H : n ∣ m) : n * (m / n) = m := by - have := mod_add_div m n - rwa [mod_eq_zero_of_dvd H, Nat.zero_add] at this - -protected theorem div_mul_cancel {n m : Nat} (H : n ∣ m) : m / n * n = m := by - rw [Nat.mul_comm, Nat.mul_div_cancel' H] - -end Nat diff --git a/Std/Data/Nat/Init/Gcd.lean b/Std/Data/Nat/Init/Gcd.lean deleted file mode 100644 index a43d5cf293..0000000000 --- a/Std/Data/Nat/Init/Gcd.lean +++ /dev/null @@ -1,42 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro --/ -import Std.Data.Nat.Init.Basic -import Std.Data.Nat.Init.Dvd - -namespace Nat - -theorem gcd_rec (m n : Nat) : gcd m n = gcd (n % m) m := - match m with - | 0 => by have := (mod_zero n).symm; rwa [gcd_zero_right] - | _ + 1 => by simp [gcd_succ] - -@[elab_as_elim] theorem gcd.induction {P : Nat → Nat → Prop} (m n : Nat) - (H0 : ∀n, P 0 n) (H1 : ∀ m n, 0 < m → P (n % m) m → P m n) : P m n := - Nat.strongInductionOn (motive := fun m => ∀ n, P m n) m - (fun - | 0, _ => H0 - | _+1, IH => fun _ => H1 _ _ (succ_pos _) (IH _ (mod_lt _ (succ_pos _)) _) ) - n - -theorem gcd_dvd (m n : Nat) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) := by - induction m, n using gcd.induction with - | H0 n => rw [gcd_zero_left]; exact ⟨Nat.dvd_zero n, Nat.dvd_refl n⟩ - | H1 m n _ IH => rw [← gcd_rec] at IH; exact ⟨IH.2, (dvd_mod_iff IH.2).1 IH.1⟩ - -theorem gcd_dvd_left (m n : Nat) : gcd m n ∣ m := (gcd_dvd m n).left - -theorem gcd_dvd_right (m n : Nat) : gcd m n ∣ n := (gcd_dvd m n).right - -theorem gcd_le_left (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h <| gcd_dvd_left m n - -theorem gcd_le_right (n) (h : 0 < n) : gcd m n ≤ n := le_of_dvd h <| gcd_dvd_right m n - -theorem dvd_gcd : k ∣ m → k ∣ n → k ∣ gcd m n := by - induction m, n using gcd.induction with intro km kn - | H0 n => rw [gcd_zero_left]; exact kn - | H1 n m _ IH => rw [gcd_rec]; exact IH ((dvd_mod_iff km).2 kn) km - -end Nat diff --git a/Std/Tactic/PermuteGoals.lean b/Std/Tactic/PermuteGoals.lean index e085e8b944..8f267c50f4 100644 --- a/Std/Tactic/PermuteGoals.lean +++ b/Std/Tactic/PermuteGoals.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Mario Carneiro -/ import Std.Data.List.Basic +import Lean.Elab.Tactic.Basic /-! # The `on_goal`, `pick_goal`, and `swap` tactics. From 0c24611b514597e67d5d08f92c08b6b1a7cb0152 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 15 Feb 2024 19:25:04 +1100 Subject: [PATCH 046/213] rename --- Std/Classes/SatisfiesM.lean | 168 ++++++++++++++++++++++++++++++++++++ 1 file changed, 168 insertions(+) create mode 100644 Std/Classes/SatisfiesM.lean diff --git a/Std/Classes/SatisfiesM.lean b/Std/Classes/SatisfiesM.lean new file mode 100644 index 0000000000..0b596789ed --- /dev/null +++ b/Std/Classes/SatisfiesM.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2022 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ + +/-! +## SatisfiesM + +The `SatisfiesM` predicate works over an arbitrary (lawful) monad / applicative / functor, +and enables Hoare-like reasoning over monadic expressions. For example, given a monadic +function `f : α → m β`, to say that the return value of `f` satisfies `Q` whenever +the input satisfies `P`, we write `∀ a, P a → SatisfiesM Q (f a)`. +-/ + +/-- +`SatisfiesM p (x : m α)` lifts propositions over a monad. It asserts that `x` may as well +have the type `x : m {a // p a}`, because there exists some `m {a // p a}` whose image is `x`. +So `p` is the postcondition of the monadic value. +-/ +def SatisfiesM {m : Type u → Type v} [Functor m] (p : α → Prop) (x : m α) : Prop := + ∃ x' : m {a // p a}, Subtype.val <$> x' = x + +namespace SatisfiesM + +/-- If `p` is always true, then every `x` satisfies it. -/ +theorem of_true [Applicative m] [LawfulApplicative m] {x : m α} + (h : ∀ a, p a) : SatisfiesM p x := + ⟨(fun a => ⟨a, h a⟩) <$> x, by simp [← comp_map, Function.comp_def]⟩ + +/-- +If `p` is always true, then every `x` satisfies it. +(This is the strongest postcondition version of `of_true`.) +-/ +protected theorem trivial [Applicative m] [LawfulApplicative m] {x : m α} : + SatisfiesM (fun _ => True) x := of_true fun _ => trivial + +/-- The `SatisfiesM p x` predicate is monotonic in `p`. -/ +theorem imp [Functor m] [LawfulFunctor m] {x : m α} + (h : SatisfiesM p x) (H : ∀ {a}, p a → q a) : SatisfiesM q x := + let ⟨x, h⟩ := h; ⟨(fun ⟨a, h⟩ => ⟨_, H h⟩) <$> x, by rw [← h, ← comp_map]; rfl⟩ + +/-- `SatisfiesM` distributes over `<$>`, general version. -/ +protected theorem map [Functor m] [LawfulFunctor m] {x : m α} + (hx : SatisfiesM p x) (hf : ∀ {a}, p a → q (f a)) : SatisfiesM q (f <$> x) := by + let ⟨x', hx⟩ := hx + refine ⟨(fun ⟨a, h⟩ => ⟨f a, hf h⟩) <$> x', ?_⟩ + rw [← hx]; simp [← comp_map, Function.comp_def] + +/-- +`SatisfiesM` distributes over `<$>`, strongest postcondition version. +(Use this for reasoning forward from assumptions.) +-/ +theorem map_post [Functor m] [LawfulFunctor m] {x : m α} + (hx : SatisfiesM p x) : SatisfiesM (fun b => ∃ a, p a ∧ b = f a) (f <$> x) := + hx.map fun h => ⟨_, h, rfl⟩ + +/-- +`SatisfiesM` distributes over `<$>`, weakest precondition version. +(Use this for reasoning backward from the goal.) +-/ +theorem map_pre [Functor m] [LawfulFunctor m] {x : m α} + (hx : SatisfiesM (fun a => p (f a)) x) : SatisfiesM p (f <$> x) := + hx.map fun h => h + +/-- `SatisfiesM` distributes over `mapConst`, general version. -/ +protected theorem mapConst [Functor m] [LawfulFunctor m] {x : m α} + (hx : SatisfiesM q x) (ha : ∀ {b}, q b → p a) : SatisfiesM p (Functor.mapConst a x) := + map_const (f := m) ▸ hx.map ha + +/-- `SatisfiesM` distributes over `pure`, general version / weakest precondition version. -/ +protected theorem pure [Applicative m] [LawfulApplicative m] + (h : p a) : SatisfiesM (m := m) p (pure a) := ⟨pure ⟨_, h⟩, by simp⟩ + +/-- `SatisfiesM` distributes over `<*>`, general version. -/ +protected theorem seq [Applicative m] [LawfulApplicative m] {x : m α} + (hf : SatisfiesM p₁ f) (hx : SatisfiesM p₂ x) + (H : ∀ {f a}, p₁ f → p₂ a → q (f a)) : SatisfiesM q (f <*> x) := by + match f, x, hf, hx with | _, _, ⟨f, rfl⟩, ⟨x, rfl⟩ => ?_ + refine ⟨(fun ⟨a, h₁⟩ ⟨b, h₂⟩ => ⟨a b, H h₁ h₂⟩) <$> f <*> x, ?_⟩ + simp only [← pure_seq]; simp [SatisfiesM, seq_assoc] + simp only [← pure_seq]; simp [seq_assoc, Function.comp_def] + +/-- `SatisfiesM` distributes over `<*>`, strongest postcondition version. -/ +protected theorem seq_post [Applicative m] [LawfulApplicative m] {x : m α} + (hf : SatisfiesM p₁ f) (hx : SatisfiesM p₂ x) : + SatisfiesM (fun c => ∃ f a, p₁ f ∧ p₂ a ∧ c = f a) (f <*> x) := + hf.seq hx fun hf ha => ⟨_, _, hf, ha, rfl⟩ + +/-- +`SatisfiesM` distributes over `<*>`, weakest precondition version 1. +(Use this when `x` and the goal are known and `f` is a subgoal.) +-/ +protected theorem seq_pre [Applicative m] [LawfulApplicative m] {x : m α} + (hf : SatisfiesM (fun f => ∀ {a}, p₂ a → q (f a)) f) (hx : SatisfiesM p₂ x) : + SatisfiesM q (f <*> x) := + hf.seq hx fun hf ha => hf ha + +/-- +`SatisfiesM` distributes over `<*>`, weakest precondition version 2. +(Use this when `f` and the goal are known and `x` is a subgoal.) +-/ +protected theorem seq_pre' [Applicative m] [LawfulApplicative m] {x : m α} + (hf : SatisfiesM p₁ f) (hx : SatisfiesM (fun a => ∀ {f}, p₁ f → q (f a)) x) : + SatisfiesM q (f <*> x) := + hf.seq hx fun hf ha => ha hf + +/-- `SatisfiesM` distributes over `<*`, general version. -/ +protected theorem seqLeft [Applicative m] [LawfulApplicative m] {x : m α} + (hx : SatisfiesM p₁ x) (hy : SatisfiesM p₂ y) + (H : ∀ {a b}, p₁ a → p₂ b → q a) : SatisfiesM q (x <* y) := + seqLeft_eq x y ▸ (hx.map fun h _ => H h).seq_pre hy + +/-- `SatisfiesM` distributes over `*>`, general version. -/ +protected theorem seqRight [Applicative m] [LawfulApplicative m] {x : m α} + (hx : SatisfiesM p₁ x) (hy : SatisfiesM p₂ y) + (H : ∀ {a b}, p₁ a → p₂ b → q b) : SatisfiesM q (x *> y) := + seqRight_eq x y ▸ (hx.map fun h _ => H h).seq_pre hy + +/-- `SatisfiesM` distributes over `>>=`, general version. -/ +protected theorem bind [Monad m] [LawfulMonad m] {f : α → m β} + (hx : SatisfiesM p x) (hf : ∀ a, p a → SatisfiesM q (f a)) : + SatisfiesM q (x >>= f) := by + match x, hx with | _, ⟨x, rfl⟩ => ?_ + have g a ha := Classical.indefiniteDescription _ (hf a ha) + refine ⟨x >>= fun ⟨a, h⟩ => g a h, ?_⟩ + simp [← bind_pure_comp]; congr; funext ⟨a, h⟩; simp [← (g a h).2, ← bind_pure_comp] + +/-- `SatisfiesM` distributes over `>>=`, weakest precondition version. -/ +protected theorem bind_pre [Monad m] [LawfulMonad m] {f : α → m β} + (hx : SatisfiesM (fun a => SatisfiesM q (f a)) x) : + SatisfiesM q (x >>= f) := hx.bind fun _ h => h + +end SatisfiesM + +@[simp] theorem SatisfiesM_Id_eq : SatisfiesM (m := Id) p x ↔ p x := + ⟨fun ⟨y, eq⟩ => eq ▸ y.2, fun h => ⟨⟨_, h⟩, rfl⟩⟩ + +@[simp] theorem SatisfiesM_Option_eq : SatisfiesM (m := Option) p x ↔ ∀ a, x = some a → p a := + ⟨by revert x; intro | some _, ⟨some ⟨_, h⟩, rfl⟩, _, rfl => exact h, + fun h => match x with | some a => ⟨some ⟨a, h _ rfl⟩, rfl⟩ | none => ⟨none, rfl⟩⟩ + +@[simp] theorem SatisfiesM_Except_eq : SatisfiesM (m := Except ε) p x ↔ ∀ a, x = .ok a → p a := + ⟨by revert x; intro | .ok _, ⟨.ok ⟨_, h⟩, rfl⟩, _, rfl => exact h, + fun h => match x with | .ok a => ⟨.ok ⟨a, h _ rfl⟩, rfl⟩ | .error e => ⟨.error e, rfl⟩⟩ + +@[simp] theorem SatisfiesM_ReaderT_eq [Monad m] : + SatisfiesM (m := ReaderT ρ m) p x ↔ ∀ s, SatisfiesM p (x s) := + (exists_congr fun a => by exact ⟨fun eq _ => eq ▸ rfl, funext⟩).trans Classical.skolem.symm + +theorem SatisfiesM_StateRefT_eq [Monad m] : + SatisfiesM (m := StateRefT' ω σ m) p x ↔ ∀ s, SatisfiesM p (x s) := by simp + +@[simp] theorem SatisfiesM_StateT_eq [Monad m] [LawfulMonad m] : + SatisfiesM (m := StateT ρ m) (α := α) p x ↔ ∀ s, SatisfiesM (m := m) (p ·.1) (x s) := by + refine .trans ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, h⟩ => ?_⟩ Classical.skolem.symm + · refine ⟨fun s => (fun ⟨⟨a, h⟩, s'⟩ => ⟨⟨a, s'⟩, h⟩) <$> f s, fun s => ?_⟩ + rw [← comp_map, map_eq_pure_bind]; rfl + · refine ⟨fun s => (fun ⟨⟨a, s'⟩, h⟩ => ⟨⟨a, h⟩, s'⟩) <$> f s, funext fun s => ?_⟩ + show _ >>= _ = _; simp [map_eq_pure_bind, ← h] + +@[simp] theorem SatisfiesM_ExceptT_eq [Monad m] [LawfulMonad m] : + SatisfiesM (m := ExceptT ρ m) (α := α) p x ↔ SatisfiesM (m := m) (∀ a, · = .ok a → p a) x := by + refine ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, eq⟩ => eq ▸ ?_⟩ + · exists (fun | .ok ⟨a, h⟩ => ⟨.ok a, fun | _, rfl => h⟩ | .error e => ⟨.error e, nofun⟩) <$> f + show _ = _ >>= _; rw [← comp_map, map_eq_pure_bind]; congr; funext a; cases a <;> rfl + · exists ((fun | ⟨.ok a, h⟩ => .ok ⟨a, h _ rfl⟩ | ⟨.error e, _⟩ => .error e) <$> f : m _) + show _ >>= _ = _; simp [← comp_map, map_eq_pure_bind]; congr; funext ⟨a, h⟩; cases a <;> rfl From 20175e89ebab78ab9bc89803105cc52455179892 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 15 Feb 2024 19:30:31 +1100 Subject: [PATCH 047/213] cleanup --- Std/Data/Array/Match.lean | 1 - Std/Data/List/Init/Lemmas.lean | 1 - Std/Data/Option/Basic.lean | 1 - Std/Lean/HashSet.lean | 1 - 4 files changed, 4 deletions(-) diff --git a/Std/Data/Array/Match.lean b/Std/Data/Array/Match.lean index 5a2962d44a..282846f956 100644 --- a/Std/Data/Array/Match.lean +++ b/Std/Data/Array/Match.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: F. G. Dorais -/ import Std.Data.Nat.Lemmas -import Std.Data.Array.Init.Lemmas namespace Array diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean index 9970fa69c9..76a8f1328b 100644 --- a/Std/Data/List/Init/Lemmas.lean +++ b/Std/Data/List/Init/Lemmas.lean @@ -3,7 +3,6 @@ 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 -/ -import Std.Classes.SetNotation namespace List diff --git a/Std/Data/Option/Basic.lean b/Std/Data/Option/Basic.lean index 644e2bcd61..131a4ada36 100644 --- a/Std/Data/Option/Basic.lean +++ b/Std/Data/Option/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Classes.SetNotation namespace Option diff --git a/Std/Lean/HashSet.lean b/Std/Lean/HashSet.lean index dd71cd3cfc..272ea4dab0 100644 --- a/Std/Lean/HashSet.lean +++ b/Std/Lean/HashSet.lean @@ -5,7 +5,6 @@ Authors: Jannis Limperg -/ import Lean.Data.HashSet -import Std.Classes.SetNotation namespace Lean.HashSet From 871926d6327e1cb6585fbb1ff476efbeaaab822e Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 15 Feb 2024 19:31:39 +1100 Subject: [PATCH 048/213] fix --- Std/Tactic/Omega/OmegaM.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Std/Tactic/Omega/OmegaM.lean b/Std/Tactic/Omega/OmegaM.lean index 0be6dc0383..d4f20ec405 100644 --- a/Std/Tactic/Omega/OmegaM.lean +++ b/Std/Tactic/Omega/OmegaM.lean @@ -8,6 +8,7 @@ import Std.Tactic.Omega.LinearCombo import Std.Tactic.Omega.Config import Std.Lean.Expr import Std.Lean.HashSet +import Std.Classes.SetNotation /-! # The `OmegaM` state monad. From 1649581b46b966fc3d5fed9c8f17f2ff7f371739 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 15 Feb 2024 20:32:59 +1100 Subject: [PATCH 049/213] rm run_cmd --- Std.lean | 4 +- Std/Data/Nat.lean | 2 + Std/Tactic/RunCmd.lean | 83 ------------------------------------------ test/run_cmd.lean | 1 - 4 files changed, 4 insertions(+), 86 deletions(-) delete mode 100644 Std/Tactic/RunCmd.lean diff --git a/Std.lean b/Std.lean index 3224309dc8..95623d568c 100644 --- a/Std.lean +++ b/Std.lean @@ -1,8 +1,8 @@ import Std.Classes.BEq import Std.Classes.Cast -import Std.Classes.SatisfiesM import Std.Classes.Order import Std.Classes.RatCast +import Std.Classes.SatisfiesM import Std.Classes.SetNotation import Std.CodeAction import Std.CodeAction.Attr @@ -120,7 +120,6 @@ import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix import Std.Tactic.Relation.Rfl import Std.Tactic.Relation.Symm -import Std.Tactic.RunCmd import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm import Std.Tactic.SimpTrace @@ -133,6 +132,7 @@ import Std.Tactic.Where import Std.Test.Internal.DummyLabelAttr import Std.Util.Cache import Std.Util.CheckTactic +import Std.Util.ExtendedBinder import Std.Util.LibraryNote import Std.Util.Pickle import Std.Util.ProofWanted diff --git a/Std/Data/Nat.lean b/Std/Data/Nat.lean index e756fe2023..6fd2edd7ca 100644 --- a/Std/Data/Nat.lean +++ b/Std/Data/Nat.lean @@ -1,3 +1,5 @@ +import Std.Data.Nat.Basic import Std.Data.Nat.Bitwise import Std.Data.Nat.Gcd +import Std.Data.Nat.Init.Basic import Std.Data.Nat.Lemmas diff --git a/Std/Tactic/RunCmd.lean b/Std/Tactic/RunCmd.lean deleted file mode 100644 index edda178266..0000000000 --- a/Std/Tactic/RunCmd.lean +++ /dev/null @@ -1,83 +0,0 @@ -/- -Copyright (c) 2018 Sebastian Ullrich. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sebastian Ullrich, Mario Carneiro --/ -import Lean.Elab.Eval -import Lean.Elab.Command -import Std.Tactic.Lint - -/-! -Defines commands to compile and execute a command / term / tactic on the spot: - -* `run_cmd doSeq` command which executes code in `CommandElabM Unit`. - This is almost the same as `#eval show CommandElabM Unit from do doSeq`, - except that it doesn't print an empty diagnostic. - -* `run_tac doSeq` tactic which executes code in `TacticM Unit`. - -* `by_elab doSeq` term which executes code in `TermElabM Expr` to produce an expression. --/ - -namespace Std.Tactic.RunCmd -open Lean Meta Elab Command Term Tactic - -/-- -The `run_cmd doSeq` command executes code in `CommandElabM Unit`. -This is almost the same as `#eval show CommandElabM Unit from do doSeq`, -except that it doesn't print an empty diagnostic. --/ -elab (name := runCmd) "run_cmd " elems:doSeq : command => do - ← liftTermElabM <| - unsafe evalTerm (CommandElabM Unit) - (mkApp (mkConst ``CommandElabM) (mkConst ``Unit)) - (← `(discard do $elems)) - -/-- -The `run_elab doSeq` command executes code in `TermElabM Unit`. -This is almost the same as `#eval show TermElabM Unit from do doSeq`, -except that it doesn't print an empty diagnostic. --/ -elab (name := runElab) "run_elab " elems:doSeq : command => do - ← liftTermElabM <| - unsafe evalTerm (CommandElabM Unit) - (mkApp (mkConst ``CommandElabM) (mkConst ``Unit)) - (← `(Command.liftTermElabM <| discard do $elems)) - -/-- -The `run_meta doSeq` command executes code in `MetaM Unit`. -This is almost the same as `#eval show MetaM Unit from do doSeq`, -except that it doesn't print an empty diagnostic. - -(This is effectively a synonym for `run_elab`.) --/ -macro (name := runMeta) "run_meta " elems:doSeq : command => - `(command| run_elab (show MetaM Unit from do $elems)) - -/-- The `run_tac doSeq` tactic executes code in `TacticM Unit`. -/ -elab (name := runTac) "run_tac " e:doSeq : tactic => do - ← unsafe evalTerm (TacticM Unit) (mkApp (mkConst ``TacticM) (mkConst ``Unit)) - (← `(discard do $e)) - -/-- -* The `by_elab doSeq` expression runs the `doSeq` as a `TermElabM Expr` to - synthesize the expression. -* `by_elab fun expectedType? => do doSeq` receives the expected type (an `Option Expr`) - as well. --/ -syntax (name := byElab) "by_elab " doSeq : term - -/-- Elaborator for `by_elab`. -/ -@[term_elab byElab, nolint unusedHavesSuffices] def elabRunElab : TermElab := fun -| `(by_elab $cmds:doSeq), expectedType? => do - if let `(Lean.Parser.Term.doSeq| $e:term) := cmds then - if e matches `(Lean.Parser.Term.doSeq| fun $[$_args]* => $_) then - let tac ← unsafe evalTerm - (Option Expr → TermElabM Expr) - (Lean.mkForall `x .default - (mkApp (mkConst ``Option) (mkConst ``Expr)) - (mkApp (mkConst ``TermElabM) (mkConst ``Expr))) e - return ← tac expectedType? - (← unsafe evalTerm (TermElabM Expr) (mkApp (mkConst ``TermElabM) (mkConst ``Expr)) - (← `(do $cmds))) -| _, _ => throwUnsupportedSyntax diff --git a/test/run_cmd.lean b/test/run_cmd.lean index eeefab07d7..acb2e24065 100644 --- a/test/run_cmd.lean +++ b/test/run_cmd.lean @@ -1,5 +1,4 @@ import Lean.Elab.Tactic.ElabTerm -import Std.Tactic.RunCmd import Std.Tactic.GuardMsgs open Lean Elab Tactic From a925ff65b2dc7c916a56067fcb11803cf8f084d7 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Thu, 15 Feb 2024 08:06:18 -0800 Subject: [PATCH 050/213] chore: adapt to lastest lean4 master --- Std.lean | 1 - Std/Data/ByteArray.lean | 1 - Std/Data/Char.lean | 1 - Std/Data/List/Init/Lemmas.lean | 3 - Std/Data/Option/Lemmas.lean | 1 - Std/Data/String/Lemmas.lean | 1 - Std/Data/UInt.lean | 1 - Std/Tactic/Congr.lean | 108 --------------- Std/Tactic/Ext.lean | 234 --------------------------------- Std/Tactic/Ext/Attr.lean | 109 --------------- 10 files changed, 460 deletions(-) delete mode 100644 Std/Tactic/Ext/Attr.lean diff --git a/Std.lean b/Std.lean index 95623d568c..b1143a30d3 100644 --- a/Std.lean +++ b/Std.lean @@ -85,7 +85,6 @@ import Std.Tactic.Classical import Std.Tactic.Congr import Std.Tactic.Exact import Std.Tactic.Ext -import Std.Tactic.Ext.Attr import Std.Tactic.FalseOrByContra import Std.Tactic.GuardMsgs import Std.Tactic.Init diff --git a/Std/Data/ByteArray.lean b/Std/Data/ByteArray.lean index 4652153d5c..1a6d6b5df2 100644 --- a/Std/Data/ByteArray.lean +++ b/Std/Data/ByteArray.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ import Std.Data.Array.Lemmas -import Std.Tactic.Ext.Attr namespace ByteArray diff --git a/Std/Data/Char.lean b/Std/Data/Char.lean index 2c3be7cd13..5ee22c51b4 100644 --- a/Std/Data/Char.lean +++ b/Std/Data/Char.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Std.Tactic.Ext.Attr @[ext] theorem Char.ext : {a b : Char} → a.val = b.val → a = b | ⟨_,_⟩, ⟨_,_⟩, rfl => rfl diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean index 76a8f1328b..e060dba28a 100644 --- a/Std/Data/List/Init/Lemmas.lean +++ b/Std/Data/List/Init/Lemmas.lean @@ -15,9 +15,6 @@ These are theorems used in the definitions of `Std.Data.List.Basic` and tactics. New theorems should be added to `Std.Data.List.Lemmas` if they are not needed by the bootstrap. -/ -theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a, a ∈ l → ¬p a := by - simp only [eq_nil_iff_forall_not_mem, mem_filter, not_and] - -- A specialization of `minimum?_eq_some_iff` to Nat. theorem minimum?_eq_some_iff' {xs : List Nat} : xs.minimum? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, a ≤ b) := diff --git a/Std/Data/Option/Lemmas.lean b/Std/Data/Option/Lemmas.lean index 5ef860bbb7..1bc51384b7 100644 --- a/Std/Data/Option/Lemmas.lean +++ b/Std/Data/Option/Lemmas.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Std.Data.Option.Init.Lemmas import Std.Data.Option.Basic -import Std.Tactic.Ext.Attr namespace Option diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 74c85883ad..013b21e084 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -7,7 +7,6 @@ import Std.Data.Char import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.String.Basic -import Std.Tactic.Ext.Attr import Std.Tactic.Lint.Misc import Std.Tactic.SeqFocus import Std.Tactic.Simpa diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index 9cf6bf6b2b..04929fa84e 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 François G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ -import Std.Tactic.Ext.Attr /-! ### UInt8 -/ diff --git a/Std/Tactic/Congr.lean b/Std/Tactic/Congr.lean index ebdaf0488d..e69de29bb2 100644 --- a/Std/Tactic/Congr.lean +++ b/Std/Tactic/Congr.lean @@ -1,108 +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, Miyahara Kō --/ -import Lean.Meta.Tactic.Congr -import Lean.Elab.Tactic.Config -import Std.Tactic.Ext - -/-! # `congr with` tactic, `rcongr` tactic -/ - -namespace Std.Tactic -open Lean Meta Elab Tactic Std.Tactic - -/-- Configuration options for `congr` & `rcongr` -/ -structure Congr.Config where - /-- If `closePre := true`, it will attempt to close new goals using `Eq.refl`, `HEq.refl`, and - `assumption` with reducible transparency. -/ - closePre : Bool := true - /-- If `closePost := true`, it will try again on goals on which `congr` failed to make progress - with default transparency. -/ - closePost : Bool := true - -/-- Function elaborating `Congr.Config` -/ -declare_config_elab Congr.elabConfig Congr.Config - -@[inherit_doc Lean.Parser.Tactic.congr] -syntax (name := congrConfig) "congr" Parser.Tactic.config (ppSpace num)? : tactic - -/-- -Apply congruence (recursively) to goals of the form `⊢ f as = f bs` and `⊢ HEq (f as) (f bs)`. -* `congr n` controls the depth of the recursive applications. - This is useful when `congr` is too aggressive in breaking down the goal. - For example, given `⊢ f (g (x + y)) = f (g (y + x))`, - `congr` produces the goals `⊢ x = y` and `⊢ y = x`, - while `congr 2` produces the intended `⊢ x + y = y + x`. -* If, at any point, a subgoal matches a hypothesis then the subgoal will be closed. -* You can use `congr with p (: n)?` to call `ext p (: n)?` to all subgoals generated by `congr`. - For example, if the goal is `⊢ f '' s = g '' s` then `congr with x` generates the goal - `x : α ⊢ f x = g x`. --/ -syntax (name := congrConfigWith) "congr" (Parser.Tactic.config)? (ppSpace colGt num)? - " with" (ppSpace colGt rintroPat)* (" : " num)? : tactic - -elab_rules : tactic - | `(tactic| congr $cfg:config $[$n?]?) => do - let config ← Congr.elabConfig (mkOptionalNode cfg) - let hugeDepth := 1000000 - let depth := n?.map (·.getNat) |>.getD hugeDepth - liftMetaTactic fun mvarId => - mvarId.congrN depth (closePre := config.closePre) (closePost := config.closePost) - -macro_rules - | `(tactic| congr $(cfg)? $(depth)? with $ps* $[: $n]?) => - match cfg with - | none => `(tactic| congr $(depth)? <;> ext $ps* $[: $n]?) - | some cfg => `(tactic| congr $cfg $(depth)? <;> ext $ps* $[: $n]?) - -/-- -Recursive core of `rcongr`. Calls `ext pats <;> congr` and then itself recursively, -unless `ext pats <;> congr` made no progress. --/ -partial def rcongrCore (g : MVarId) (config : Congr.Config) (pats : List (TSyntax `rcasesPat)) - (acc : Array MVarId) : TermElabM (Array MVarId) := do - let mut acc := acc - for (g, qs) in (← Ext.extCore g pats (failIfUnchanged := false)).2 do - let s ← saveState - let gs ← g.congrN 1000000 (closePre := config.closePre) (closePost := config.closePost) - if ← not <$> g.isAssigned <||> gs.anyM fun g' => return (← g'.getType).eqv (← g.getType) then - s.restore - acc := acc.push g - else - for g in gs do - acc ← rcongrCore g config qs acc - pure acc - -/-- -Repeatedly apply `congr` and `ext`, using the given patterns as arguments for `ext`. - -There are two ways this tactic stops: -* `congr` fails (makes no progress), after having already applied `ext`. -* `congr` canceled out the last usage of `ext`. In this case, the state is reverted to before - the `congr` was applied. - -For example, when the goal is -``` -⊢ (fun x => f x + 3) '' s = (fun x => g x + 3) '' s -``` -then `rcongr x` produces the goal -``` -x : α ⊢ f x = g x -``` -This gives the same result as `congr; ext x; congr`. - -In contrast, `congr` would produce -``` -⊢ (fun x => f x + 3) = (fun x => g x + 3) -``` -and `congr with x` (or `congr; ext x`) would produce -``` -x : α ⊢ f x + 3 = g x + 3 -``` --/ -elab (name := rcongr) "rcongr" cfg:((Parser.Tactic.config)?) ps:(ppSpace colGt rintroPat)* : - tactic => do - let gs ← rcongrCore (← getMainGoal) (← Congr.elabConfig cfg) - (RCases.expandRIntroPats ps).toList #[] - replaceMainGoal gs.toList diff --git a/Std/Tactic/Ext.lean b/Std/Tactic/Ext.lean index 6681cc2385..e69de29bb2 100644 --- a/Std/Tactic/Ext.lean +++ b/Std/Tactic/Ext.lean @@ -1,234 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro --/ -import Lean.Elab.Tactic.RCases -import Lean.Linter.Util -import Std.Tactic.Init -import Std.Tactic.Ext.Attr - -namespace Std.Tactic.Ext -open Lean Meta Elab Tactic - -/-- -Constructs the hypotheses for the extensionality lemma. -Calls the continuation `k` with the list of parameters to the structure, -two structure variables `x` and `y`, and a list of pairs `(field, ty)` -where `ty` is `x.field = y.field` or `HEq x.field y.field`. --/ -def withExtHyps (struct : Name) (flat : Term) - (k : Array Expr → (x y : Expr) → Array (Name × Expr) → MetaM α) : MetaM α := do - let flat ← match flat with - | `(true) => pure true - | `(false) => pure false - | _ => throwErrorAt flat "expected 'true' or 'false'" - unless isStructure (← getEnv) struct do throwError "not a structure: {struct}" - let structC ← mkConstWithLevelParams struct - forallTelescope (← inferType structC) fun params _ => do - withNewBinderInfos (params.map (·.fvarId!, BinderInfo.implicit)) do - withLocalDeclD `x (mkAppN structC params) fun x => do - withLocalDeclD `y (mkAppN structC params) fun y => do - let mut hyps := #[] - let fields := if flat then - getStructureFieldsFlattened (← getEnv) struct (includeSubobjectFields := false) - else - getStructureFields (← getEnv) struct - for field in fields do - let x_f ← mkProjection x field - let y_f ← mkProjection y field - if ← isProof x_f then - pure () - else if ← isDefEq (← inferType x_f) (← inferType y_f) then - hyps := hyps.push (field, ← mkEq x_f y_f) - else - hyps := hyps.push (field, ← mkHEq x_f y_f) - k params x y hyps - -/-- -Creates the type of the extensionality lemma for the given structure, -elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example. --/ -scoped elab "ext_type% " flat:term:max ppSpace struct:ident : term => do - withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do - let ty := hyps.foldr (init := ← mkEq x y) fun (f, h) ty => - mkForall f BinderInfo.default h ty - mkForallFVars (params |>.push x |>.push y) ty - -/-- Make an `Iff` application. -/ -def mkIff (p q : Expr) : Expr := mkApp2 (mkConst ``Iff) p q - -/-- Make an n-ary `And` application. `mkAndN []` returns `True`. -/ -def mkAndN : List Expr → Expr - | [] => mkConst ``True - | [p] => p - | p :: ps => mkAnd p (mkAndN ps) - -/-- -Creates the type of the iff-variant of the extensionality lemma for the given structure, -elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example. --/ -scoped elab "ext_iff_type% " flat:term:max ppSpace struct:ident : term => do - withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do - mkForallFVars (params |>.push x |>.push y) <| - mkIff (← mkEq x y) <| mkAndN (hyps.map (·.2)).toList - -macro_rules | `(declare_ext_theorems_for $[(flat := $f)]? $struct:ident $(prio)?) => do - let flat := f.getD (mkIdent `true) - let names ← Macro.resolveGlobalName struct.getId.eraseMacroScopes - let name ← match names.filter (·.2.isEmpty) with - | [] => Macro.throwError s!"unknown constant {struct}" - | [(name, _)] => pure name - | _ => Macro.throwError s!"ambiguous name {struct}" - let extName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext" - let extIffName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext_iff" - `(@[ext $(prio)?] protected theorem $extName:ident : ext_type% $flat $struct:ident := - fun {..} {..} => by intros; subst_eqs; rfl - protected theorem $extIffName:ident : ext_iff_type% $flat $struct:ident := - fun {..} {..} => - ⟨fun h => by cases h; split_ands <;> rfl, - fun _ => by (repeat cases ‹_ ∧ _›); subst_eqs; rfl⟩) - -/-- Apply a single extensionality lemma to `goal`. -/ -def applyExtLemma (goal : MVarId) : MetaM (List MVarId) := goal.withContext do - let tgt ← goal.getType' - unless tgt.isAppOfArity ``Eq 3 do - throwError "applyExtLemma only applies to equations, not{indentExpr tgt}" - let ty := tgt.getArg! 0 - let s ← saveState - for lem in ← getExtLemmas ty do - try - -- Note: We have to do this extra check to ensure that we don't apply e.g. - -- funext to a goal `(?a₁ : ?b) = ?a₂` to produce `(?a₁ x : ?b') = ?a₂ x`, - -- since this will loop. - -- We require that the type of the equality is not changed by the `goal.apply c` line - -- TODO: add flag to apply tactic to toggle unification vs. matching - withNewMCtxDepth do - let c ← mkConstWithFreshMVarLevels lem.declName - let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing (← inferType c) - guard (← isDefEq tgt declTy) - -- We use `newGoals := .all` as this is - -- more useful in practice with dependently typed arguments of `@[ext]` lemmas. - return ← goal.apply (cfg := { newGoals := .all }) (← mkConstWithFreshMVarLevels lem.declName) - catch _ => s.restore - throwError "no applicable extensionality lemma found for{indentExpr ty}" - -/-- Apply a single extensionality lemma to the current goal. -/ -elab "apply_ext_lemma" : tactic => liftMetaTactic applyExtLemma - -/-- -Postprocessor for `withExt` which runs `rintro` with the given patterns when the target is a -pi type. --/ -def tryIntros [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat)) - (k : MVarId → List (TSyntax `rcasesPat) → m Nat) : m Nat := do - match pats with - | [] => k (← (g.intros : TermElabM _)).2 [] - | p::ps => - if (← (g.withContext g.getType' : TermElabM _)).isForall then - let mut n := 0 - for g in ← RCases.rintro #[p] none g do - n := n.max (← tryIntros g ps k) - pure (n + 1) - else k g pats - -/-- -Applies a single extensionality lemma, using `pats` to introduce variables in the result. -Runs continuation `k` on each subgoal. --/ -def withExt1 [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat)) - (k : MVarId → List (TSyntax `rcasesPat) → m Nat) : m Nat := do - let mut n := 0 - for g in ← (applyExtLemma g : TermElabM _) do - n := n.max (← tryIntros g pats k) - pure n - -/-- -Applies a extensionality lemmas recursively, using `pats` to introduce variables in the result. -Runs continuation `k` on each subgoal. --/ -def withExtN [Monad m] [MonadLiftT TermElabM m] [MonadExcept Exception m] - (g : MVarId) (pats : List (TSyntax `rcasesPat)) (k : MVarId → List (TSyntax `rcasesPat) → m Nat) - (depth := 1000000) (failIfUnchanged := true) : m Nat := - match depth with - | 0 => k g pats - | depth+1 => do - if failIfUnchanged then - withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false) - else try - withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false) - catch _ => k g pats - -/-- -Apply extensionality lemmas as much as possible, using `pats` to introduce the variables -in extensionality lemmas like `funext`. Returns a list of subgoals. --/ -def extCore (g : MVarId) (pats : List (TSyntax `rcasesPat)) - (depth := 1000000) (failIfUnchanged := true) : - TermElabM (Nat × Array (MVarId × List (TSyntax `rcasesPat))) := do - StateT.run (m := TermElabM) (s := #[]) - (withExtN g pats (fun g qs => modify (·.push (g, qs)) *> pure 0) depth failIfUnchanged) - -/-- -* `ext pat*` applies extensionality lemmas as much as possible, - using `pat*` to introduce the variables in extensionality lemmas using `rintro`. - For example, this names the variables introduced by lemmas such as `funext`. -* `ext` applies extensionality lemmas as much as possible - but introduces anonymous variables whenever needed. -* `ext pat* : n` applies ext lemmas only up to depth `n`. - -The `ext1 pat*` tactic is like `ext pat*` except that it only applies a single extensionality lemma. - -The `ext?` tactic (note: unimplemented) has the same syntax as the `ext` tactic, -and it gives a suggestion of an equivalent tactic to use in place of `ext`. --/ -syntax "ext" (colGt ppSpace rintroPat)* (" : " num)? : tactic -elab_rules : tactic - | `(tactic| ext $pats* $[: $n]?) => do - let pats := RCases.expandRIntroPats pats - let depth := n.map (·.getNat) |>.getD 1000000 - let (used, gs) ← extCore (← getMainGoal) pats.toList depth - if RCases.linter.unusedRCasesPattern.get (← getOptions) then - if used < pats.size then - Linter.logLint RCases.linter.unusedRCasesPattern (mkNullNode pats[used:].toArray) - m!"`ext` did not consume the patterns: {pats[used:]}" - replaceMainGoal <| gs.map (·.1) |>.toList - -/-- -`ext1 pat*` is like `ext pat*` except that it only applies a single extensionality lemma rather -than recursively applying as many extensionality lemmas as possible. - -The `pat*` patterns are processed using the `rintro` tactic. -If no patterns are supplied, then variables are introduced anonymously using the `intros` tactic. - -The `ext1?` tactic (note: unimplemented) has the same syntax as the `ext1?` tactic, -and it gives a suggestion of an equivalent tactic to use in place of `ext1`. --/ -macro "ext1" xs:(colGt ppSpace rintroPat)* : tactic => - if xs.isEmpty then `(tactic| apply_ext_lemma <;> intros) - else `(tactic| apply_ext_lemma <;> rintro $xs*) - --- TODO -/-- `ext1? pat*` is like `ext1 pat*` but gives a suggestion on what pattern to use -/ -syntax "ext1?" (colGt ppSpace rintroPat)* : tactic -/-- `ext? pat*` is like `ext pat*` but gives a suggestion on what pattern to use -/ -syntax "ext?" (colGt ppSpace rintroPat)* (" : " num)? : tactic - -end Std.Tactic.Ext - -attribute [ext] funext propext Subtype.eq - -@[ext] theorem Prod.ext : {x y : Prod α β} → x.fst = y.fst → x.snd = y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl - -@[ext] theorem PProd.ext : {x y : PProd α β} → x.fst = y.fst → x.snd = y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl - -@[ext] theorem Sigma.ext : {x y : Sigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl - -@[ext] theorem PSigma.ext : {x y : PSigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl - -@[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl -protected theorem Unit.ext (x y : Unit) : x = y := rfl diff --git a/Std/Tactic/Ext/Attr.lean b/Std/Tactic/Ext/Attr.lean deleted file mode 100644 index 7b9245bc4b..0000000000 --- a/Std/Tactic/Ext/Attr.lean +++ /dev/null @@ -1,109 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro --/ -import Lean.Elab.Command - -namespace Std.Tactic.Ext -open Lean Meta - -/-- `declare_ext_theorems_for A` declares the extensionality theorems for the structure `A`. -/ -syntax "declare_ext_theorems_for " ("(" &"flat" " := " term ") ")? ident (ppSpace prio)? : command - -/-- Information about an extensionality theorem, stored in the environment extension. -/ -structure ExtTheorem where - /-- Declaration name of the extensionality theorem. -/ - declName : Name - /-- Priority of the extensionality theorem. -/ - priority : Nat - /-- Key in the discrimination tree. -/ - keys : Array DiscrTree.Key - deriving Inhabited, Repr, BEq, Hashable - -/-- The state of the `ext` extension environment -/ -structure ExtTheorems where - /-- The tree of `ext` extensions. -/ - tree : DiscrTree ExtTheorem := {} - /-- Erased `ext`s. -/ - erased : PHashSet Name := {} - deriving Inhabited - -/-- Discrimation tree settings for the `ext` extension. -/ -def extExt.config : WhnfCoreConfig := {} - -/-- The environment extension to track `@[ext]` lemmas. -/ -initialize extExtension : - SimpleScopedEnvExtension ExtTheorem ExtTheorems ← - registerSimpleScopedEnvExtension { - addEntry := fun { tree, erased } thm => - { tree := tree.insertCore thm.keys thm, erased := erased.erase thm.declName } - initial := {} - } - -/-- Get the list of `@[ext]` lemmas corresponding to the key `ty`, -ordered from high priority to low. -/ -@[inline] def getExtLemmas (ty : Expr) : MetaM (Array ExtTheorem) := do - let extTheorems := extExtension.getState (← getEnv) - let arr ← extTheorems.tree.getMatch ty extExt.config - let erasedArr := arr.filter fun thm => !extTheorems.erased.contains thm.declName - -- Using insertion sort because it is stable and the list of matches should be mostly sorted. - -- Most ext lemmas have default priority. - return erasedArr.insertionSort (·.priority < ·.priority) |>.reverse - -/-- Erases a name marked `ext` by adding it to the state's `erased` field and - removing it from the state's list of `Entry`s. -/ -def ExtTheorems.eraseCore (d : ExtTheorems) (declName : Name) : ExtTheorems := - { d with erased := d.erased.insert declName } - -/-- - Erase a name marked as a `ext` attribute. - Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem` - found somewhere in the state's tree, and is not erased. --/ -def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Name) : - m ExtTheorems := do - unless d.tree.containsValueP (·.declName == declName) && !d.erased.contains declName do - throwError "'{declName}' does not have [ext] attribute" - return d.eraseCore declName - -/-- Registers an extensionality lemma. - -* When `@[ext]` is applied to a structure, it generates `.ext` and `.ext_iff` theorems and registers - them for the `ext` tactic. - -* When `@[ext]` is applied to a theorem, the theorem is registered for the `ext` tactic. - -* You can use `@[ext 9000]` to specify a priority for the attribute. - -* You can use the flag `@[ext (flat := false)]` to prevent flattening all fields of parent - structures in the generated extensionality lemmas. -/ -syntax (name := ext) "ext" (" (" &"flat" " := " term ")")? (ppSpace prio)? : attr - -initialize registerBuiltinAttribute { - name := `ext - descr := "Marks a lemma as extensionality lemma" - add := fun declName stx kind => do - let `(attr| ext $[(flat := $f)]? $(prio)?) := stx - | throwError "unexpected @[ext] attribute {stx}" - if isStructure (← getEnv) declName then - liftCommandElabM <| Elab.Command.elabCommand <| - ← `(declare_ext_theorems_for $[(flat := $f)]? $(mkCIdentFrom stx declName) $[$prio]?) - else MetaM.run' do - if let some flat := f then - throwErrorAt flat "unexpected 'flat' config on @[ext] lemma" - let declTy := (← getConstInfo declName).type - let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing declTy - let failNotEq := throwError - "@[ext] attribute only applies to structures or lemmas proving x = y, got {declTy}" - let some (ty, lhs, rhs) := declTy.eq? | failNotEq - unless lhs.isMVar && rhs.isMVar do failNotEq - let keys ← withReducible <| DiscrTree.mkPath ty extExt.config - let priority ← liftCommandElabM do Elab.liftMacroM do - evalPrio (prio.getD (← `(prio| default))) - extExtension.add {declName, keys, priority} kind - erase := fun declName => do - let s := extExtension.getState (← getEnv) - let s ← s.erase declName - modifyEnv fun env => extExtension.modifyState env fun _ => s -} From 656848a541592ff7052f2352915e05678c33d4a8 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Thu, 15 Feb 2024 08:06:42 -0800 Subject: [PATCH 051/213] chore: adapt for 3347 --- Std/Classes/Cast.lean | 40 ---------------------------------------- 1 file changed, 40 deletions(-) diff --git a/Std/Classes/Cast.lean b/Std/Classes/Cast.lean index 9adeb6ebe0..9030568e99 100644 --- a/Std/Classes/Cast.lean +++ b/Std/Classes/Cast.lean @@ -5,46 +5,6 @@ Authors: Mario Carneiro, Gabriel Ebner -/ import Std.Util.LibraryNote -/-- Type class for the canonical homomorphism `Nat → R`. -/ -class NatCast (R : Type u) where - /-- The canonical map `Nat → R`. -/ - protected natCast : Nat → R - -instance : NatCast Nat where natCast n := n -instance : NatCast Int where natCast n := Int.ofNat n - -/-- Canonical homomorphism from `Nat` to a additive monoid `R` with a `1`. -This is just the bare function in order to aid in creating instances of `AddMonoidWithOne`. -/ -@[coe, reducible, match_pattern] protected def Nat.cast {R : Type u} [NatCast R] : Nat → R := - NatCast.natCast - --- see note [coercion into rings] -instance [NatCast R] : CoeTail Nat R where coe := Nat.cast - --- see note [coercion into rings] -instance [NatCast R] : CoeHTCT Nat R where coe := Nat.cast - -/-- This instance is needed to ensure that `instCoeNatInt` from core is not used. -/ -instance : Coe Nat Int where coe := Nat.cast - -/-- Type class for the canonical homomorphism `Int → R`. -/ -class IntCast (R : Type u) where - /-- The canonical map `Int → R`. -/ - protected intCast : Int → R - -instance : IntCast Int where intCast n := n - -/-- Canonical homomorphism from `Int` to a additive group `R` with a `1`. -This is just the bare function in order to aid in creating instances of `AddGroupWithOne`. -/ -@[coe, reducible, match_pattern] protected def Int.cast {R : Type u} [IntCast R] : Int → R := - IntCast.intCast - --- see note [coercion into rings] -instance [IntCast R] : CoeTail Int R where coe := Int.cast - --- see note [coercion into rings] -instance [IntCast R] : CoeHTCT Int R where coe := Int.cast - library_note "coercion into rings" /-- Coercions such as `Nat.castCoe` that go from a concrete structure such as From 5423cb8fbe29313ba108297dbdc2f8ac26c3e3a7 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 16 Feb 2024 12:00:34 +1100 Subject: [PATCH 052/213] don't use set notation in omega --- Std/Tactic/Omega/OmegaM.lean | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/Std/Tactic/Omega/OmegaM.lean b/Std/Tactic/Omega/OmegaM.lean index d4f20ec405..a8f51591f6 100644 --- a/Std/Tactic/Omega/OmegaM.lean +++ b/Std/Tactic/Omega/OmegaM.lean @@ -8,7 +8,6 @@ import Std.Tactic.Omega.LinearCombo import Std.Tactic.Omega.Config import Std.Lean.Expr import Std.Lean.HashSet -import Std.Classes.SetNotation /-! # The `OmegaM` state monad. @@ -129,7 +128,7 @@ def analyzeAtom (e : Expr) : OmegaM (HashSet Expr) := do match e.getAppFnArgs with | (``Nat.cast, #[.const ``Int [], _, e']) => -- Casts of natural numbers are non-negative. - let mut r := {Expr.app (.const ``Int.ofNat_nonneg []) e'} + let mut r := HashSet.empty.insert (Expr.app (.const ``Int.ofNat_nonneg []) e') match (← cfg).splitNatSub, e'.getAppFnArgs with | true, (``HSub.hSub, #[_, _, _, _, a, b]) => -- `((a - b : Nat) : Int)` gives a dichotomy @@ -149,9 +148,9 @@ def analyzeAtom (e : Expr) : OmegaM (HashSet Expr) := do let ne_zero := mkApp3 (.const ``Ne [1]) (.const ``Int []) k (toExpr (0 : Int)) let pos := mkApp4 (.const ``LT.lt [0]) (.const ``Int []) (.const ``Int.instLTInt []) (toExpr (0 : Int)) k - pure <| - {mkApp3 (.const ``Int.mul_ediv_self_le []) x k (← mkDecideProof ne_zero), - mkApp3 (.const ``Int.lt_mul_ediv_self_add []) x k (← mkDecideProof pos)} + pure <| HashSet.empty.insert + (mkApp3 (.const ``Int.mul_ediv_self_le []) x k (← mkDecideProof ne_zero)) |>.insert + (mkApp3 (.const ``Int.lt_mul_ediv_self_add []) x k (← mkDecideProof pos)) | (``HMod.hMod, #[_, _, _, _, x, k]) => match k.getAppFnArgs with | (``HPow.hPow, #[_, _, _, _, b, exp]) => match natCast? b with @@ -161,10 +160,10 @@ def analyzeAtom (e : Expr) : OmegaM (HashSet Expr) := do let b_pos := mkApp4 (.const ``LT.lt [0]) (.const ``Int []) (.const ``Int.instLTInt []) (toExpr (0 : Int)) b let pow_pos := mkApp3 (.const ``Int.pos_pow_of_pos []) b exp (← mkDecideProof b_pos) - pure <| - {mkApp3 (.const ``Int.emod_nonneg []) x k - (mkApp3 (.const ``Int.ne_of_gt []) k (toExpr (0 : Int)) pow_pos), - mkApp3 (.const ``Int.emod_lt_of_pos []) x k pow_pos} + pure <| HashSet.empty.insert + (mkApp3 (.const ``Int.emod_nonneg []) x k + (mkApp3 (.const ``Int.ne_of_gt []) k (toExpr (0 : Int)) pow_pos)) |>.insert + (mkApp3 (.const ``Int.emod_lt_of_pos []) x k pow_pos) | (``Nat.cast, #[.const ``Int [], _, k']) => match k'.getAppFnArgs with | (``HPow.hPow, #[_, _, _, _, b, exp]) => match natCast? b with @@ -175,19 +174,21 @@ def analyzeAtom (e : Expr) : OmegaM (HashSet Expr) := do (toExpr (0 : Nat)) b let pow_pos := mkApp3 (.const ``Nat.pos_pow_of_pos []) b exp (← mkDecideProof b_pos) let cast_pos := mkApp2 (.const ``Int.ofNat_pos_of_pos []) k' pow_pos - pure <| - {mkApp3 (.const ``Int.emod_nonneg []) x k - (mkApp3 (.const ``Int.ne_of_gt []) k (toExpr (0 : Int)) cast_pos), - mkApp3 (.const ``Int.emod_lt_of_pos []) x k cast_pos} + pure <| HashSet.empty.insert + (mkApp3 (.const ``Int.emod_nonneg []) x k + (mkApp3 (.const ``Int.ne_of_gt []) k (toExpr (0 : Int)) cast_pos)) |>.insert + (mkApp3 (.const ``Int.emod_lt_of_pos []) x k cast_pos) | _ => pure ∅ | _ => pure ∅ | (``Min.min, #[_, _, x, y]) => - pure <| {mkApp2 (.const ``Int.min_le_left []) x y, mkApp2 (.const ``Int.min_le_right []) x y} + pure <| HashSet.empty.insert (mkApp2 (.const ``Int.min_le_left []) x y) |>.insert + (mkApp2 (.const ``Int.min_le_right []) x y) | (``Max.max, #[_, _, x, y]) => - pure <| {mkApp2 (.const ``Int.le_max_left []) x y, mkApp2 (.const ``Int.le_max_right []) x y} + pure <| HashSet.empty.insert (mkApp2 (.const ``Int.le_max_left []) x y) |>.insert + (mkApp2 (.const ``Int.le_max_right []) x y) | (``ite, #[α, i, dec, t, e]) => if α == (.const ``Int []) then - pure <| {mkApp5 (.const ``ite_disjunction [0]) α i dec t e} + pure <| HashSet.empty.insert <| mkApp5 (.const ``ite_disjunction [0]) α i dec t e else pure {} | _ => pure ∅ From 7bcea890e12347efdb8a0acfb8adc89e506b371c Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 16 Feb 2024 12:00:53 +1100 Subject: [PATCH 053/213] remove unnecessary import --- Std/Tactic/Omega/OmegaM.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/Std/Tactic/Omega/OmegaM.lean b/Std/Tactic/Omega/OmegaM.lean index a8f51591f6..5a00afef35 100644 --- a/Std/Tactic/Omega/OmegaM.lean +++ b/Std/Tactic/Omega/OmegaM.lean @@ -7,7 +7,6 @@ import Std.Tactic.Omega.Int import Std.Tactic.Omega.LinearCombo import Std.Tactic.Omega.Config import Std.Lean.Expr -import Std.Lean.HashSet /-! # The `OmegaM` state monad. From 3ee03e504889b3be724f0063104e19c9e8d2b910 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 16 Feb 2024 12:35:53 +1100 Subject: [PATCH 054/213] fix import --- Std/Tactic/Omega/Frontend.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Std/Tactic/Omega/Frontend.lean b/Std/Tactic/Omega/Frontend.lean index 7ed447c428..b63725dc59 100644 --- a/Std/Tactic/Omega/Frontend.lean +++ b/Std/Tactic/Omega/Frontend.lean @@ -10,6 +10,7 @@ import Std.Tactic.Omega.Int import Std.Tactic.FalseOrByContra import Std.Lean.Meta.Basic import Std.Lean.Elab.Tactic +import Std.Lean.HashSet /-! # Frontend to the `omega` tactic. From a50b4ec18b0915cf972c6a1b517d8107ebaa879a Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 16 Feb 2024 13:42:25 +1100 Subject: [PATCH 055/213] removing omega dependencies --- Std/Classes/Order.lean | 8 ++++---- Std/Tactic/FalseOrByContra.lean | 10 ++++++---- Std/Tactic/Omega/Frontend.lean | 1 + Std/Tactic/Omega/Int.lean | 4 +++- Std/Tactic/Omega/MinNatAbs.lean | 3 +-- 5 files changed, 15 insertions(+), 11 deletions(-) diff --git a/Std/Classes/Order.lean b/Std/Classes/Order.lean index c5f70db253..ce18d8f9de 100644 --- a/Std/Classes/Order.lean +++ b/Std/Classes/Order.lean @@ -114,10 +114,10 @@ end Ordering @[simp] theorem gt_iff_lt [LT α] {x y : α} : x > y ↔ y < x := Iff.rfl -theorem le_of_eq_of_le {a b c : α} [LE α] (h₁ : a = b) (h₂ : b ≤ c) : a ≤ c := by subst h₁; exact h₂ +theorem le_of_eq_of_le {a b c : α} [LE α] (h₁ : a = b) (h₂ : b ≤ c) : a ≤ c := h₁ ▸ h₂ -theorem le_of_le_of_eq {a b c : α} [LE α] (h₁ : a ≤ b) (h₂ : b = c) : a ≤ c := by subst h₂; exact h₁ +theorem le_of_le_of_eq {a b c : α} [LE α] (h₁ : a ≤ b) (h₂ : b = c) : a ≤ c := h₂ ▸ h₁ -theorem lt_of_eq_of_lt {a b c : α} [LT α] (h₁ : a = b) (h₂ : b < c) : a < c := by subst h₁; exact h₂ +theorem lt_of_eq_of_lt {a b c : α} [LT α] (h₁ : a = b) (h₂ : b < c) : a < c := h₁ ▸ h₂ -theorem lt_of_lt_of_eq {a b c : α} [LT α] (h₁ : a < b) (h₂ : b = c) : a < c := by subst h₂; exact h₁ +theorem lt_of_lt_of_eq {a b c : α} [LT α] (h₁ : a < b) (h₂ : b = c) : a < c := h₂ ▸ h₁ diff --git a/Std/Tactic/FalseOrByContra.lean b/Std/Tactic/FalseOrByContra.lean index bcf9a9e125..8a3a8d0763 100644 --- a/Std/Tactic/FalseOrByContra.lean +++ b/Std/Tactic/FalseOrByContra.lean @@ -5,6 +5,7 @@ Authors: Scott Morrison -/ import Lean.Elab.Tactic.Basic import Std.Lean.Meta.Basic +import Lean.Meta.Tactic.Util /-! # `false_or_by_contra` tactic @@ -23,9 +24,11 @@ open Lean Changes the goal to `False`, retaining as much information as possible: If the goal is `False`, do nothing. -If the goal is an implication or a function type, introduce the argument. -(If the goal is `x ≠ y`, introduce `x = y`.) -Otherwise, for a propositional goal `P`, replace it with `¬ ¬ P` and introduce `¬ P`. +If the goal is an implication or a function type, introduce the argument and restart. +(In particular, if the goal is `x ≠ y`, introduce `x = y`.) +Otherwise, for a propositional goal `P`, replace it with `¬ ¬ P` +(attempt to find a `Decidable` instance, but otherwise falling back to working classically) +and introduce `¬ P`. For a non-propositional goal use `False.elim`. -/ syntax (name := false_or_by_contra) "false_or_by_contra" : tactic @@ -58,6 +61,5 @@ partial def falseOrByContra (g : MVarId) (useClassical : Option Bool := none) : let [g] ← g.applyConst ``False.elim | panic! "expected one sugoal" pure g - @[inherit_doc falseOrByContra] elab "false_or_by_contra" : tactic => liftMetaTactic1 (falseOrByContra ·) diff --git a/Std/Tactic/Omega/Frontend.lean b/Std/Tactic/Omega/Frontend.lean index b63725dc59..8dcbc10652 100644 --- a/Std/Tactic/Omega/Frontend.lean +++ b/Std/Tactic/Omega/Frontend.lean @@ -11,6 +11,7 @@ import Std.Tactic.FalseOrByContra import Std.Lean.Meta.Basic import Std.Lean.Elab.Tactic import Std.Lean.HashSet +import Lean.Meta.Tactic.Cases /-! # Frontend to the `omega` tactic. diff --git a/Std/Tactic/Omega/Int.lean b/Std/Tactic/Omega/Int.lean index 15615fba7c..8e094fb684 100644 --- a/Std/Tactic/Omega/Int.lean +++ b/Std/Tactic/Omega/Int.lean @@ -103,7 +103,9 @@ theorem natAbs_dichotomy {a : Int} : 0 ≤ a ∧ a.natAbs = a ∨ a < 0 ∧ a.na simp_all theorem neg_le_natAbs {a : Int} : -a ≤ a.natAbs := by - simpa using Int.le_natAbs (a := -a) + have t := Int.le_natAbs (a := -a) + simp at t + exact t theorem add_le_iff_le_sub (a b c : Int) : a + b ≤ c ↔ a ≤ c - b := by conv => diff --git a/Std/Tactic/Omega/MinNatAbs.lean b/Std/Tactic/Omega/MinNatAbs.lean index 88621f0709..03dd84da17 100644 --- a/Std/Tactic/Omega/MinNatAbs.lean +++ b/Std/Tactic/Omega/MinNatAbs.lean @@ -6,7 +6,6 @@ Authors: Scott Morrison import Std.Data.List.Init.Lemmas import Std.Data.Int.Init.Order import Std.Data.Option.Lemmas -import Std.Tactic.Init /-! # `List.nonzeroMinimum`, `List.minNatAbs`, `List.maxNatAbs` @@ -76,7 +75,7 @@ theorem nonzeroMinimum_eq_nonzero_iff {xs : List Nat} {y : Nat} (h : y ≠ 0) : specialize w (nonzeroMinimum xs) (nonzeroMinimum_mem nz) cases w with | inl h => exact h - | inr h => exfalso; exact nz h + | inr h => exact False.elim (nz h) theorem nonzeroMinimum_eq_of_nonzero {xs : List Nat} (h : xs.nonzeroMinimum ≠ 0) : ∃ x ∈ xs, xs.nonzeroMinimum = x := From a45defd526d98afd1f333bf084505bec47f16c97 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Thu, 15 Feb 2024 19:24:04 -0800 Subject: [PATCH 056/213] chore: compatibility updates for Int migration --- Std/Data/BitVec/Basic.lean | 1 - Std/Data/Int.lean | 4 - Std/Data/Int/Basic.lean | 173 ----------- Std/Data/Int/DivMod.lean | 7 - Std/Data/Int/Init/DivMod.lean | 340 --------------------- Std/Data/Int/Init/Lemmas.lean | 506 -------------------------------- Std/Data/Int/Init/Order.lean | 434 --------------------------- Std/Data/Int/Lemmas.lean | 1 - Std/Data/Int/Order.lean | 3 - Std/Data/Rat/Basic.lean | 2 + Std/Data/Rat/Lemmas.lean | 2 +- Std/Tactic/NormCast.lean | 18 ++ Std/Tactic/Omega/Int.lean | 2 +- Std/Tactic/Omega/IntList.lean | 1 - Std/Tactic/Omega/MinNatAbs.lean | 1 - test/int.lean | 1 - 16 files changed, 22 insertions(+), 1474 deletions(-) delete mode 100644 Std/Data/Int/Basic.lean delete mode 100644 Std/Data/Int/Init/DivMod.lean delete mode 100644 Std/Data/Int/Init/Lemmas.lean delete mode 100644 Std/Data/Int/Init/Order.lean diff --git a/Std/Data/BitVec/Basic.lean b/Std/Data/BitVec/Basic.lean index d702af163e..0aaa8d5a14 100644 --- a/Std/Data/BitVec/Basic.lean +++ b/Std/Data/BitVec/Basic.lean @@ -5,7 +5,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer -/ import Std.Data.Fin.Basic -import Std.Data.Int.Basic import Std.Data.Nat.Bitwise import Std.Tactic.Alias diff --git a/Std/Data/Int.lean b/Std/Data/Int.lean index e3f10da0b6..9f2f799da1 100644 --- a/Std/Data/Int.lean +++ b/Std/Data/Int.lean @@ -1,8 +1,4 @@ -import Std.Data.Int.Basic import Std.Data.Int.DivMod import Std.Data.Int.Gcd -import Std.Data.Int.Init.DivMod -import Std.Data.Int.Init.Lemmas -import Std.Data.Int.Init.Order import Std.Data.Int.Lemmas import Std.Data.Int.Order diff --git a/Std/Data/Int/Basic.lean b/Std/Data/Int/Basic.lean deleted file mode 100644 index c483dd63c6..0000000000 --- a/Std/Data/Int/Basic.lean +++ /dev/null @@ -1,173 +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 --/ -import Lean.ToExpr - -open Nat - -namespace Int - -/-- -`-[n+1]` is suggestive notation for `negSucc n`, which is the second constructor of -`Int` for making strictly negative numbers by mapping `n : Nat` to `-(n + 1)`. --/ -scoped notation "-[" n "+1]" => negSucc n - -/- ## sign -/ - -/-- -Returns the "sign" of the integer as another integer: `1` for positive numbers, -`-1` for negative numbers, and `0` for `0`. --/ -def sign : Int → Int - | succ _ => 1 - | 0 => 0 - | -[_+1] => -1 - -/-! ## toNat' -/ - -/-- -* If `n : Nat`, then `int.toNat' n = some n` -* If `n : Int` is negative, then `int.toNat' n = none`. --/ -def toNat' : Int → Option Nat - | (n : Nat) => some n - | -[_+1] => none - -/-! ## Quotient and remainder - -There are three main conventions for integer division, -referred here as the E, F, T rounding conventions. -All three pairs satisfy the identity `x % y + (x / y) * y = x` unconditionally, -and satisfy `x / 0 = 0` and `x % 0 = x`. --/ - -/-! ### E-rounding division - -This pair satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0`. --/ - -/-- -Integer division. This version of `Int.div` uses the E-rounding convention -(euclidean division), in which `Int.emod x y` satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0` -and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`. --/ -def ediv : Int → Int → Int - | ofNat m, ofNat n => ofNat (m / n) - | ofNat m, -[n+1] => -ofNat (m / succ n) - | -[_+1], 0 => 0 - | -[m+1], succ n => -[m / succ n +1] - | -[m+1], -[n+1] => ofNat (succ (m / succ n)) - -/-- -Integer modulus. This version of `Int.mod` uses the E-rounding convention -(euclidean division), in which `Int.emod x y` satisfies `0 ≤ emod x y < natAbs y` for `y ≠ 0` -and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`. --/ -def emod : Int → Int → Int - | ofNat m, n => ofNat (m % natAbs n) - | -[m+1], n => subNatNat (natAbs n) (succ (m % natAbs n)) - - -/-! ### F-rounding division - -This pair satisfies `fdiv x y = floor (x / y)`. --/ - -/-- -Integer division. This version of `Int.div` uses the F-rounding convention -(flooring division), in which `Int.fdiv x y` satisfies `fdiv x y = floor (x / y)` -and `Int.fmod` is the unique function satisfying `fmod x y + (fdiv x y) * y = x`. --/ -def fdiv : Int → Int → Int - | 0, _ => 0 - | ofNat m, ofNat n => ofNat (m / n) - | succ m, -[n+1] => -[m / succ n +1] - | -[_+1], 0 => 0 - | -[m+1], succ n => -[m / succ n +1] - | -[m+1], -[n+1] => ofNat (succ m / succ n) - -/-- -Integer modulus. This version of `Int.mod` uses the F-rounding convention -(flooring division), in which `Int.fdiv x y` satisfies `fdiv x y = floor (x / y)` -and `Int.fmod` is the unique function satisfying `fmod x y + (fdiv x y) * y = x`. --/ -def fmod : Int → Int → Int - | 0, _ => 0 - | ofNat m, ofNat n => ofNat (m % n) - | succ m, -[n+1] => subNatNat (m % succ n) n - | -[m+1], ofNat n => subNatNat n (succ (m % n)) - | -[m+1], -[n+1] => -ofNat (succ m % succ n) - -/-! ### T-rounding division - -This pair satisfies `div x y = round_to_zero (x / y)`. -`Int.div` and `Int.mod` are defined in core lean. --/ - -/-- -Core Lean provides instances using T-rounding division, i.e. `Int.div` and `Int.mod`. -We override these here. --/ -instance : Div Int := ⟨Int.ediv⟩ -instance : Mod Int := ⟨Int.emod⟩ - -/-! ## gcd -/ - -/-- Computes the greatest common divisor of two integers, as a `Nat`. -/ -def gcd (m n : Int) : Nat := m.natAbs.gcd n.natAbs - -/-! ## divisibility -/ - -/-- -Divisibility of integers. `a ∣ b` (typed as `\|`) says that -there is some `c` such that `b = a * c`. --/ -instance : Dvd Int := ⟨fun a b => ∃ c, b = a * c⟩ - -/-! ## bit operations -/ - -/-- -Bitwise not - -Interprets the integer as an infinite sequence of bits in two's complement -and complements each bit. -``` -~~~(0:Int) = -1 -~~~(1:Int) = -2 -~~~(-1:Int) = 0 -``` --/ -protected def not : Int -> Int - | Int.ofNat n => Int.negSucc n - | Int.negSucc n => Int.ofNat n - -instance : Complement Int := ⟨.not⟩ - -/-- -Bitwise shift right. - -Conceptually, this treats the integer as an infinite sequence of bits in two's -complement and shifts the value to the right. - -```lean -( 0b0111:Int) >>> 1 = 0b0011 -( 0b1000:Int) >>> 1 = 0b0100 -(-0b1000:Int) >>> 1 = -0b0100 -(-0b0111:Int) >>> 1 = -0b0100 -``` --/ -protected def shiftRight : Int → Nat → Int - | Int.ofNat n, s => Int.ofNat (n >>> s) - | Int.negSucc n, s => Int.negSucc (n >>> s) - -instance : HShiftRight Int Nat Int := ⟨.shiftRight⟩ - -open Lean in -instance : ToExpr Int where - toTypeExpr := .const ``Int [] - toExpr i := match i with - | .ofNat n => mkApp (.const ``Int.ofNat []) (toExpr n) - | .negSucc n => mkApp (.const ``Int.negSucc []) (toExpr n) diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index b14b0bc114..189b8c2afe 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -5,7 +5,6 @@ Authors: Jeremy Avigad, Mario Carneiro -/ import Std.Data.Nat.Lemmas import Std.Data.Int.Order -import Std.Data.Int.Init.DivMod /-! # Lemmas about integer division @@ -59,12 +58,6 @@ theorem fdiv_eq_div {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = div a | ofNat m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm | ofNat m, succ n | -[m+1], 0 | -[m+1], -[n+1] => rfl --- Lean 4 core provides an instance for `Div Int` using `Int.div`. --- Even though we provide a higher priority instance in `Std.Data.Int.Basic`, --- we provide a `simp` lemma here to unfold usages of that instance back to `Int.div`. -@[simp] theorem div_def' (a b : Int) : - @HDiv.hDiv Int Int Int (@instHDiv Int Int.instDivInt) a b = Int.div a b := rfl - @[simp] protected theorem neg_div : ∀ a b : Int, (-a).div b = -(a.div b) | 0, n => by simp [Int.neg_zero] | succ m, (n:Nat) | -[m+1], 0 | -[m+1], -[n+1] => rfl diff --git a/Std/Data/Int/Init/DivMod.lean b/Std/Data/Int/Init/DivMod.lean deleted file mode 100644 index a0eeb55ae8..0000000000 --- a/Std/Data/Int/Init/DivMod.lean +++ /dev/null @@ -1,340 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Mario Carneiro --/ -import Std.Data.Int.Init.Order - -/-! -# Lemmas about integer division needed to bootstrap `omega`. --/ - - -open Nat - -namespace Int - -/-! ### `/` -/ - -@[simp, norm_cast] theorem ofNat_ediv (m n : Nat) : (↑(m / n) : Int) = ↑m / ↑n := rfl - -@[simp] theorem zero_ediv : ∀ b : Int, 0 / b = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => show -ofNat _ = _ by simp - -@[simp] protected theorem ediv_zero : ∀ a : Int, a / 0 = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => rfl - -@[simp] protected theorem ediv_neg : ∀ a b : Int, a / (-b) = -(a / b) - | ofNat m, 0 => show ofNat (m / 0) = -↑(m / 0) by rw [Nat.div_zero]; rfl - | ofNat m, -[n+1] => (Int.neg_neg _).symm - | ofNat m, succ n | -[m+1], 0 | -[m+1], succ n | -[m+1], -[n+1] => rfl - -protected theorem div_def (a b : Int) : a / b = Int.ediv a b := rfl - -theorem add_mul_ediv_right (a b : Int) {c : Int} (H : c ≠ 0) : (a + b * c) / c = a / c + b := - suffices ∀ {{a b c : Int}}, 0 < c → (a + b * c).ediv c = a.ediv c + b from - match Int.lt_trichotomy c 0 with - | Or.inl hlt => by - rw [← Int.neg_inj, ← Int.ediv_neg, Int.neg_add, ← Int.ediv_neg, ← Int.neg_mul_neg] - exact this (Int.neg_pos_of_neg hlt) - | Or.inr (Or.inl HEq) => absurd HEq H - | Or.inr (Or.inr hgt) => this hgt - suffices ∀ {k n : Nat} {a : Int}, (a + n * k.succ).ediv k.succ = a.ediv k.succ + n from - fun a b c H => match c, eq_succ_of_zero_lt H, b with - | _, ⟨_, rfl⟩, ofNat _ => this - | _, ⟨k, rfl⟩, -[n+1] => show (a - n.succ * k.succ).ediv k.succ = a.ediv k.succ - n.succ by - rw [← Int.add_sub_cancel (ediv ..), ← this, Int.sub_add_cancel] - fun {k n} => @fun - | ofNat m => congrArg ofNat <| Nat.add_mul_div_right _ _ k.succ_pos - | -[m+1] => by - show ((n * k.succ : Nat) - m.succ : Int).ediv k.succ = n - (m / k.succ + 1 : Nat) - if h : m < n * k.succ then - rw [← Int.ofNat_sub h, ← Int.ofNat_sub ((Nat.div_lt_iff_lt_mul k.succ_pos).2 h)] - apply congrArg ofNat - rw [Nat.mul_comm, Nat.mul_sub_div]; rwa [Nat.mul_comm] - else - have h := Nat.not_lt.1 h - have H {a b : Nat} (h : a ≤ b) : (a : Int) + -((b : Int) + 1) = -[b - a +1] := by - rw [negSucc_eq, Int.ofNat_sub h] - simp only [Int.sub_eq_add_neg, Int.neg_add, Int.neg_neg, Int.add_left_comm, Int.add_assoc] - show ediv (↑(n * succ k) + -((m : Int) + 1)) (succ k) = n + -(↑(m / succ k) + 1 : Int) - rw [H h, H ((Nat.le_div_iff_mul_le k.succ_pos).2 h)] - apply congrArg negSucc - rw [Nat.mul_comm, Nat.sub_mul_div]; rwa [Nat.mul_comm] - -theorem add_ediv_of_dvd_right {a b c : Int} (H : c ∣ b) : (a + b) / c = a / c + b / c := - if h : c = 0 then by simp [h] else by - let ⟨k, hk⟩ := H - rw [hk, Int.mul_comm c k, Int.add_mul_ediv_right _ _ h, - ← Int.zero_add (k * c), Int.add_mul_ediv_right _ _ h, Int.zero_ediv, Int.zero_add] - -theorem add_ediv_of_dvd_left {a b c : Int} (H : c ∣ a) : (a + b) / c = a / c + b / c := by - rw [Int.add_comm, Int.add_ediv_of_dvd_right H, Int.add_comm] - -@[simp] theorem mul_ediv_cancel (a : Int) {b : Int} (H : b ≠ 0) : (a * b) / b = a := by - have := Int.add_mul_ediv_right 0 a H - rwa [Int.zero_add, Int.zero_ediv, Int.zero_add] at this - -@[simp] theorem mul_ediv_cancel_left (b : Int) (H : a ≠ 0) : (a * b) / a = b := - Int.mul_comm .. ▸ Int.mul_ediv_cancel _ H - -theorem div_nonneg_iff_of_pos {a b : Int} (h : 0 < b) : a / b ≥ 0 ↔ a ≥ 0 := by - rw [Int.div_def] - match b, h with - | Int.ofNat (b+1), _ => - rcases a with ⟨a⟩ <;> simp [Int.ediv] - exact decide_eq_decide.mp rfl - -/-! ### mod -/ - -theorem mod_def' (m n : Int) : m % n = emod m n := rfl - -theorem ofNat_mod (m n : Nat) : (↑(m % n) : Int) = mod m n := rfl - -theorem ofNat_mod_ofNat (m n : Nat) : (m % n : Int) = ↑(m % n) := rfl - -@[simp, norm_cast] theorem ofNat_emod (m n : Nat) : (↑(m % n) : Int) = m % n := rfl - -@[simp] theorem zero_emod (b : Int) : 0 % b = 0 := by simp [mod_def', emod] - -@[simp] theorem emod_zero : ∀ a : Int, a % 0 = a - | ofNat _ => congrArg ofNat <| Nat.mod_zero _ - | -[_+1] => congrArg negSucc <| Nat.mod_zero _ - -theorem emod_add_ediv : ∀ a b : Int, a % b + b * (a / b) = a - | ofNat _, ofNat _ => congrArg ofNat <| Nat.mod_add_div .. - | ofNat m, -[n+1] => by - show (m % succ n + -↑(succ n) * -↑(m / succ n) : Int) = m - rw [Int.neg_mul_neg]; exact congrArg ofNat <| Nat.mod_add_div .. - | -[_+1], 0 => by rw [emod_zero]; rfl - | -[m+1], succ n => aux m n.succ - | -[m+1], -[n+1] => aux m n.succ -where - aux (m n : Nat) : n - (m % n + 1) - (n * (m / n) + n) = -[m+1] := by - rw [← ofNat_emod, ← ofNat_ediv, ← Int.sub_sub, negSucc_eq, Int.sub_sub n, - ← Int.neg_neg (_-_), Int.neg_sub, Int.sub_sub_self, Int.add_right_comm] - exact congrArg (fun x => -(ofNat x + 1)) (Nat.mod_add_div ..) - -theorem ediv_add_emod (a b : Int) : b * (a / b) + a % b = a := - (Int.add_comm ..).trans (emod_add_ediv ..) - -theorem emod_def (a b : Int) : a % b = a - b * (a / b) := by - rw [← Int.add_sub_cancel (a % b), emod_add_ediv] - -theorem emod_nonneg : ∀ (a : Int) {b : Int}, b ≠ 0 → 0 ≤ a % b - | ofNat _, _, _ => ofNat_zero_le _ - | -[_+1], _, H => Int.sub_nonneg_of_le <| ofNat_le.2 <| Nat.mod_lt _ (natAbs_pos.2 H) - -theorem emod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : a % b < b := - match a, b, eq_succ_of_zero_lt H with - | ofNat _, _, ⟨_, rfl⟩ => ofNat_lt.2 (Nat.mod_lt _ (Nat.succ_pos _)) - | -[_+1], _, ⟨_, rfl⟩ => Int.sub_lt_self _ (ofNat_lt.2 <| Nat.succ_pos _) - -theorem mul_ediv_self_le {x k : Int} (h : k ≠ 0) : k * (x / k) ≤ x := - calc k * (x / k) - _ ≤ k * (x / k) + x % k := Int.le_add_of_nonneg_right (emod_nonneg x h) - _ = x := ediv_add_emod _ _ - -theorem lt_mul_ediv_self_add {x k : Int} (h : 0 < k) : x < k * (x / k) + k := - calc x - _ = k * (x / k) + x % k := (ediv_add_emod _ _).symm - _ < k * (x / k) + k := Int.add_lt_add_left (emod_lt_of_pos x h) _ - -theorem emod_add_ediv' (m k : Int) : m % k + m / k * k = m := by - rw [Int.mul_comm]; apply emod_add_ediv - -@[simp] theorem add_mul_emod_self {a b c : Int} : (a + b * c) % c = a % c := - if cz : c = 0 then by - rw [cz, Int.mul_zero, Int.add_zero] - else by - rw [Int.emod_def, Int.emod_def, Int.add_mul_ediv_right _ _ cz, Int.add_comm _ b, - Int.mul_add, Int.mul_comm, ← Int.sub_sub, Int.add_sub_cancel] - -@[simp] theorem add_mul_emod_self_left (a b c : Int) : (a + b * c) % b = a % b := by - rw [Int.mul_comm, Int.add_mul_emod_self] - -@[simp] theorem add_emod_self {a b : Int} : (a + b) % b = a % b := by - have := add_mul_emod_self_left a b 1; rwa [Int.mul_one] at this - -@[simp] theorem add_emod_self_left {a b : Int} : (a + b) % a = b % a := by - rw [Int.add_comm, Int.add_emod_self] - -theorem neg_emod {a b : Int} : -a % b = (b - a) % b := by - rw [← add_emod_self_left]; rfl - -@[simp] theorem emod_add_emod (m n k : Int) : (m % n + k) % n = (m + k) % n := by - have := (add_mul_emod_self_left (m % n + k) n (m / n)).symm - rwa [Int.add_right_comm, emod_add_ediv] at this - -@[simp] theorem add_emod_emod (m n k : Int) : (m + n % k) % k = (m + n) % k := by - rw [Int.add_comm, emod_add_emod, Int.add_comm] - -theorem add_emod (a b n : Int) : (a + b) % n = (a % n + b % n) % n := by - rw [add_emod_emod, emod_add_emod] - -theorem add_emod_eq_add_emod_right {m n k : Int} (i : Int) - (H : m % n = k % n) : (m + i) % n = (k + i) % n := by - rw [← emod_add_emod, ← emod_add_emod k, H] - -theorem emod_add_cancel_right {m n k : Int} (i) : (m + i) % n = (k + i) % n ↔ m % n = k % n := - ⟨fun H => by - have := add_emod_eq_add_emod_right (-i) H - rwa [Int.add_neg_cancel_right, Int.add_neg_cancel_right] at this, - add_emod_eq_add_emod_right _⟩ - -@[simp] theorem mul_emod_left (a b : Int) : (a * b) % b = 0 := by - rw [← Int.zero_add (a * b), Int.add_mul_emod_self, Int.zero_emod] - -@[simp] theorem mul_emod_right (a b : Int) : (a * b) % a = 0 := by - rw [Int.mul_comm, mul_emod_left] - -theorem mul_emod (a b n : Int) : (a * b) % n = (a % n) * (b % n) % n := by - conv => lhs; rw [ - ← emod_add_ediv a n, ← emod_add_ediv' b n, Int.add_mul, Int.mul_add, Int.mul_add, - Int.mul_assoc, Int.mul_assoc, ← Int.mul_add n _ _, add_mul_emod_self_left, - ← Int.mul_assoc, add_mul_emod_self] - -@[local simp] theorem emod_self {a : Int} : a % a = 0 := by - have := mul_emod_left 1 a; rwa [Int.one_mul] at this - -@[simp] theorem emod_emod_of_dvd (n : Int) {m k : Int} - (h : m ∣ k) : (n % k) % m = n % m := by - conv => rhs; rw [← emod_add_ediv n k] - match k, h with - | _, ⟨t, rfl⟩ => rw [Int.mul_assoc, add_mul_emod_self_left] - -@[simp] theorem emod_emod (a b : Int) : (a % b) % b = a % b := by - conv => rhs; rw [← emod_add_ediv a b, add_mul_emod_self_left] - -theorem sub_emod (a b n : Int) : (a - b) % n = (a % n - b % n) % n := by - apply (emod_add_cancel_right b).mp - rw [Int.sub_add_cancel, ← Int.add_emod_emod, Int.sub_add_cancel, emod_emod] - -/-! ### properties of `/` and `%` -/ - -theorem mul_ediv_cancel_of_emod_eq_zero {a b : Int} (H : a % b = 0) : b * (a / b) = a := by - have := emod_add_ediv a b; rwa [H, Int.zero_add] at this - -theorem ediv_mul_cancel_of_emod_eq_zero {a b : Int} (H : a % b = 0) : a / b * b = a := by - rw [Int.mul_comm, mul_ediv_cancel_of_emod_eq_zero H] - -/-! ### dvd -/ - -protected theorem dvd_zero (n : Int) : n ∣ 0 := ⟨0, (Int.mul_zero _).symm⟩ - -protected theorem dvd_refl (n : Int) : n ∣ n := ⟨1, (Int.mul_one _).symm⟩ - -protected theorem one_dvd (n : Int) : 1 ∣ n := ⟨n, (Int.one_mul n).symm⟩ - -protected theorem dvd_trans : ∀ {a b c : Int}, a ∣ b → b ∣ c → a ∣ c - | _, _, _, ⟨d, rfl⟩, ⟨e, rfl⟩ => ⟨d * e, by rw [Int.mul_assoc]⟩ - -@[simp] protected theorem zero_dvd {n : Int} : 0 ∣ n ↔ n = 0 := - ⟨fun ⟨k, e⟩ => by rw [e, Int.zero_mul], fun h => h.symm ▸ Int.dvd_refl _⟩ - -protected theorem neg_dvd {a b : Int} : -a ∣ b ↔ a ∣ b := by - constructor <;> exact fun ⟨k, e⟩ => - ⟨-k, by simp [e, Int.neg_mul, Int.mul_neg, Int.neg_neg]⟩ - -protected theorem dvd_neg {a b : Int} : a ∣ -b ↔ a ∣ b := by - constructor <;> exact fun ⟨k, e⟩ => - ⟨-k, by simp [← e, Int.neg_mul, Int.mul_neg, Int.neg_neg]⟩ - -protected theorem dvd_mul_right (a b : Int) : a ∣ a * b := ⟨_, rfl⟩ - -protected theorem dvd_mul_left (a b : Int) : b ∣ a * b := ⟨_, Int.mul_comm ..⟩ - -protected theorem dvd_add : ∀ {a b c : Int}, a ∣ b → a ∣ c → a ∣ b + c - | _, _, _, ⟨d, rfl⟩, ⟨e, rfl⟩ => ⟨d + e, by rw [Int.mul_add]⟩ - -protected theorem dvd_sub : ∀ {a b c : Int}, a ∣ b → a ∣ c → a ∣ b - c - | _, _, _, ⟨d, rfl⟩, ⟨e, rfl⟩ => ⟨d - e, by rw [Int.mul_sub]⟩ - - -@[norm_cast] theorem ofNat_dvd {m n : Nat} : (↑m : Int) ∣ ↑n ↔ m ∣ n := by - refine ⟨fun ⟨a, ae⟩ => ?_, fun ⟨k, e⟩ => ⟨k, by rw [e, Int.ofNat_mul]⟩⟩ - match Int.le_total a 0 with - | .inl h => - have := ae.symm ▸ Int.mul_nonpos_of_nonneg_of_nonpos (ofNat_zero_le _) h - rw [Nat.le_antisymm (ofNat_le.1 this) (Nat.zero_le _)] - apply Nat.dvd_zero - | .inr h => match a, eq_ofNat_of_zero_le h with - | _, ⟨k, rfl⟩ => exact ⟨k, Int.ofNat.inj ae⟩ - -@[simp] theorem natAbs_dvd_natAbs {a b : Int} : natAbs a ∣ natAbs b ↔ a ∣ b := by - refine ⟨fun ⟨k, hk⟩ => ?_, fun ⟨k, hk⟩ => ⟨natAbs k, hk.symm ▸ natAbs_mul a k⟩⟩ - rw [← natAbs_ofNat k, ← natAbs_mul, natAbs_eq_natAbs_iff] at hk - cases hk <;> subst b - · apply Int.dvd_mul_right - · rw [← Int.mul_neg]; apply Int.dvd_mul_right - -theorem ofNat_dvd_left {n : Nat} {z : Int} : (↑n : Int) ∣ z ↔ n ∣ z.natAbs := by - rw [← natAbs_dvd_natAbs, natAbs_ofNat] - -theorem dvd_of_emod_eq_zero {a b : Int} (H : b % a = 0) : a ∣ b := - ⟨b / a, (mul_ediv_cancel_of_emod_eq_zero H).symm⟩ - -theorem dvd_emod_sub_self {x : Int} {m : Nat} : (m : Int) ∣ x % m - x := by - apply dvd_of_emod_eq_zero - simp [sub_emod] - -theorem emod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → b % a = 0 - | _, _, ⟨_, rfl⟩ => mul_emod_right .. - -theorem dvd_iff_emod_eq_zero (a b : Int) : a ∣ b ↔ b % a = 0 := - ⟨emod_eq_zero_of_dvd, dvd_of_emod_eq_zero⟩ - -theorem emod_pos_of_not_dvd {a b : Int} (h : ¬ a ∣ b) : a = 0 ∨ 0 < b % a := by - rw [dvd_iff_emod_eq_zero] at h - if w : a = 0 then simp_all - else exact Or.inr (Int.lt_iff_le_and_ne.mpr ⟨emod_nonneg b w, Ne.symm h⟩) - -instance decidableDvd : DecidableRel (α := Int) (· ∣ ·) := fun _ _ => - decidable_of_decidable_of_iff (dvd_iff_emod_eq_zero ..).symm - -protected theorem ediv_mul_cancel {a b : Int} (H : b ∣ a) : a / b * b = a := - ediv_mul_cancel_of_emod_eq_zero (emod_eq_zero_of_dvd H) - -protected theorem mul_ediv_cancel' {a b : Int} (H : a ∣ b) : a * (b / a) = b := by - rw [Int.mul_comm, Int.ediv_mul_cancel H] - -protected theorem mul_ediv_assoc (a : Int) : ∀ {b c : Int}, c ∣ b → (a * b) / c = a * (b / c) - | _, c, ⟨d, rfl⟩ => - if cz : c = 0 then by simp [cz, Int.mul_zero] else by - rw [Int.mul_left_comm, Int.mul_ediv_cancel_left _ cz, Int.mul_ediv_cancel_left _ cz] - -protected theorem mul_ediv_assoc' (b : Int) {a c : Int} - (h : c ∣ a) : (a * b) / c = a / c * b := by - rw [Int.mul_comm, Int.mul_ediv_assoc _ h, Int.mul_comm] - -theorem neg_ediv_of_dvd : ∀ {a b : Int}, b ∣ a → (-a) / b = -(a / b) - | _, b, ⟨c, rfl⟩ => by if bz : b = 0 then simp [bz] else - rw [Int.neg_mul_eq_mul_neg, Int.mul_ediv_cancel_left _ bz, Int.mul_ediv_cancel_left _ bz] - -theorem sub_ediv_of_dvd (a : Int) {b c : Int} - (hcb : c ∣ b) : (a - b) / c = a / c - b / c := by - rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_ediv_of_dvd_right (Int.dvd_neg.2 hcb)] - congr; exact Int.neg_ediv_of_dvd hcb - -/-! -# `bmod` ("balanced" mod) - -We use balanced mod in the omega algorithm, -to make ±1 coefficients appear in equations without them. --/ - -/-- -Balanced mod, taking values in the range [- m/2, (m - 1)/2]. --/ -def bmod (x : Int) (m : Nat) : Int := - let r := x % m - if r < (m + 1) / 2 then - r - else - r - m - -@[simp] theorem bmod_emod : bmod x m % m = x % m := by - dsimp [bmod] - split <;> simp [Int.sub_emod] diff --git a/Std/Data/Int/Init/Lemmas.lean b/Std/Data/Int/Init/Lemmas.lean deleted file mode 100644 index 8ea82a6871..0000000000 --- a/Std/Data/Int/Init/Lemmas.lean +++ /dev/null @@ -1,506 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro --/ -import Std.Classes.Cast -import Std.Data.Int.Basic -import Std.Tactic.NormCast.Lemmas - -open Nat - -namespace Int - -@[simp] theorem ofNat_eq_coe : ofNat n = Nat.cast n := rfl - -@[simp] theorem ofNat_zero : ((0 : Nat) : Int) = 0 := rfl - -@[simp] theorem ofNat_one : ((1 : Nat) : Int) = 1 := rfl - -theorem ofNat_two : ((2 : Nat) : Int) = 2 := rfl - -@[simp] theorem default_eq_zero : default = (0 : Int) := rfl - -protected theorem zero_ne_one : (0 : Int) ≠ 1 := nofun - -/- ## Definitions of basic functions -/ - -theorem subNatNat_of_sub_eq_zero {m n : Nat} (h : n - m = 0) : subNatNat m n = ↑(m - n) := by - rw [subNatNat, h, ofNat_eq_coe] - -theorem subNatNat_of_sub_eq_succ {m n k : Nat} (h : n - m = succ k) : subNatNat m n = -[k+1] := by - rw [subNatNat, h] - -@[simp] protected theorem neg_zero : -(0:Int) = 0 := rfl - -@[norm_cast] theorem ofNat_add (n m : Nat) : (↑(n + m) : Int) = n + m := rfl -@[norm_cast] theorem ofNat_mul (n m : Nat) : (↑(n * m) : Int) = n * m := rfl -theorem ofNat_succ (n : Nat) : (succ n : Int) = n + 1 := rfl - -@[local simp] theorem neg_ofNat_zero : -((0 : Nat) : Int) = 0 := rfl -@[local simp] theorem neg_ofNat_succ (n : Nat) : -(succ n : Int) = -[n+1] := rfl -@[local simp] theorem neg_negSucc (n : Nat) : -(-[n+1]) = succ n := rfl - -theorem negSucc_coe (n : Nat) : -[n+1] = -↑(n + 1) := rfl - -theorem negOfNat_eq : negOfNat n = -ofNat n := rfl - -/- ## These are only for internal use -/ - -@[simp] theorem add_def {a b : Int} : Int.add a b = a + b := rfl - -@[local simp] theorem ofNat_add_ofNat (m n : Nat) : (↑m + ↑n : Int) = ↑(m + n) := rfl -@[local simp] theorem ofNat_add_negSucc (m n : Nat) : ↑m + -[n+1] = subNatNat m (succ n) := rfl -@[local simp] theorem negSucc_add_ofNat (m n : Nat) : -[m+1] + ↑n = subNatNat n (succ m) := rfl -@[local simp] theorem negSucc_add_negSucc (m n : Nat) : -[m+1] + -[n+1] = -[succ (m + n) +1] := rfl - -@[simp] theorem mul_def {a b : Int} : Int.mul a b = a * b := rfl - -@[local simp] theorem ofNat_mul_ofNat (m n : Nat) : (↑m * ↑n : Int) = ↑(m * n) := rfl -@[local simp] theorem ofNat_mul_negSucc' (m n : Nat) : ↑m * -[n+1] = negOfNat (m * succ n) := rfl -@[local simp] theorem negSucc_mul_ofNat' (m n : Nat) : -[m+1] * ↑n = negOfNat (succ m * n) := rfl -@[local simp] theorem negSucc_mul_negSucc' (m n : Nat) : - -[m+1] * -[n+1] = ofNat (succ m * succ n) := rfl - -/- ## some basic functions and properties -/ - -@[norm_cast] theorem ofNat_inj : ((m : Nat) : Int) = (n : Nat) ↔ m = n := ⟨ofNat.inj, congrArg _⟩ - -theorem ofNat_eq_zero : ((n : Nat) : Int) = 0 ↔ n = 0 := ofNat_inj - -theorem ofNat_ne_zero : ((n : Nat) : Int) ≠ 0 ↔ n ≠ 0 := not_congr ofNat_eq_zero - -theorem negSucc_inj : negSucc m = negSucc n ↔ m = n := ⟨negSucc.inj, fun H => by simp [H]⟩ - -theorem negSucc_eq (n : Nat) : -[n+1] = -((n : Int) + 1) := rfl - -@[simp] theorem negSucc_ne_zero (n : Nat) : -[n+1] ≠ 0 := nofun - -@[simp] theorem zero_ne_negSucc (n : Nat) : 0 ≠ -[n+1] := nofun - -@[simp, norm_cast] theorem Nat.cast_ofNat_Int : - (Nat.cast (no_index (OfNat.ofNat n)) : Int) = OfNat.ofNat n := rfl - -/- ## neg -/ - -@[simp] protected theorem neg_neg : ∀ a : Int, -(-a) = a - | 0 => rfl - | succ _ => rfl - | -[_+1] => rfl - -protected theorem neg_inj {a b : Int} : -a = -b ↔ a = b := - ⟨fun h => by rw [← Int.neg_neg a, ← Int.neg_neg b, h], congrArg _⟩ - -@[simp] protected theorem neg_eq_zero : -a = 0 ↔ a = 0 := Int.neg_inj (b := 0) - -protected theorem neg_ne_zero : -a ≠ 0 ↔ a ≠ 0 := not_congr Int.neg_eq_zero - -protected theorem sub_eq_add_neg {a b : Int} : a - b = a + -b := rfl - -theorem add_neg_one (i : Int) : i + -1 = i - 1 := rfl - -/- ## basic properties of subNatNat -/ - --- @[elabAsElim] -- TODO(Mario): unexpected eliminator resulting type -theorem subNatNat_elim (m n : Nat) (motive : Nat → Nat → Int → Prop) - (hp : ∀ i n, motive (n + i) n i) - (hn : ∀ i m, motive m (m + i + 1) -[i+1]) : - motive m n (subNatNat m n) := by - unfold subNatNat - match h : n - m with - | 0 => - have ⟨k, h⟩ := Nat.le.dest (Nat.le_of_sub_eq_zero h) - rw [h.symm, Nat.add_sub_cancel_left]; apply hp - | succ k => - rw [Nat.sub_eq_iff_eq_add (Nat.le_of_lt (Nat.lt_of_sub_eq_succ h))] at h - rw [h, Nat.add_comm]; apply hn - -theorem subNatNat_add_left : subNatNat (m + n) m = n := by - unfold subNatNat - rw [Nat.sub_eq_zero_of_le (Nat.le_add_right ..), Nat.add_sub_cancel_left, ofNat_eq_coe] - -theorem subNatNat_add_right : subNatNat m (m + n + 1) = negSucc n := by - simp [subNatNat, Nat.add_assoc, Nat.add_sub_cancel_left] - -theorem subNatNat_add_add (m n k : Nat) : subNatNat (m + k) (n + k) = subNatNat m n := by - apply subNatNat_elim m n (fun m n i => subNatNat (m + k) (n + k) = i) - · intro i j - rw [Nat.add_assoc, Nat.add_comm i k, ← Nat.add_assoc] - exact subNatNat_add_left - · intro i j - rw [Nat.add_assoc j i 1, Nat.add_comm j (i+1), Nat.add_assoc, Nat.add_comm (i+1) (j+k)] - exact subNatNat_add_right - -theorem subNatNat_of_le {m n : Nat} (h : n ≤ m) : subNatNat m n = ↑(m - n) := - subNatNat_of_sub_eq_zero (Nat.sub_eq_zero_of_le h) - -theorem subNatNat_of_lt {m n : Nat} (h : m < n) : subNatNat m n = -[pred (n - m) +1] := - subNatNat_of_sub_eq_succ <| (Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)).symm - - -/- # Additive group properties -/ - -/- addition -/ - -protected theorem add_comm : ∀ a b : Int, a + b = b + a - | ofNat n, ofNat m => by simp [Nat.add_comm] - | ofNat _, -[_+1] => rfl - | -[_+1], ofNat _ => rfl - | -[_+1], -[_+1] => by simp [Nat.add_comm] - -@[simp] protected theorem add_zero : ∀ a : Int, a + 0 = a - | ofNat _ => rfl - | -[_+1] => rfl - -@[simp] protected theorem zero_add (a : Int) : 0 + a = a := Int.add_comm .. ▸ a.add_zero - -theorem ofNat_add_negSucc_of_lt (h : m < n.succ) : ofNat m + -[n+1] = -[n - m+1] := - show subNatNat .. = _ by simp [succ_sub (le_of_lt_succ h), subNatNat] - -theorem subNatNat_sub (h : n ≤ m) (k : Nat) : subNatNat (m - n) k = subNatNat m (k + n) := by - rwa [← subNatNat_add_add _ _ n, Nat.sub_add_cancel] - -theorem subNatNat_add (m n k : Nat) : subNatNat (m + n) k = m + subNatNat n k := by - cases n.lt_or_ge k with - | inl h' => - simp [subNatNat_of_lt h', succ_pred_eq_of_pos (Nat.sub_pos_of_lt h')] - conv => lhs; rw [← Nat.sub_add_cancel (Nat.le_of_lt h')] - apply subNatNat_add_add - | inr h' => simp [subNatNat_of_le h', - subNatNat_of_le (Nat.le_trans h' (le_add_left ..)), Nat.add_sub_assoc h'] - -theorem subNatNat_add_negSucc (m n k : Nat) : - subNatNat m n + -[k+1] = subNatNat m (n + succ k) := by - have h := Nat.lt_or_ge m n - cases h with - | inr h' => - rw [subNatNat_of_le h'] - simp - rw [subNatNat_sub h', Nat.add_comm] - | inl h' => - have h₂ : m < n + succ k := Nat.lt_of_lt_of_le h' (le_add_right _ _) - have h₃ : m ≤ n + k := le_of_succ_le_succ h₂ - rw [subNatNat_of_lt h', subNatNat_of_lt h₂] - simp [Nat.add_comm] - rw [← add_succ, succ_pred_eq_of_pos (Nat.sub_pos_of_lt h'), add_succ, succ_sub h₃, - Nat.pred_succ] - rw [Nat.add_comm n, Nat.add_sub_assoc (Nat.le_of_lt h')] - -protected theorem add_assoc : ∀ a b c : Int, a + b + c = a + (b + c) - | (m:Nat), (n:Nat), c => aux1 .. - | Nat.cast m, b, Nat.cast k => by - rw [Int.add_comm, ← aux1, Int.add_comm k, aux1, Int.add_comm b] - | a, (n:Nat), (k:Nat) => by - rw [Int.add_comm, Int.add_comm a, ← aux1, Int.add_comm a, Int.add_comm k] - | -[m+1], -[n+1], (k:Nat) => aux2 .. - | -[m+1], (n:Nat), -[k+1] => by - rw [Int.add_comm, ← aux2, Int.add_comm n, ← aux2, Int.add_comm -[m+1]] - | (m:Nat), -[n+1], -[k+1] => by - rw [Int.add_comm, Int.add_comm m, Int.add_comm m, ← aux2, Int.add_comm -[k+1]] - | -[m+1], -[n+1], -[k+1] => by - simp [add_succ, Nat.add_comm, Nat.add_left_comm, neg_ofNat_succ] -where - aux1 (m n : Nat) : ∀ c : Int, m + n + c = m + (n + c) - | (k:Nat) => by simp [Nat.add_assoc] - | -[k+1] => by simp [subNatNat_add] - aux2 (m n k : Nat) : -[m+1] + -[n+1] + k = -[m+1] + (-[n+1] + k) := by - simp [add_succ] - rw [Int.add_comm, subNatNat_add_negSucc] - simp [add_succ, succ_add, Nat.add_comm] - -protected theorem add_left_comm (a b c : Int) : a + (b + c) = b + (a + c) := by - rw [← Int.add_assoc, Int.add_comm a, Int.add_assoc] - -protected theorem add_right_comm (a b c : Int) : a + b + c = a + c + b := by - rw [Int.add_assoc, Int.add_comm b, ← Int.add_assoc] - -/- ## negation -/ - -theorem subNatNat_self : ∀ n, subNatNat n n = 0 - | 0 => rfl - | succ m => by rw [subNatNat_of_sub_eq_zero (Nat.sub_self ..), Nat.sub_self, ofNat_zero] - -attribute [local simp] subNatNat_self - -@[local simp] protected theorem add_left_neg : ∀ a : Int, -a + a = 0 - | 0 => rfl - | succ m => by simp - | -[m+1] => by simp - -@[local simp] protected theorem add_right_neg (a : Int) : a + -a = 0 := by - rw [Int.add_comm, Int.add_left_neg] - -@[simp] protected theorem neg_eq_of_add_eq_zero {a b : Int} (h : a + b = 0) : -a = b := by - rw [← Int.add_zero (-a), ← h, ← Int.add_assoc, Int.add_left_neg, Int.zero_add] - -protected theorem eq_neg_of_eq_neg {a b : Int} (h : a = -b) : b = -a := by - rw [h, Int.neg_neg] - -protected theorem eq_neg_comm {a b : Int} : a = -b ↔ b = -a := - ⟨Int.eq_neg_of_eq_neg, Int.eq_neg_of_eq_neg⟩ - -protected theorem neg_eq_comm {a b : Int} : -a = b ↔ -b = a := by - rw [eq_comm, Int.eq_neg_comm, eq_comm] - -protected theorem neg_add_cancel_left (a b : Int) : -a + (a + b) = b := by - rw [← Int.add_assoc, Int.add_left_neg, Int.zero_add] - -protected theorem add_neg_cancel_left (a b : Int) : a + (-a + b) = b := by - rw [← Int.add_assoc, Int.add_right_neg, Int.zero_add] - -protected theorem add_neg_cancel_right (a b : Int) : a + b + -b = a := by - rw [Int.add_assoc, Int.add_right_neg, Int.add_zero] - -protected theorem neg_add_cancel_right (a b : Int) : a + -b + b = a := by - rw [Int.add_assoc, Int.add_left_neg, Int.add_zero] - -protected theorem add_left_cancel {a b c : Int} (h : a + b = a + c) : b = c := by - have h₁ : -a + (a + b) = -a + (a + c) := by rw [h] - simp [← Int.add_assoc, Int.add_left_neg, Int.zero_add] at h₁; exact h₁ - -@[local simp] protected theorem neg_add {a b : Int} : -(a + b) = -a + -b := by - apply Int.add_left_cancel (a := a + b) - rw [Int.add_right_neg, Int.add_comm a, ← Int.add_assoc, Int.add_assoc b, - Int.add_right_neg, Int.add_zero, Int.add_right_neg] - -/- ## subtraction -/ - -@[simp] theorem negSucc_sub_one (n : Nat) : -[n+1] - 1 = -[n + 1 +1] := rfl - -@[simp] protected theorem sub_self (a : Int) : a - a = 0 := by - rw [Int.sub_eq_add_neg, Int.add_right_neg] - -@[simp] protected theorem sub_zero (a : Int) : a - 0 = a := by simp [Int.sub_eq_add_neg] - -@[simp] protected theorem zero_sub (a : Int) : 0 - a = -a := by simp [Int.sub_eq_add_neg] - -protected theorem sub_eq_zero_of_eq {a b : Int} (h : a = b) : a - b = 0 := by - rw [h, Int.sub_self] - -protected theorem eq_of_sub_eq_zero {a b : Int} (h : a - b = 0) : a = b := by - have : 0 + b = b := by rw [Int.zero_add] - have : a - b + b = b := by rwa [h] - rwa [Int.sub_eq_add_neg, Int.neg_add_cancel_right] at this - -protected theorem sub_eq_zero {a b : Int} : a - b = 0 ↔ a = b := - ⟨Int.eq_of_sub_eq_zero, Int.sub_eq_zero_of_eq⟩ - -protected theorem sub_sub (a b c : Int) : a - b - c = a - (b + c) := by - simp [Int.sub_eq_add_neg, Int.add_assoc] - -protected theorem neg_sub (a b : Int) : -(a - b) = b - a := by - simp [Int.sub_eq_add_neg, Int.add_comm] - -protected theorem sub_sub_self (a b : Int) : a - (a - b) = b := by - simp [Int.sub_eq_add_neg, ← Int.add_assoc] - -protected theorem sub_neg (a b : Int) : a - -b = a + b := by simp [Int.sub_eq_add_neg] - -@[simp] protected theorem sub_add_cancel (a b : Int) : a - b + b = a := - Int.neg_add_cancel_right a b - -@[simp] protected theorem add_sub_cancel (a b : Int) : a + b - b = a := - Int.add_neg_cancel_right a b - -protected theorem add_sub_assoc (a b c : Int) : a + b - c = a + (b - c) := by - rw [Int.sub_eq_add_neg, Int.add_assoc, ← Int.sub_eq_add_neg] - -@[norm_cast] theorem ofNat_sub (h : m ≤ n) : ((n - m : Nat) : Int) = n - m := by - match m with - | 0 => rfl - | succ m => - show ofNat (n - succ m) = subNatNat n (succ m) - rw [subNatNat, Nat.sub_eq_zero_of_le h] - -theorem negSucc_coe' (n : Nat) : -[n+1] = -↑n - 1 := by - rw [Int.sub_eq_add_neg, ← Int.neg_add]; rfl - -protected theorem subNatNat_eq_coe {m n : Nat} : subNatNat m n = ↑m - ↑n := by - apply subNatNat_elim m n fun m n i => i = m - n - · intros i n - rw [Int.ofNat_add, Int.sub_eq_add_neg, Int.add_assoc, Int.add_left_comm, - Int.add_right_neg, Int.add_zero] - · intros i n - simp only [negSucc_coe, ofNat_add, Int.sub_eq_add_neg, Int.neg_add, ← Int.add_assoc] - rw [← @Int.sub_eq_add_neg n, ← ofNat_sub, Nat.sub_self, ofNat_zero, Int.zero_add] - apply Nat.le_refl - -theorem toNat_sub (m n : Nat) : toNat (m - n) = m - n := by - rw [← Int.subNatNat_eq_coe] - refine subNatNat_elim m n (fun m n i => toNat i = m - n) (fun i n => ?_) (fun i n => ?_) - · exact (Nat.add_sub_cancel_left ..).symm - · dsimp; rw [Nat.add_assoc, Nat.sub_eq_zero_of_le (Nat.le_add_right ..)]; rfl - -/- ## Ring properties -/ - -@[simp] theorem ofNat_mul_negSucc (m n : Nat) : (m : Int) * -[n+1] = -↑(m * succ n) := rfl - -@[simp] theorem negSucc_mul_ofNat (m n : Nat) : -[m+1] * n = -↑(succ m * n) := rfl - -@[simp] theorem negSucc_mul_negSucc (m n : Nat) : -[m+1] * -[n+1] = succ m * succ n := rfl - -protected theorem mul_comm (a b : Int) : a * b = b * a := by - cases a <;> cases b <;> simp [Nat.mul_comm] - -theorem ofNat_mul_negOfNat (m n : Nat) : (m : Nat) * negOfNat n = negOfNat (m * n) := by - cases n <;> rfl - -theorem negOfNat_mul_ofNat (m n : Nat) : negOfNat m * (n : Nat) = negOfNat (m * n) := by - rw [Int.mul_comm]; simp [ofNat_mul_negOfNat, Nat.mul_comm] - -theorem negSucc_mul_negOfNat (m n : Nat) : -[m+1] * negOfNat n = ofNat (succ m * n) := by - cases n <;> rfl - -theorem negOfNat_mul_negSucc (m n : Nat) : negOfNat n * -[m+1] = ofNat (n * succ m) := by - rw [Int.mul_comm, negSucc_mul_negOfNat, Nat.mul_comm] - -attribute [local simp] ofNat_mul_negOfNat negOfNat_mul_ofNat - negSucc_mul_negOfNat negOfNat_mul_negSucc - -protected theorem mul_assoc (a b c : Int) : a * b * c = a * (b * c) := by - cases a <;> cases b <;> cases c <;> simp [Nat.mul_assoc] - -protected theorem mul_left_comm (a b c : Int) : a * (b * c) = b * (a * c) := by - rw [← Int.mul_assoc, ← Int.mul_assoc, Int.mul_comm a] - -protected theorem mul_right_comm (a b c : Int) : a * b * c = a * c * b := by - rw [Int.mul_assoc, Int.mul_assoc, Int.mul_comm b] - -@[simp] protected theorem mul_zero (a : Int) : a * 0 = 0 := by cases a <;> rfl - -@[simp] protected theorem zero_mul (a : Int) : 0 * a = 0 := Int.mul_comm .. ▸ a.mul_zero - -theorem negOfNat_eq_subNatNat_zero (n) : negOfNat n = subNatNat 0 n := by cases n <;> rfl - -theorem ofNat_mul_subNatNat (m n k : Nat) : - m * subNatNat n k = subNatNat (m * n) (m * k) := by - cases m with - | zero => simp [ofNat_zero, Int.zero_mul, Nat.zero_mul] - | succ m => cases n.lt_or_ge k with - | inl h => - have h' : succ m * n < succ m * k := Nat.mul_lt_mul_of_pos_left h (Nat.succ_pos m) - simp [subNatNat_of_lt h, subNatNat_of_lt h'] - rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h), ← neg_ofNat_succ, Nat.mul_sub_left_distrib, - ← succ_pred_eq_of_pos (Nat.sub_pos_of_lt h')]; rfl - | inr h => - have h' : succ m * k ≤ succ m * n := Nat.mul_le_mul_left _ h - simp [subNatNat_of_le h, subNatNat_of_le h', Nat.mul_sub_left_distrib] - -theorem negOfNat_add (m n : Nat) : negOfNat m + negOfNat n = negOfNat (m + n) := by - cases m <;> cases n <;> simp [Nat.succ_add] <;> rfl - -theorem negSucc_mul_subNatNat (m n k : Nat) : - -[m+1] * subNatNat n k = subNatNat (succ m * k) (succ m * n) := by - cases n.lt_or_ge k with - | inl h => - have h' : succ m * n < succ m * k := Nat.mul_lt_mul_of_pos_left h (Nat.succ_pos m) - rw [subNatNat_of_lt h, subNatNat_of_le (Nat.le_of_lt h')] - simp [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h), Nat.mul_sub_left_distrib] - | inr h => cases Nat.lt_or_ge k n with - | inl h' => - have h₁ : succ m * n > succ m * k := Nat.mul_lt_mul_of_pos_left h' (Nat.succ_pos m) - rw [subNatNat_of_le h, subNatNat_of_lt h₁, negSucc_mul_ofNat, - Nat.mul_sub_left_distrib, ← succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁)]; rfl - | inr h' => rw [Nat.le_antisymm h h', subNatNat_self, subNatNat_self, Int.mul_zero] - -attribute [local simp] ofNat_mul_subNatNat negOfNat_add negSucc_mul_subNatNat - -protected theorem mul_add : ∀ a b c : Int, a * (b + c) = a * b + a * c - | (m:Nat), (n:Nat), (k:Nat) => by simp [Nat.left_distrib] - | (m:Nat), (n:Nat), -[k+1] => by - simp [negOfNat_eq_subNatNat_zero]; rw [← subNatNat_add]; rfl - | (m:Nat), -[n+1], (k:Nat) => by - simp [negOfNat_eq_subNatNat_zero]; rw [Int.add_comm, ← subNatNat_add]; rfl - | (m:Nat), -[n+1], -[k+1] => by simp; rw [← Nat.left_distrib, succ_add]; rfl - | -[m+1], (n:Nat), (k:Nat) => by simp [Nat.mul_comm]; rw [← Nat.right_distrib, Nat.mul_comm] - | -[m+1], (n:Nat), -[k+1] => by - simp [negOfNat_eq_subNatNat_zero]; rw [Int.add_comm, ← subNatNat_add]; rfl - | -[m+1], -[n+1], (k:Nat) => by simp [negOfNat_eq_subNatNat_zero]; rw [← subNatNat_add]; rfl - | -[m+1], -[n+1], -[k+1] => by simp; rw [← Nat.left_distrib, succ_add]; rfl - -protected theorem add_mul (a b c : Int) : (a + b) * c = a * c + b * c := by - simp [Int.mul_comm, Int.mul_add] - -protected theorem neg_mul_eq_neg_mul (a b : Int) : -(a * b) = -a * b := - Int.neg_eq_of_add_eq_zero <| by rw [← Int.add_mul, Int.add_right_neg, Int.zero_mul] - -protected theorem neg_mul_eq_mul_neg (a b : Int) : -(a * b) = a * -b := - Int.neg_eq_of_add_eq_zero <| by rw [← Int.mul_add, Int.add_right_neg, Int.mul_zero] - -@[local simp] protected theorem neg_mul (a b : Int) : -a * b = -(a * b) := - (Int.neg_mul_eq_neg_mul a b).symm - -@[local simp] protected theorem mul_neg (a b : Int) : a * -b = -(a * b) := - (Int.neg_mul_eq_mul_neg a b).symm - -protected theorem neg_mul_neg (a b : Int) : -a * -b = a * b := by simp - -protected theorem neg_mul_comm (a b : Int) : -a * b = a * -b := by simp - -protected theorem mul_sub (a b c : Int) : a * (b - c) = a * b - a * c := by - simp [Int.sub_eq_add_neg, Int.mul_add] - -protected theorem sub_mul (a b c : Int) : (a - b) * c = a * c - b * c := by - simp [Int.sub_eq_add_neg, Int.add_mul] - -@[simp] protected theorem one_mul : ∀ a : Int, 1 * a = a - | ofNat n => show ofNat (1 * n) = ofNat n by rw [Nat.one_mul] - | -[n+1] => show -[1 * n +1] = -[n+1] by rw [Nat.one_mul] - -@[simp] protected theorem mul_one (a : Int) : a * 1 = a := by rw [Int.mul_comm, Int.one_mul] - -protected theorem mul_neg_one (a : Int) : a * -1 = -a := by rw [Int.mul_neg, Int.mul_one] - -protected theorem neg_eq_neg_one_mul : ∀ a : Int, -a = -1 * a - | 0 => rfl - | succ n => show _ = -[1 * n +1] by rw [Nat.one_mul]; rfl - | -[n+1] => show _ = ofNat _ by rw [Nat.one_mul]; rfl - -protected theorem mul_eq_zero {a b : Int} : a * b = 0 ↔ a = 0 ∨ b = 0 := by - refine ⟨fun h => ?_, fun h => h.elim (by simp [·, Int.zero_mul]) (by simp [·, Int.mul_zero])⟩ - exact match a, b, h with - | .ofNat 0, _, _ => by simp - | _, .ofNat 0, _ => by simp - | .ofNat (a+1), .negSucc b, h => by cases h - -protected theorem mul_ne_zero {a b : Int} (a0 : a ≠ 0) (b0 : b ≠ 0) : a * b ≠ 0 := - mt Int.mul_eq_zero.1 <| not_or.2 ⟨a0, b0⟩ - -protected theorem eq_of_mul_eq_mul_right {a b c : Int} (ha : a ≠ 0) (h : b * a = c * a) : b = c := - have : (b - c) * a = 0 := by rwa [Int.sub_mul, Int.sub_eq_zero] - Int.sub_eq_zero.1 <| (Int.mul_eq_zero.1 this).resolve_right ha - -protected theorem eq_of_mul_eq_mul_left {a b c : Int} (ha : a ≠ 0) (h : a * b = a * c) : b = c := - have : a * b - a * c = 0 := Int.sub_eq_zero_of_eq h - have : a * (b - c) = 0 := by rw [Int.mul_sub, this] - have : b - c = 0 := (Int.mul_eq_zero.1 this).resolve_left ha - Int.eq_of_sub_eq_zero this - -theorem mul_eq_mul_left_iff {a b c : Int} (h : c ≠ 0) : c * a = c * b ↔ a = b := - ⟨Int.eq_of_mul_eq_mul_left h, fun w => congrArg (fun x => c * x) w⟩ - -theorem mul_eq_mul_right_iff {a b c : Int} (h : c ≠ 0) : a * c = b * c ↔ a = b := - ⟨Int.eq_of_mul_eq_mul_right h, fun w => congrArg (fun x => x * c) w⟩ - -theorem eq_one_of_mul_eq_self_left {a b : Int} (Hpos : a ≠ 0) (H : b * a = a) : b = 1 := - Int.eq_of_mul_eq_mul_right Hpos <| by rw [Int.one_mul, H] - -theorem eq_one_of_mul_eq_self_right {a b : Int} (Hpos : b ≠ 0) (H : b * a = b) : a = 1 := - Int.eq_of_mul_eq_mul_left Hpos <| by rw [Int.mul_one, H] - -/-! -The following lemmas are later subsumed by e.g. `Nat.cast_add` and `Nat.cast_mul` in Mathlib -but it is convenient to have these earlier, for users who only need `Nat` and `Int`. --/ - -theorem natCast_zero : ((0 : Nat) : Int) = (0 : Int) := rfl - -theorem natCast_one : ((1 : Nat) : Int) = (1 : Int) := rfl - -@[simp] theorem natCast_add (a b : Nat) : ((a + b : Nat) : Int) = (a : Int) + (b : Int) := by - -- Note this only works because of local simp attributes in this file, - -- so it still makes sense to tag the lemmas with `@[simp]`. - simp - -@[simp] theorem natCast_mul (a b : Nat) : ((a * b : Nat) : Int) = (a : Int) * (b : Int) := by - simp diff --git a/Std/Data/Int/Init/Order.lean b/Std/Data/Int/Init/Order.lean deleted file mode 100644 index d2902119bb..0000000000 --- a/Std/Data/Int/Init/Order.lean +++ /dev/null @@ -1,434 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro --/ -import Std.Data.Int.Init.Lemmas -import Std.Tactic.Alias - -/-! -# Results about the order properties of the integers, and the integers as an ordered ring. --/ - -open Nat - -namespace Int - -/-! ## Order properties of the integers -/ - -theorem nonneg_def {a : Int} : NonNeg a ↔ ∃ n : Nat, a = n := - ⟨fun ⟨n⟩ => ⟨n, rfl⟩, fun h => match a, h with | _, ⟨n, rfl⟩ => ⟨n⟩⟩ - -theorem NonNeg.elim {a : Int} : NonNeg a → ∃ n : Nat, a = n := nonneg_def.1 - -theorem nonneg_or_nonneg_neg : ∀ (a : Int), NonNeg a ∨ NonNeg (-a) - | (_:Nat) => .inl ⟨_⟩ - | -[_+1] => .inr ⟨_⟩ - -theorem le_def (a b : Int) : a ≤ b ↔ NonNeg (b - a) := .rfl - -theorem lt_iff_add_one_le (a b : Int) : a < b ↔ a + 1 ≤ b := .rfl - -theorem le.intro_sub {a b : Int} (n : Nat) (h : b - a = n) : a ≤ b := by - simp [le_def, h]; constructor - -attribute [local simp] Int.add_left_neg Int.add_right_neg Int.neg_add - -theorem le.intro {a b : Int} (n : Nat) (h : a + n = b) : a ≤ b := - le.intro_sub n <| by rw [← h, Int.add_comm]; simp [Int.sub_eq_add_neg, Int.add_assoc] - -theorem le.dest_sub {a b : Int} (h : a ≤ b) : ∃ n : Nat, b - a = n := nonneg_def.1 h - -theorem le.dest {a b : Int} (h : a ≤ b) : ∃ n : Nat, a + n = b := - let ⟨n, h₁⟩ := le.dest_sub h - ⟨n, by rw [← h₁, Int.add_comm]; simp [Int.sub_eq_add_neg, Int.add_assoc]⟩ - -protected theorem le_total (a b : Int) : a ≤ b ∨ b ≤ a := - (nonneg_or_nonneg_neg (b - a)).imp_right fun H => by - rwa [show -(b - a) = a - b by simp [Int.add_comm, Int.sub_eq_add_neg]] at H - -@[simp, norm_cast] theorem ofNat_le {m n : Nat} : (↑m : Int) ≤ ↑n ↔ m ≤ n := - ⟨fun h => - let ⟨k, hk⟩ := le.dest h - Nat.le.intro <| Int.ofNat.inj <| (Int.ofNat_add m k).trans hk, - fun h => - let ⟨k, (hk : m + k = n)⟩ := Nat.le.dest h - le.intro k (by rw [← hk]; rfl)⟩ - -theorem ofNat_zero_le (n : Nat) : 0 ≤ (↑n : Int) := ofNat_le.2 n.zero_le - -theorem eq_ofNat_of_zero_le {a : Int} (h : 0 ≤ a) : ∃ n : Nat, a = n := by - have t := le.dest_sub h; rwa [Int.sub_zero] at t - -theorem eq_succ_of_zero_lt {a : Int} (h : 0 < a) : ∃ n : Nat, a = n.succ := - let ⟨n, (h : ↑(1 + n) = a)⟩ := le.dest h - ⟨n, by rw [Nat.add_comm] at h; exact h.symm⟩ - -theorem lt_add_succ (a : Int) (n : Nat) : a < a + Nat.succ n := - le.intro n <| by rw [Int.add_comm, Int.add_left_comm]; rfl - -theorem lt.intro {a b : Int} {n : Nat} (h : a + Nat.succ n = b) : a < b := - h ▸ lt_add_succ a n - -theorem lt.dest {a b : Int} (h : a < b) : ∃ n : Nat, a + Nat.succ n = b := - let ⟨n, h⟩ := le.dest h; ⟨n, by rwa [Int.add_comm, Int.add_left_comm] at h⟩ - -@[simp, norm_cast] theorem ofNat_lt {n m : Nat} : (↑n : Int) < ↑m ↔ n < m := by - rw [lt_iff_add_one_le, ← ofNat_succ, ofNat_le]; rfl - -@[simp, norm_cast] theorem ofNat_pos {n : Nat} : 0 < (↑n : Int) ↔ 0 < n := ofNat_lt - -theorem ofNat_nonneg (n : Nat) : 0 ≤ (n : Int) := ⟨_⟩ - -theorem ofNat_succ_pos (n : Nat) : 0 < (succ n : Int) := ofNat_lt.2 <| Nat.succ_pos _ - -@[simp] protected theorem le_refl (a : Int) : a ≤ a := - le.intro _ (Int.add_zero a) - -protected theorem le_trans {a b c : Int} (h₁ : a ≤ b) (h₂ : b ≤ c) : a ≤ c := - let ⟨n, hn⟩ := le.dest h₁; let ⟨m, hm⟩ := le.dest h₂ - le.intro (n + m) <| by rw [← hm, ← hn, Int.add_assoc, ofNat_add] - -protected theorem le_antisymm {a b : Int} (h₁ : a ≤ b) (h₂ : b ≤ a) : a = b := by - let ⟨n, hn⟩ := le.dest h₁; let ⟨m, hm⟩ := le.dest h₂ - have := hn; rw [← hm, Int.add_assoc, ← ofNat_add] at this - have := Int.ofNat.inj <| Int.add_left_cancel <| this.trans (Int.add_zero _).symm - rw [← hn, Nat.eq_zero_of_add_eq_zero_left this, ofNat_zero, Int.add_zero a] - -protected theorem lt_irrefl (a : Int) : ¬a < a := fun H => - let ⟨n, hn⟩ := lt.dest H - have : (a+Nat.succ n) = a+0 := by - rw [hn, Int.add_zero] - have : Nat.succ n = 0 := Int.ofNat.inj (Int.add_left_cancel this) - show False from Nat.succ_ne_zero _ this - -protected theorem ne_of_lt {a b : Int} (h : a < b) : a ≠ b := fun e => by - cases e; exact Int.lt_irrefl _ h - -protected theorem ne_of_gt {a b : Int} (h : b < a) : a ≠ b := (Int.ne_of_lt h).symm - -protected theorem le_of_lt {a b : Int} (h : a < b) : a ≤ b := - let ⟨_, hn⟩ := lt.dest h; le.intro _ hn - -protected theorem lt_iff_le_and_ne {a b : Int} : a < b ↔ a ≤ b ∧ a ≠ b := by - refine ⟨fun h => ⟨Int.le_of_lt h, Int.ne_of_lt h⟩, fun ⟨aleb, aneb⟩ => ?_⟩ - let ⟨n, hn⟩ := le.dest aleb - have : n ≠ 0 := aneb.imp fun eq => by rw [← hn, eq, ofNat_zero, Int.add_zero] - apply lt.intro; rwa [← Nat.succ_pred_eq_of_pos (Nat.pos_of_ne_zero this)] at hn - -theorem lt_succ (a : Int) : a < a + 1 := Int.le_refl _ - -protected theorem zero_lt_one : (0 : Int) < 1 := ⟨_⟩ - -protected theorem lt_iff_le_not_le {a b : Int} : a < b ↔ a ≤ b ∧ ¬b ≤ a := by - rw [Int.lt_iff_le_and_ne] - constructor <;> refine fun ⟨h, h'⟩ => ⟨h, h'.imp fun h' => ?_⟩ - · exact Int.le_antisymm h h' - · subst h'; apply Int.le_refl - -protected theorem not_le {a b : Int} : ¬a ≤ b ↔ b < a := - ⟨fun h => Int.lt_iff_le_not_le.2 ⟨(Int.le_total ..).resolve_right h, h⟩, - fun h => (Int.lt_iff_le_not_le.1 h).2⟩ - -protected theorem not_lt {a b : Int} : ¬a < b ↔ b ≤ a := - by rw [← Int.not_le, Decidable.not_not] - -protected theorem lt_trichotomy (a b : Int) : a < b ∨ a = b ∨ b < a := - if eq : a = b then .inr <| .inl eq else - if le : a ≤ b then .inl <| Int.lt_iff_le_and_ne.2 ⟨le, eq⟩ else - .inr <| .inr <| Int.not_le.1 le - -protected theorem ne_iff_lt_or_gt {a b : Int} : a ≠ b ↔ a < b ∨ b < a := by - constructor - · intro h - cases Int.lt_trichotomy a b - case inl lt => exact Or.inl lt - case inr h => - cases h - case inl =>simp_all - case inr gt => exact Or.inr gt - · intro h - cases h - case inl lt => exact Int.ne_of_lt lt - case inr gt => exact Int.ne_of_gt gt - -protected alias ⟨lt_or_gt_of_ne, _⟩ := Int.ne_iff_lt_or_gt - -protected theorem eq_iff_le_and_ge {x y : Int} : x = y ↔ x ≤ y ∧ y ≤ x := by - constructor - · simp_all - · intro ⟨h₁, h₂⟩ - exact Int.le_antisymm h₁ h₂ - -protected theorem lt_of_le_of_lt {a b c : Int} (h₁ : a ≤ b) (h₂ : b < c) : a < c := - Int.not_le.1 fun h => Int.not_le.2 h₂ (Int.le_trans h h₁) - -protected theorem lt_of_lt_of_le {a b c : Int} (h₁ : a < b) (h₂ : b ≤ c) : a < c := - Int.not_le.1 fun h => Int.not_le.2 h₁ (Int.le_trans h₂ h) - -protected theorem lt_trans {a b c : Int} (h₁ : a < b) (h₂ : b < c) : a < c := - Int.lt_of_le_of_lt (Int.le_of_lt h₁) h₂ - -instance : Trans (α := Int) (· ≤ ·) (· ≤ ·) (· ≤ ·) := ⟨Int.le_trans⟩ - -instance : Trans (α := Int) (· < ·) (· ≤ ·) (· < ·) := ⟨Int.lt_of_lt_of_le⟩ - -instance : Trans (α := Int) (· ≤ ·) (· < ·) (· < ·) := ⟨Int.lt_of_le_of_lt⟩ - -instance : Trans (α := Int) (· < ·) (· < ·) (· < ·) := ⟨Int.lt_trans⟩ - -protected theorem min_def (n m : Int) : min n m = if n ≤ m then n else m := rfl - -protected theorem max_def (n m : Int) : max n m = if n ≤ m then m else n := rfl - -protected theorem min_comm (a b : Int) : min a b = min b a := by - simp [Int.min_def] - by_cases h₁ : a ≤ b <;> by_cases h₂ : b ≤ a <;> simp [h₁, h₂] - · exact Int.le_antisymm h₁ h₂ - · cases not_or_intro h₁ h₂ <| Int.le_total .. - -protected theorem min_le_right (a b : Int) : min a b ≤ b := by rw [Int.min_def]; split <;> simp [*] - -protected theorem min_le_left (a b : Int) : min a b ≤ a := Int.min_comm .. ▸ Int.min_le_right .. - -protected theorem le_min {a b c : Int} : a ≤ min b c ↔ a ≤ b ∧ a ≤ c := - ⟨fun h => ⟨Int.le_trans h (Int.min_le_left ..), Int.le_trans h (Int.min_le_right ..)⟩, - fun ⟨h₁, h₂⟩ => by rw [Int.min_def]; split <;> assumption⟩ - -protected theorem max_comm (a b : Int) : max a b = max b a := by - simp only [Int.max_def] - by_cases h₁ : a ≤ b <;> by_cases h₂ : b ≤ a <;> simp [h₁, h₂] - · exact Int.le_antisymm h₂ h₁ - · cases not_or_intro h₁ h₂ <| Int.le_total .. - -protected theorem le_max_left (a b : Int) : a ≤ max a b := by rw [Int.max_def]; split <;> simp [*] - -protected theorem le_max_right (a b : Int) : b ≤ max a b := Int.max_comm .. ▸ Int.le_max_left .. - -protected theorem max_le {a b c : Int} : max a b ≤ c ↔ a ≤ c ∧ b ≤ c := - ⟨fun h => ⟨Int.le_trans (Int.le_max_left ..) h, Int.le_trans (Int.le_max_right ..) h⟩, - fun ⟨h₁, h₂⟩ => by rw [Int.max_def]; split <;> assumption⟩ - -theorem eq_natAbs_of_zero_le {a : Int} (h : 0 ≤ a) : a = natAbs a := by - let ⟨n, e⟩ := eq_ofNat_of_zero_le h - rw [e]; rfl - -theorem le_natAbs {a : Int} : a ≤ natAbs a := - match Int.le_total 0 a with - | .inl h => by rw [eq_natAbs_of_zero_le h]; apply Int.le_refl - | .inr h => Int.le_trans h (ofNat_zero_le _) - -theorem negSucc_lt_zero (n : Nat) : -[n+1] < 0 := - Int.not_le.1 fun h => let ⟨_, h⟩ := eq_ofNat_of_zero_le h; nomatch h - -@[simp] theorem negSucc_not_nonneg (n : Nat) : 0 ≤ -[n+1] ↔ False := by - simp only [Int.not_le, iff_false]; exact Int.negSucc_lt_zero n - -protected theorem add_le_add_left {a b : Int} (h : a ≤ b) (c : Int) : c + a ≤ c + b := - let ⟨n, hn⟩ := le.dest h; le.intro n <| by rw [Int.add_assoc, hn] - -protected theorem add_lt_add_left {a b : Int} (h : a < b) (c : Int) : c + a < c + b := - Int.lt_iff_le_and_ne.2 ⟨Int.add_le_add_left (Int.le_of_lt h) _, fun heq => - b.lt_irrefl <| by rwa [Int.add_left_cancel heq] at h⟩ - -protected theorem add_le_add_right {a b : Int} (h : a ≤ b) (c : Int) : a + c ≤ b + c := - Int.add_comm c a ▸ Int.add_comm c b ▸ Int.add_le_add_left h c - -protected theorem add_lt_add_right {a b : Int} (h : a < b) (c : Int) : a + c < b + c := - Int.add_comm c a ▸ Int.add_comm c b ▸ Int.add_lt_add_left h c - -protected theorem le_of_add_le_add_left {a b c : Int} (h : a + b ≤ a + c) : b ≤ c := by - have : -a + (a + b) ≤ -a + (a + c) := Int.add_le_add_left h _ - simp [Int.neg_add_cancel_left] at this - assumption - -protected theorem le_of_add_le_add_right {a b c : Int} (h : a + b ≤ c + b) : a ≤ c := - Int.le_of_add_le_add_left (a := b) <| by rwa [Int.add_comm b a, Int.add_comm b c] - -protected theorem add_le_add_iff_left (a : Int) : a + b ≤ a + c ↔ b ≤ c := - ⟨Int.le_of_add_le_add_left, (Int.add_le_add_left · _)⟩ - -protected theorem add_le_add_iff_right (c : Int) : a + c ≤ b + c ↔ a ≤ b := - ⟨Int.le_of_add_le_add_right, (Int.add_le_add_right · _)⟩ - -protected theorem add_le_add {a b c d : Int} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d := - Int.le_trans (Int.add_le_add_right h₁ c) (Int.add_le_add_left h₂ b) - -protected theorem le_add_of_nonneg_right {a b : Int} (h : 0 ≤ b) : a ≤ a + b := by - have : a + b ≥ a + 0 := Int.add_le_add_left h a - rwa [Int.add_zero] at this - -protected theorem le_add_of_nonneg_left {a b : Int} (h : 0 ≤ b) : a ≤ b + a := by - have : 0 + a ≤ b + a := Int.add_le_add_right h a - rwa [Int.zero_add] at this - -protected theorem neg_le_neg {a b : Int} (h : a ≤ b) : -b ≤ -a := by - have : 0 ≤ -a + b := Int.add_left_neg a ▸ Int.add_le_add_left h (-a) - have : 0 + -b ≤ -a + b + -b := Int.add_le_add_right this (-b) - rwa [Int.add_neg_cancel_right, Int.zero_add] at this - -protected theorem le_of_neg_le_neg {a b : Int} (h : -b ≤ -a) : a ≤ b := - suffices - -a ≤ - -b by simp [Int.neg_neg] at this; assumption - Int.neg_le_neg h - -protected theorem neg_nonpos_of_nonneg {a : Int} (h : 0 ≤ a) : -a ≤ 0 := by - have : -a ≤ -0 := Int.neg_le_neg h - rwa [Int.neg_zero] at this - -protected theorem neg_nonneg_of_nonpos {a : Int} (h : a ≤ 0) : 0 ≤ -a := by - have : -0 ≤ -a := Int.neg_le_neg h - rwa [Int.neg_zero] at this - -protected theorem neg_lt_neg {a b : Int} (h : a < b) : -b < -a := by - have : 0 < -a + b := Int.add_left_neg a ▸ Int.add_lt_add_left h (-a) - have : 0 + -b < -a + b + -b := Int.add_lt_add_right this (-b) - rwa [Int.add_neg_cancel_right, Int.zero_add] at this - -protected theorem neg_neg_of_pos {a : Int} (h : 0 < a) : -a < 0 := by - have : -a < -0 := Int.neg_lt_neg h - rwa [Int.neg_zero] at this - -protected theorem neg_pos_of_neg {a : Int} (h : a < 0) : 0 < -a := by - have : -0 < -a := Int.neg_lt_neg h - rwa [Int.neg_zero] at this - -protected theorem sub_nonneg_of_le {a b : Int} (h : b ≤ a) : 0 ≤ a - b := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem le_of_sub_nonneg {a b : Int} (h : 0 ≤ a - b) : b ≤ a := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem sub_pos_of_lt {a b : Int} (h : b < a) : 0 < a - b := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem lt_of_sub_pos {a b : Int} (h : 0 < a - b) : b < a := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem sub_left_le_of_le_add {a b c : Int} (h : a ≤ b + c) : a - b ≤ c := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_comm b c, Int.add_neg_cancel_right] at h - -protected theorem sub_le_self (a : Int) {b : Int} (h : 0 ≤ b) : a - b ≤ a := - calc a + -b - _ ≤ a + 0 := Int.add_le_add_left (Int.neg_nonpos_of_nonneg h) _ - _ = a := by rw [Int.add_zero] - -protected theorem sub_lt_self (a : Int) {b : Int} (h : 0 < b) : a - b < a := - calc a + -b - _ < a + 0 := Int.add_lt_add_left (Int.neg_neg_of_pos h) _ - _ = a := by rw [Int.add_zero] - -theorem add_one_le_of_lt {a b : Int} (H : a < b) : a + 1 ≤ b := H - -/- ### Order properties and multiplication -/ - - -protected theorem mul_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b := by - let ⟨n, hn⟩ := eq_ofNat_of_zero_le ha - let ⟨m, hm⟩ := eq_ofNat_of_zero_le hb - rw [hn, hm, ← ofNat_mul]; apply ofNat_nonneg - -protected theorem mul_pos {a b : Int} (ha : 0 < a) (hb : 0 < b) : 0 < a * b := by - let ⟨n, hn⟩ := eq_succ_of_zero_lt ha - let ⟨m, hm⟩ := eq_succ_of_zero_lt hb - rw [hn, hm, ← ofNat_mul]; apply ofNat_succ_pos - -protected theorem mul_lt_mul_of_pos_left {a b c : Int} - (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b := by - have : 0 < c * (b - a) := Int.mul_pos h₂ (Int.sub_pos_of_lt h₁) - rw [Int.mul_sub] at this - exact Int.lt_of_sub_pos this - -protected theorem mul_lt_mul_of_pos_right {a b c : Int} - (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c := by - have : 0 < b - a := Int.sub_pos_of_lt h₁ - have : 0 < (b - a) * c := Int.mul_pos this h₂ - rw [Int.sub_mul] at this - exact Int.lt_of_sub_pos this - -protected theorem mul_le_mul_of_nonneg_left {a b c : Int} - (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := by - if hba : b ≤ a then rw [Int.le_antisymm hba h₁]; apply Int.le_refl else - if hc0 : c ≤ 0 then simp [Int.le_antisymm hc0 h₂, Int.zero_mul] else - exact Int.le_of_lt <| Int.mul_lt_mul_of_pos_left - (Int.lt_iff_le_not_le.2 ⟨h₁, hba⟩) (Int.lt_iff_le_not_le.2 ⟨h₂, hc0⟩) - -protected theorem mul_le_mul_of_nonneg_right {a b c : Int} - (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := by - rw [Int.mul_comm, Int.mul_comm b]; exact Int.mul_le_mul_of_nonneg_left h₁ h₂ - -protected theorem mul_le_mul {a b c d : Int} - (hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d := - Int.le_trans (Int.mul_le_mul_of_nonneg_right hac nn_b) (Int.mul_le_mul_of_nonneg_left hbd nn_c) - -protected theorem mul_nonpos_of_nonneg_of_nonpos {a b : Int} - (ha : 0 ≤ a) (hb : b ≤ 0) : a * b ≤ 0 := by - have h : a * b ≤ a * 0 := Int.mul_le_mul_of_nonneg_left hb ha - rwa [Int.mul_zero] at h - -protected theorem mul_nonpos_of_nonpos_of_nonneg {a b : Int} - (ha : a ≤ 0) (hb : 0 ≤ b) : a * b ≤ 0 := by - have h : a * b ≤ 0 * b := Int.mul_le_mul_of_nonneg_right ha hb - rwa [Int.zero_mul] at h - -protected theorem mul_le_mul_of_nonpos_right {a b c : Int} - (h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c := - have : -c ≥ 0 := Int.neg_nonneg_of_nonpos hc - have : b * -c ≤ a * -c := Int.mul_le_mul_of_nonneg_right h this - Int.le_of_neg_le_neg <| by rwa [← Int.neg_mul_eq_mul_neg, ← Int.neg_mul_eq_mul_neg] at this - -protected theorem mul_le_mul_of_nonpos_left {a b c : Int} - (ha : a ≤ 0) (h : c ≤ b) : a * b ≤ a * c := by - rw [Int.mul_comm a b, Int.mul_comm a c] - apply Int.mul_le_mul_of_nonpos_right h ha - -/- ## natAbs -/ - -@[simp] theorem natAbs_ofNat (n : Nat) : natAbs ↑n = n := rfl -@[simp] theorem natAbs_negSucc (n : Nat) : natAbs -[n+1] = n.succ := rfl -@[simp] theorem natAbs_zero : natAbs (0 : Int) = (0 : Nat) := rfl -@[simp] theorem natAbs_one : natAbs (1 : Int) = (1 : Nat) := rfl - -@[simp] theorem natAbs_eq_zero : natAbs a = 0 ↔ a = 0 := - ⟨fun H => match a with - | ofNat _ => congrArg ofNat H - | -[_+1] => absurd H (succ_ne_zero _), - fun e => e ▸ rfl⟩ - -theorem natAbs_pos : 0 < natAbs a ↔ a ≠ 0 := by rw [Nat.pos_iff_ne_zero, Ne, natAbs_eq_zero] - -@[simp] theorem natAbs_neg : ∀ (a : Int), natAbs (-a) = natAbs a - | 0 => rfl - | succ _ => rfl - | -[_+1] => rfl - -theorem natAbs_eq : ∀ (a : Int), a = natAbs a ∨ a = -↑(natAbs a) - | ofNat _ => Or.inl rfl - | -[_+1] => Or.inr rfl - -theorem natAbs_negOfNat (n : Nat) : natAbs (negOfNat n) = n := by - cases n <;> rfl - -theorem natAbs_mul (a b : Int) : natAbs (a * b) = natAbs a * natAbs b := by - cases a <;> cases b <;> - simp only [← Int.mul_def, Int.mul, natAbs_negOfNat] <;> simp only [natAbs] - -theorem natAbs_eq_natAbs_iff {a b : Int} : a.natAbs = b.natAbs ↔ a = b ∨ a = -b := by - constructor <;> intro h - · cases Int.natAbs_eq a with - | inl h₁ | inr h₁ => - cases Int.natAbs_eq b with - | inl h₂ | inr h₂ => rw [h₁, h₂]; simp [h] - · cases h with (subst a; try rfl) - | inr h => rw [Int.natAbs_neg] - -theorem natAbs_of_nonneg {a : Int} (H : 0 ≤ a) : (natAbs a : Int) = a := - match a, eq_ofNat_of_zero_le H with - | _, ⟨_, rfl⟩ => rfl - -theorem ofNat_natAbs_of_nonpos {a : Int} (H : a ≤ 0) : (natAbs a : Int) = -a := by - rw [← natAbs_neg, natAbs_of_nonneg (Int.neg_nonneg_of_nonpos H)] diff --git a/Std/Data/Int/Lemmas.lean b/Std/Data/Int/Lemmas.lean index 4ef4a5ee7f..a449fdb06f 100644 --- a/Std/Data/Int/Lemmas.lean +++ b/Std/Data/Int/Lemmas.lean @@ -1,7 +1,6 @@ -- This is a backwards compatibility shim, after `Std.Data.Int.Lemmas` was split into smaller files. -- Hopefully it can later be removed. -import Std.Data.Int.Basic import Std.Data.Int.Gcd import Std.Data.Int.Order import Std.Data.Int.DivMod diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 5288f7d454..8b3461e5d2 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -3,9 +3,6 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ -import Std.Data.Nat.Lemmas -import Std.Data.Int.Init.Order -import Std.Data.Option.Basic import Std.Tactic.Omega import Std.Data.Nat.Lemmas diff --git a/Std/Data/Rat/Basic.lean b/Std/Data/Rat/Basic.lean index 002855654f..3d689f8b27 100644 --- a/Std/Data/Rat/Basic.lean +++ b/Std/Data/Rat/Basic.lean @@ -87,6 +87,8 @@ namespace Rat /-- Embedding of `Int` in the rational numbers. -/ def ofInt (num : Int) : Rat := { num, reduced := Nat.coprime_one_right _ } +instance : NatCast Rat where + natCast n := ofInt n instance : IntCast Rat := ⟨ofInt⟩ instance : OfNat Rat n := ⟨n⟩ diff --git a/Std/Data/Rat/Lemmas.lean b/Std/Data/Rat/Lemmas.lean index 5950fe9fd3..61c1a2367a 100644 --- a/Std/Data/Rat/Lemmas.lean +++ b/Std/Data/Rat/Lemmas.lean @@ -3,8 +3,8 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Data.Int.Init.Lemmas import Std.Data.Rat.Basic +import Std.Tactic.NormCast.Ext import Std.Tactic.SeqFocus /-! # Additional lemmas about the Rational Numbers -/ diff --git a/Std/Tactic/NormCast.lean b/Std/Tactic/NormCast.lean index e79a0971a6..034c16497c 100644 --- a/Std/Tactic/NormCast.lean +++ b/Std/Tactic/NormCast.lean @@ -6,6 +6,7 @@ Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner import Lean.Elab.Tactic.Conv.Simp import Std.Lean.Meta.Simp import Std.Tactic.NormCast.Ext +import Std.Tactic.NormCast.Lemmas import Std.Classes.Cast /-! @@ -15,6 +16,23 @@ import Std.Classes.Cast open Lean Meta Simp open Std.Tactic.NormCast +namespace Int + +/- These will be attached to definitions once norm_cast is in core. -/ +attribute [norm_cast] Nat.cast_ofNat_Int +attribute [norm_cast] ofNat_add +attribute [norm_cast] ofNat_sub +attribute [norm_cast] ofNat_mul +attribute [norm_cast] ofNat_inj +attribute [norm_cast] ofNat_ediv +attribute [norm_cast] ofNat_emod +attribute [norm_cast] ofNat_dvd +attribute [norm_cast] ofNat_le +attribute [norm_cast] ofNat_lt +attribute [norm_cast] ofNat_pos + +end Int + namespace Std.Tactic.NormCast initialize registerTraceClass `Tactic.norm_cast diff --git a/Std/Tactic/Omega/Int.lean b/Std/Tactic/Omega/Int.lean index 15615fba7c..e27bebfeea 100644 --- a/Std/Tactic/Omega/Int.lean +++ b/Std/Tactic/Omega/Int.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Classes.Order -import Std.Data.Int.Init.Order +import Std.Tactic.Alias /-! # Lemmas about `Nat` and `Int` needed internally by `omega`. diff --git a/Std/Tactic/Omega/IntList.lean b/Std/Tactic/Omega/IntList.lean index b4392fe543..1dc4c9aeb4 100644 --- a/Std/Tactic/Omega/IntList.lean +++ b/Std/Tactic/Omega/IntList.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.List.Init.Lemmas -import Std.Data.Int.Init.DivMod import Std.Data.Option.Init.Lemmas import Std.Tactic.Simpa diff --git a/Std/Tactic/Omega/MinNatAbs.lean b/Std/Tactic/Omega/MinNatAbs.lean index 88621f0709..5ee858ff0b 100644 --- a/Std/Tactic/Omega/MinNatAbs.lean +++ b/Std/Tactic/Omega/MinNatAbs.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.List.Init.Lemmas -import Std.Data.Int.Init.Order import Std.Data.Option.Lemmas import Std.Tactic.Init diff --git a/test/int.lean b/test/int.lean index 3c948d4264..65397bfaca 100644 --- a/test/int.lean +++ b/test/int.lean @@ -1,4 +1,3 @@ -import Std.Data.Int.Basic -- complement #guard ~~~(-1:Int) = 0 From c21447fe5c07282aae34467f5cb421637756b122 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 16 Feb 2024 14:53:58 +1100 Subject: [PATCH 057/213] chore: adaptations for nightly-2024-02-15 (#652) Co-authored-by: Joe Hendrix --- Std.lean | 5 +- .../{LawfulMonad.lean => SatisfiesM.lean} | 62 -- Std/Classes/SetNotation.lean | 110 --- Std/Data/Array/Init/Lemmas.lean | 175 +--- Std/Data/Array/Lemmas.lean | 2 +- Std/Data/Array/Match.lean | 1 - Std/Data/Bool.lean | 2 + Std/Data/Fin.lean | 1 - Std/Data/Fin/Basic.lean | 1 - Std/Data/Fin/Init/Lemmas.lean | 7 - Std/Data/Fin/Iterate.lean | 1 - Std/Data/HashMap/Basic.lean | 1 + Std/Data/Int/DivMod.lean | 1 + Std/Data/Int/Init/DivMod.lean | 1 - Std/Data/Int/Init/Lemmas.lean | 1 - Std/Data/Int/Init/Order.lean | 1 + Std/Data/Int/Order.lean | 1 + Std/Data/List.lean | 1 - Std/Data/List/Basic.lean | 2 - Std/Data/List/Count.lean | 1 + Std/Data/List/Init/Basic.lean | 28 - Std/Data/List/Init/Lemmas.lean | 611 +------------- Std/Data/List/Lemmas.lean | 2 +- Std/Data/Nat.lean | 3 - Std/Data/Nat/Bitwise.lean | 6 +- Std/Data/Nat/Gcd.lean | 1 - Std/Data/Nat/Init/Dvd.lean | 95 --- Std/Data/Nat/Init/Gcd.lean | 42 - Std/Data/Nat/Init/Lemmas.lean | 298 ------- Std/Data/Nat/Lemmas.lean | 23 +- Std/Data/Option/Basic.lean | 1 - Std/Data/Option/Lemmas.lean | 1 - Std/Data/PairingHeap.lean | 1 - Std/Data/Prod.lean | 1 - Std/Data/Prod/Lex.lean | 32 - Std/Data/RBMap/Basic.lean | 3 +- Std/Data/RBMap/WF.lean | 1 - Std/Data/String/Lemmas.lean | 3 +- Std/Data/Sum/Basic.lean | 2 - Std/Data/UInt.lean | 1 - Std/Lean/HashSet.lean | 1 - Std/Lean/Meta/LazyDiscrTree.lean | 1 - Std/Lean/Position.lean | 2 - Std/Logic.lean | 793 +----------------- Std/Tactic/HaveI.lean | 63 -- Std/Tactic/Omega.lean | 1 - Std/Tactic/Omega/Int.lean | 1 - Std/Tactic/Omega/IntList.lean | 1 - Std/Tactic/Omega/Logic.lean | 3 +- Std/Tactic/Omega/MinNatAbs.lean | 1 + Std/Tactic/Omega/OmegaM.lean | 1 + Std/Tactic/PermuteGoals.lean | 1 + Std/Tactic/RunCmd.lean | 84 -- Std/Tactic/SolveByElim.lean | 2 +- Std/Tactic/SolveByElim/Backtrack.lean | 1 + Std/Util/ExtendedBinder.lean | 67 -- lean-toolchain | 2 +- scripts/nolints.json | 3 +- test.lean | 9 + test/isIndependentOf.lean | 1 + test/lintTC.lean | 1 - test/lintsimp.lean | 5 +- test/print_prefix.lean | 13 +- test/run_cmd.lean | 1 - 64 files changed, 58 insertions(+), 2532 deletions(-) rename Std/Classes/{LawfulMonad.lean => SatisfiesM.lean} (74%) delete mode 100644 Std/Data/Fin/Init/Lemmas.lean delete mode 100644 Std/Data/List/Init/Basic.lean delete mode 100644 Std/Data/Nat/Init/Dvd.lean delete mode 100644 Std/Data/Nat/Init/Gcd.lean delete mode 100644 Std/Data/Nat/Init/Lemmas.lean delete mode 100644 Std/Data/Prod.lean delete mode 100644 Std/Data/Prod/Lex.lean delete mode 100644 Std/Tactic/HaveI.lean delete mode 100644 Std/Tactic/RunCmd.lean create mode 100644 test.lean diff --git a/Std.lean b/Std.lean index 9756ff2841..95623d568c 100644 --- a/Std.lean +++ b/Std.lean @@ -1,8 +1,8 @@ import Std.Classes.BEq import Std.Classes.Cast -import Std.Classes.LawfulMonad import Std.Classes.Order import Std.Classes.RatCast +import Std.Classes.SatisfiesM import Std.Classes.SetNotation import Std.CodeAction import Std.CodeAction.Attr @@ -32,7 +32,6 @@ import Std.Data.Nat import Std.Data.Option import Std.Data.Ord import Std.Data.PairingHeap -import Std.Data.Prod import Std.Data.RBMap import Std.Data.Range import Std.Data.Rat @@ -89,7 +88,6 @@ import Std.Tactic.Ext import Std.Tactic.Ext.Attr import Std.Tactic.FalseOrByContra import Std.Tactic.GuardMsgs -import Std.Tactic.HaveI import Std.Tactic.Init import Std.Tactic.Instances import Std.Tactic.LabelAttr @@ -122,7 +120,6 @@ import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix import Std.Tactic.Relation.Rfl import Std.Tactic.Relation.Symm -import Std.Tactic.RunCmd import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm import Std.Tactic.SimpTrace diff --git a/Std/Classes/LawfulMonad.lean b/Std/Classes/SatisfiesM.lean similarity index 74% rename from Std/Classes/LawfulMonad.lean rename to Std/Classes/SatisfiesM.lean index fa45dd7988..0b596789ed 100644 --- a/Std/Classes/LawfulMonad.lean +++ b/Std/Classes/SatisfiesM.lean @@ -3,68 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Logic - -/-- -An alternative constructor for `LawfulMonad` which has more -defaultable fields in the common case. --/ -theorem LawfulMonad.mk' (m : Type u → Type v) [Monad m] - (id_map : ∀ {α} (x : m α), id <$> x = x) - (pure_bind : ∀ {α β} (x : α) (f : α → m β), pure x >>= f = f x) - (bind_assoc : ∀ {α β γ} (x : m α) (f : α → m β) (g : β → m γ), - x >>= f >>= g = x >>= fun x => f x >>= g) - (map_const : ∀ {α β} (x : α) (y : m β), - Functor.mapConst x y = Function.const β x <$> y := by intros; rfl) - (seqLeft_eq : ∀ {α β} (x : m α) (y : m β), - x <* y = (x >>= fun a => y >>= fun _ => pure a) := by intros; rfl) - (seqRight_eq : ∀ {α β} (x : m α) (y : m β), x *> y = (x >>= fun _ => y) := by intros; rfl) - (bind_pure_comp : ∀ {α β} (f : α → β) (x : m α), - x >>= (fun y => pure (f y)) = f <$> x := by intros; rfl) - (bind_map : ∀ {α β} (f : m (α → β)) (x : m α), f >>= (. <$> x) = f <*> x := by intros; rfl) - : LawfulMonad m := - have map_pure {α β} (g : α → β) (x : α) : g <$> (pure x : m α) = pure (g x) := by - rw [← bind_pure_comp]; simp [pure_bind] - { id_map, bind_pure_comp, bind_map, pure_bind, bind_assoc, map_pure, - comp_map := by simp [← bind_pure_comp, bind_assoc, pure_bind] - pure_seq := by intros; rw [← bind_map]; simp [pure_bind] - seq_pure := by intros; rw [← bind_map]; simp [map_pure, bind_pure_comp] - seq_assoc := by simp [← bind_pure_comp, ← bind_map, bind_assoc, pure_bind] - map_const := funext fun x => funext (map_const x) - seqLeft_eq := by simp [seqLeft_eq, ← bind_map, ← bind_pure_comp, pure_bind, bind_assoc] - seqRight_eq := fun x y => by - rw [seqRight_eq, ← bind_map, ← bind_pure_comp, bind_assoc]; simp [pure_bind, id_map] } - -instance : LawfulMonad (Except ε) := LawfulMonad.mk' - (id_map := fun x => by cases x <;> rfl) - (pure_bind := fun a f => rfl) - (bind_assoc := fun a f g => by cases a <;> rfl) - -instance : LawfulApplicative (Except ε) := inferInstance -instance : LawfulFunctor (Except ε) := inferInstance - -instance : LawfulMonad Option := LawfulMonad.mk' - (id_map := fun x => by cases x <;> rfl) - (pure_bind := fun x f => rfl) - (bind_assoc := fun x f g => by cases x <;> rfl) - (bind_pure_comp := fun f x => by cases x <;> rfl) - -instance : LawfulApplicative Option := inferInstance -instance : LawfulFunctor Option := inferInstance - -instance : LawfulMonad (EStateM ε σ) := .mk' - (id_map := fun x => funext <| fun s => by - dsimp only [EStateM.instMonadEStateM, EStateM.map] - match x s with - | .ok _ _ => rfl - | .error _ _ => rfl) - (pure_bind := fun _ _ => rfl) - (bind_assoc := fun x _ _ => funext <| fun s => by - dsimp only [EStateM.instMonadEStateM, EStateM.bind] - match x s with - | .ok _ _ => rfl - | .error _ _ => rfl) - (map_const := fun _ _ => rfl) /-! ## SatisfiesM diff --git a/Std/Classes/SetNotation.lean b/Std/Classes/SetNotation.lean index 7e46916cc9..977e1e3df3 100644 --- a/Std/Classes/SetNotation.lean +++ b/Std/Classes/SetNotation.lean @@ -3,109 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Util.ExtendedBinder - -/-- Notation type class for the subset relation `⊆`. -/ -class HasSubset (α : Type u) where - /-- Subset relation: `a ⊆ b` -/ - Subset : α → α → Prop -export HasSubset (Subset) - -/-- Subset relation: `a ⊆ b` -/ -infix:50 " ⊆ " => HasSubset.Subset - -/-- Notation type class for the strict subset relation `⊂`. -/ -class HasSSubset (α : Type u) where - /-- Strict subset relation: `a ⊂ b` -/ - SSubset : α → α → Prop -export HasSSubset (SSubset) - -/-- Strict subset relation: `a ⊂ b` -/ -infix:50 " ⊂ " => HasSSubset.SSubset - -/-- Superset relation: `a ⊇ b` -/ -abbrev Superset [HasSubset α] (a b : α) := b ⊆ a -/-- Superset relation: `a ⊇ b` -/ -infix:50 " ⊇ " => Superset - -/-- Strict superset relation: `a ⊃ b` -/ -abbrev SSuperset [HasSSubset α] (a b : α) := b ⊂ a -/-- Strict superset relation: `a ⊃ b` -/ -infix:50 " ⊃ " => SSuperset - -/-- Notation type class for the union operation `∪`. -/ -class Union (α : Type u) where - /-- `a ∪ b` is the union of`a` and `b`. -/ - union : α → α → α -/-- `a ∪ b` is the union of`a` and `b`. -/ -infixl:65 " ∪ " => Union.union - -/-- Notation type class for the intersection operation `∩`. -/ -class Inter (α : Type u) where - /-- `a ∩ b` is the intersection of`a` and `b`. -/ - inter : α → α → α -/-- `a ∩ b` is the intersection of`a` and `b`. -/ -infixl:70 " ∩ " => Inter.inter - -/-- Notation type class for the set difference `\`. -/ -class SDiff (α : Type u) where - /-- - `a \ b` is the set difference of `a` and `b`, - consisting of all elements in `a` that are not in `b`. - -/ - sdiff : α → α → α -/-- -`a \ b` is the set difference of `a` and `b`, -consisting of all elements in `a` that are not in `b`. --/ -infix:70 " \\ " => SDiff.sdiff - -/-- -Type class for the `insert` operation. -Used to implement the `{ a, b, c }` syntax. --/ -class Insert (α : outParam <| Type u) (γ : Type v) where - /-- `insert x xs` inserts the element `x` into the collection `xs`. -/ - insert : α → γ → γ -export Insert (insert) - -/-- -Type class for the `singleton` operation. -Used to implement the `{ a, b, c }` syntax. --/ -class Singleton (α : outParam <| Type u) (β : Type v) where - /-- `singleton x` is a collection with the single element `x` (notation: `{x}`). -/ - singleton : α → β -export Singleton (singleton) - -/-- Type class used to implement the notation `{ a ∈ c | p a }` -/ -class Sep (α : outParam <| Type u) (γ : Type v) where - /-- Computes `{ a ∈ c | p a }`. -/ - sep : (α → Prop) → γ → γ - -/-- Declare `∀ x ∈ y, ...` as syntax for `∀ x, x ∈ y → ...` and `∃ x ∈ y, ...` as syntax for -`∃ x, x ∈ y ∧ ...` -/ -binder_predicate x " ∈ " y:term => `($x ∈ $y) - -/-- Declare `∀ x ∉ y, ...` as syntax for `∀ x, x ∉ y → ...` and `∃ x ∉ y, ...` as syntax for -`∃ x, x ∉ y ∧ ...` -/ -binder_predicate x " ∉ " y:term => `($x ∉ $y) - -/-- Declare `∀ x ⊆ y, ...` as syntax for `∀ x, x ⊆ y → ...` and `∃ x ⊆ y, ...` as syntax for -`∃ x, x ⊆ y ∧ ...` -/ -binder_predicate x " ⊆ " y:term => `($x ⊆ $y) - -/-- Declare `∀ x ⊂ y, ...` as syntax for `∀ x, x ⊂ y → ...` and `∃ x ⊂ y, ...` as syntax for -`∃ x, x ⊂ y ∧ ...` -/ -binder_predicate x " ⊂ " y:term => `($x ⊂ $y) - -/-- Declare `∀ x ⊇ y, ...` as syntax for `∀ x, x ⊇ y → ...` and `∃ x ⊇ y, ...` as syntax for -`∃ x, x ⊇ y ∧ ...` -/ -binder_predicate x " ⊇ " y:term => `($x ⊇ $y) - -/-- Declare `∀ x ⊃ y, ...` as syntax for `∀ x, x ⊃ y → ...` and `∃ x ⊃ y, ...` as syntax for -`∃ x, x ⊃ y ∧ ...` -/ -binder_predicate x " ⊃ " y:term => `($x ⊃ $y) /-- `{ a, b, c }` is a set with elements `a`, `b`, and `c`. @@ -129,10 +26,3 @@ def singletonUnexpander : Lean.PrettyPrinter.Unexpander def insertUnexpander : Lean.PrettyPrinter.Unexpander | `($_ $a { $ts:term,* }) => `({$a:term, $ts,*}) | _ => throw () - -/-- `insert x ∅ = {x}` -/ -class IsLawfulSingleton (α : Type u) (β : Type v) [EmptyCollection β] [Insert α β] [Singleton α β] : - Prop where - /-- `insert x ∅ = {x}` -/ - insert_emptyc_eq (x : α) : (insert x ∅ : β) = {x} -export IsLawfulSingleton (insert_emptyc_eq) diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index 5833f80ea3..4fc2cbd60c 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -3,11 +3,9 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.HaveI -import Std.Classes.LawfulMonad -import Std.Data.Fin.Init.Lemmas -import Std.Data.Nat.Init.Lemmas +import Std.Data.Bool import Std.Data.List.Init.Lemmas +import Std.Classes.SatisfiesM /-! ## Bootstrapping theorems about arrays @@ -17,90 +15,6 @@ This file contains some theorems about `Array` and `List` needed for `Std.List.B namespace Array -attribute [simp] data_toArray uset - -@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl - -@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size] - -@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size] - -theorem getElem_eq_data_get (a : Array α) (h : i < a.size) : a[i] = a.data.get ⟨i, h⟩ := by - by_cases i < a.size <;> (try simp [*]) <;> rfl - -theorem foldlM_eq_foldlM_data.aux [Monad m] - (f : β → α → m β) (arr : Array α) (i j) (H : arr.size ≤ i + j) (b) : - foldlM.loop f arr arr.size (Nat.le_refl _) i j b = (arr.data.drop j).foldlM f b := by - unfold foldlM.loop - split; split - · cases Nat.not_le_of_gt ‹_› (Nat.zero_add _ ▸ H) - · rename_i i; rw [Nat.succ_add] at H - simp [foldlM_eq_foldlM_data.aux f arr i (j+1) H] - conv => rhs; rw [← List.get_drop_eq_drop _ _ ‹_›] - · rw [List.drop_length_le (Nat.ge_of_not_lt ‹_›)]; rfl - -theorem foldlM_eq_foldlM_data [Monad m] - (f : β → α → m β) (init : β) (arr : Array α) : - arr.foldlM f init = arr.data.foldlM f init := by - simp [foldlM, foldlM_eq_foldlM_data.aux] - -theorem foldl_eq_foldl_data (f : β → α → β) (init : β) (arr : Array α) : - arr.foldl f init = arr.data.foldl f init := - List.foldl_eq_foldlM .. ▸ foldlM_eq_foldlM_data .. - -theorem foldrM_eq_reverse_foldlM_data.aux [Monad m] - (f : α → β → m β) (arr : Array α) (init : β) (i h) : - (arr.data.take i).reverse.foldlM (fun x y => f y x) init = foldrM.fold f arr 0 i h init := by - unfold foldrM.fold - match i with - | 0 => simp [List.foldlM, List.take] - | i+1 => rw [← List.take_concat_get _ _ h]; simp [← (aux f arr · i)]; rfl - -theorem foldrM_eq_reverse_foldlM_data [Monad m] (f : α → β → m β) (init : β) (arr : Array α) : - arr.foldrM f init = arr.data.reverse.foldlM (fun x y => f y x) init := by - have : arr = #[] ∨ 0 < arr.size := - match arr with | ⟨[]⟩ => .inl rfl | ⟨a::l⟩ => .inr (Nat.zero_lt_succ _) - match arr, this with | _, .inl rfl => rfl | arr, .inr h => ?_ - simp [foldrM, h, ← foldrM_eq_reverse_foldlM_data.aux, List.take_length] - -theorem foldrM_eq_foldrM_data [Monad m] - (f : α → β → m β) (init : β) (arr : Array α) : - arr.foldrM f init = arr.data.foldrM f init := by - rw [foldrM_eq_reverse_foldlM_data, List.foldlM_reverse] - -theorem foldr_eq_foldr_data (f : α → β → β) (init : β) (arr : Array α) : - arr.foldr f init = arr.data.foldr f init := - List.foldr_eq_foldrM .. ▸ foldrM_eq_foldrM_data .. - -@[simp] theorem push_data (arr : Array α) (a : α) : (arr.push a).data = arr.data ++ [a] := by - simp [push, List.concat_eq_append] - -theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) : - (arr.push a).foldrM f init = f a init >>= arr.foldrM f := by - simp [foldrM_eq_reverse_foldlM_data, -size_push] - -@[simp] theorem foldrM_push' [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) : - (arr.push a).foldrM f init (start := arr.size + 1) = f a init >>= arr.foldrM f := by - simp [← foldrM_push] - -theorem foldr_push (f : α → β → β) (init : β) (arr : Array α) (a : α) : - (arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push .. - -@[simp] theorem foldr_push' (f : α → β → β) (init : β) (arr : Array α) (a : α) : - (arr.push a).foldr f init (start := arr.size + 1) = arr.foldr f (f a init) := foldrM_push' .. - -@[simp] theorem toListAppend_eq (arr : Array α) (l) : arr.toListAppend l = arr.data ++ l := by - simp [toListAppend, foldr_eq_foldr_data] - -@[simp] theorem toList_eq (arr : Array α) : arr.toList = arr.data := by - simp [toList, foldr_eq_foldr_data] - -/-- A more efficient version of `arr.toList.reverse`. -/ -@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) [] - -@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.data.reverse := by - rw [toListRev, foldl_eq_foldl_data, ← List.foldr_reverse, List.foldr_self] - theorem SatisfiesM_foldlM [Monad m] [LawfulMonad m] {as : Array α} (motive : Nat → β → Prop) {init : β} (h0 : motive 0 init) {f : β → α → m β} (hf : ∀ i : Fin as.size, ∀ b, motive i.1 b → SatisfiesM (motive (i.1 + 1)) (f b as[i])) : @@ -123,35 +37,6 @@ theorem foldl_induction simp [SatisfiesM_Id_eq] at this exact this hf -theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) : - haveI : 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_data_get, List.concat_eq_append, List.get_append_left, h] - -@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by - simp only [push, getElem_eq_data_get, List.concat_eq_append] - rw [List.get_append_right] <;> simp [getElem_eq_data_get, Nat.zero_lt_one] - -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 - if h' : i < a.size then - simp [get_push_lt, h'] - else - simp at h - simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')] - -theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α → m β) (arr : Array α) : - arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by - rw [mapM, aux, foldlM_eq_foldlM_data]; rfl -where - aux (i r) : - mapM.map f arr i r = (arr.data.drop i).foldlM (fun bs a => bs.push <$> f a) r := by - unfold mapM.map; split - · rw [← List.get_drop_eq_drop _ i ‹_›] - simp [aux (i+1), map_eq_pure_bind]; rfl - · rw [List.drop_length_le (Nat.ge_of_not_lt ‹_›)]; rfl - termination_by arr.size - i - theorem SatisfiesM_mapM [Monad m] [LawfulMonad m] (as : Array α) (f : α → m β) (motive : Nat → Prop) (h0 : motive 0) (p : Fin as.size → β → Prop) @@ -182,65 +67,12 @@ theorem size_mapM [Monad m] [LawfulMonad m] (f : α → m β) (as : Array α) : SatisfiesM (fun arr => arr.size = as.size) (Array.mapM f as) := (SatisfiesM_mapM' _ _ (fun _ _ => True) (fun _ => .trivial)).imp (·.1) -@[simp] theorem map_data (f : α → β) (arr : Array α) : (arr.map f).data = arr.data.map f := by - rw [map, mapM_eq_foldlM] - apply congrArg data (foldl_eq_foldl_data (fun bs a => push bs (f a)) #[] arr) |>.trans - have H (l arr) : List.foldl (fun bs a => push bs (f a)) arr l = ⟨arr.data ++ l.map f⟩ := by - induction l generalizing arr <;> simp [*] - simp [H] - -@[simp] theorem size_map (f : α → β) (arr : Array α) : (arr.map f).size = arr.size := by - simp [size] - @[simp] theorem getElem_map (f : α → β) (arr : Array α) (i : Nat) (h) : ((arr.map f)[i]'h) = f (arr[i]'(size_map .. ▸ h)) := by have := SatisfiesM_mapM' (m := Id) arr f (fun i b => b = f (arr[i])) simp [SatisfiesM_Id_eq] at this exact this.2 i (size_map .. ▸ h) -@[simp] theorem pop_data (arr : Array α) : arr.pop.data = arr.data.dropLast := rfl - -@[simp] theorem append_eq_append (arr arr' : Array α) : arr.append arr' = arr ++ arr' := rfl - -@[simp] theorem append_data (arr arr' : Array α) : - (arr ++ arr').data = arr.data ++ arr'.data := by - rw [← append_eq_append]; unfold Array.append - rw [foldl_eq_foldl_data] - induction arr'.data generalizing arr <;> simp [*] - -@[simp] theorem appendList_eq_append - (arr : Array α) (l : List α) : arr.appendList l = arr ++ l := rfl - -@[simp] theorem appendList_data (arr : Array α) (l : List α) : - (arr ++ l).data = arr.data ++ l := by - rw [← appendList_eq_append]; unfold Array.appendList - induction l generalizing arr <;> simp [*] - -@[simp] theorem appendList_nil (arr : Array α) : arr ++ ([] : List α) = arr := Array.ext' (by simp) - -@[simp] theorem appendList_cons (arr : Array α) (a : α) (l : List α) : - arr ++ (a :: l) = arr.push a ++ l := Array.ext' (by simp) - -theorem foldl_data_eq_bind (l : List α) (acc : Array β) - (F : Array β → α → Array β) (G : α → List β) - (H : ∀ acc a, (F acc a).data = acc.data ++ G a) : - (l.foldl F acc).data = acc.data ++ l.bind G := by - induction l generalizing acc <;> simp [*, List.bind] - -theorem foldl_data_eq_map (l : List α) (acc : Array β) (G : α → β) : - (l.foldl (fun acc a => acc.push (G a)) acc).data = acc.data ++ l.map G := by - induction l generalizing acc <;> simp [*] - -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 - -theorem anyM_stop_le_start [Monad m] (p : α → m Bool) (as : Array α) (start stop) - (h : min stop as.size ≤ start) : anyM p as start stop = pure false := by - rw [anyM_eq_anyM_loop, anyM.loop, dif_neg (Nat.not_lt.2 h)] - theorem SatisfiesM_anyM [Monad m] [LawfulMonad m] (p : α → m Bool) (as : Array α) (start stop) (hstart : start ≤ min stop as.size) (tru : Prop) (fal : Nat → Prop) (h0 : fal start) (hp : ∀ i : Fin as.size, i.1 < stop → fal i.1 → @@ -299,9 +131,6 @@ theorem any_iff_exists (p : α → Bool) (as : Array α) (start stop) : theorem any_eq_true (p : α → Bool) (as : Array α) : any as p ↔ ∃ i : Fin as.size, p as[i] := by simp [any_iff_exists, Fin.isLt] -theorem mem_def (a : α) (as : Array α) : a ∈ as ↔ a ∈ as.data := - ⟨fun | .mk h => h, Array.Mem.mk⟩ - theorem any_def {p : α → Bool} (as : Array α) : as.any p = as.data.any p := by rw [Bool.eq_iff_iff, any_eq_true, List.any_eq_true]; simp only [List.mem_iff_get] exact ⟨fun ⟨i, h⟩ => ⟨_, ⟨i, rfl⟩, h⟩, fun ⟨_, ⟨i, rfl⟩, h⟩ => ⟨i, h⟩⟩ diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 3d8d68f897..79a0cc6257 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -6,9 +6,9 @@ Authors: Mario Carneiro, Gabriel Ebner -/ import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas +import Std.Data.Array.Init.Lemmas import Std.Data.Array.Basic import Std.Tactic.SeqFocus -import Std.Tactic.HaveI import Std.Tactic.Simpa import Std.Util.ProofWanted diff --git a/Std/Data/Array/Match.lean b/Std/Data/Array/Match.lean index 5a2962d44a..282846f956 100644 --- a/Std/Data/Array/Match.lean +++ b/Std/Data/Array/Match.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: F. G. Dorais -/ import Std.Data.Nat.Lemmas -import Std.Data.Array.Init.Lemmas namespace Array diff --git a/Std/Data/Bool.lean b/Std/Data/Bool.lean index 26424373cb..eb463d5d76 100644 --- a/Std/Data/Bool.lean +++ b/Std/Data/Bool.lean @@ -46,6 +46,8 @@ theorem eq_false_iff : {b : Bool} → b = false ↔ b ≠ true := by decide theorem ne_false_iff : {b : Bool} → b ≠ false ↔ b = true := by decide +theorem eq_iff_iff {a b : Bool} : a = b ↔ (a ↔ b) := by cases b <;> simp + /-! ### and -/ @[simp] theorem not_and_self : ∀ (x : Bool), (!x && x) = false := by decide diff --git a/Std/Data/Fin.lean b/Std/Data/Fin.lean index bb8df44e80..0b79375e25 100644 --- a/Std/Data/Fin.lean +++ b/Std/Data/Fin.lean @@ -1,4 +1,3 @@ import Std.Data.Fin.Basic -import Std.Data.Fin.Init.Lemmas import Std.Data.Fin.Iterate import Std.Data.Fin.Lemmas diff --git a/Std/Data/Fin/Basic.lean b/Std/Data/Fin/Basic.lean index 109f92892f..b3f65ed516 100644 --- a/Std/Data/Fin/Basic.lean +++ b/Std/Data/Fin/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2017 Robert Y. Lewis. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Robert Y. Lewis, Keeley Hoek, Mario Carneiro -/ -import Std.Data.Nat.Init.Lemmas namespace Fin diff --git a/Std/Data/Fin/Init/Lemmas.lean b/Std/Data/Fin/Init/Lemmas.lean deleted file mode 100644 index a84047765e..0000000000 --- a/Std/Data/Fin/Init/Lemmas.lean +++ /dev/null @@ -1,7 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ - -@[simp] theorem Fin.zero_eta : (⟨0, Nat.zero_lt_succ _⟩ : Fin (n + 1)) = 0 := rfl diff --git a/Std/Data/Fin/Iterate.lean b/Std/Data/Fin/Iterate.lean index c21fdffd89..73a03a7998 100644 --- a/Std/Data/Fin/Iterate.lean +++ b/Std/Data/Fin/Iterate.lean @@ -4,7 +4,6 @@ institutional affiliations. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joe Hendrix -/ -import Std.Logic namespace Fin diff --git a/Std/Data/HashMap/Basic.lean b/Std/Data/HashMap/Basic.lean index 9635d17ce3..5a41196e0f 100644 --- a/Std/Data/HashMap/Basic.lean +++ b/Std/Data/HashMap/Basic.lean @@ -5,6 +5,7 @@ Authors: Leonardo de Moura, Mario Carneiro -/ import Std.Data.AssocList import Std.Data.Nat.Basic +import Std.Data.Array.Init.Lemmas import Std.Classes.BEq namespace Std.HashMap diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 9d710f2204..b14b0bc114 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -3,6 +3,7 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ +import Std.Data.Nat.Lemmas import Std.Data.Int.Order import Std.Data.Int.Init.DivMod diff --git a/Std/Data/Int/Init/DivMod.lean b/Std/Data/Int/Init/DivMod.lean index cf7c35e507..a0eeb55ae8 100644 --- a/Std/Data/Int/Init/DivMod.lean +++ b/Std/Data/Int/Init/DivMod.lean @@ -3,7 +3,6 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ -import Std.Data.Nat.Init.Dvd import Std.Data.Int.Init.Order /-! diff --git a/Std/Data/Int/Init/Lemmas.lean b/Std/Data/Int/Init/Lemmas.lean index 97ead4750d..8ea82a6871 100644 --- a/Std/Data/Int/Init/Lemmas.lean +++ b/Std/Data/Int/Init/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Classes.Cast -import Std.Data.Nat.Init.Lemmas import Std.Data.Int.Basic import Std.Tactic.NormCast.Lemmas diff --git a/Std/Data/Int/Init/Order.lean b/Std/Data/Int/Init/Order.lean index ff7c8ce21a..d2902119bb 100644 --- a/Std/Data/Int/Init/Order.lean +++ b/Std/Data/Int/Init/Order.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Data.Int.Init.Lemmas +import Std.Tactic.Alias /-! # Results about the order properties of the integers, and the integers as an ordered ring. diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index dcb9d335ff..5288f7d454 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -3,6 +3,7 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ +import Std.Data.Nat.Lemmas import Std.Data.Int.Init.Order import Std.Data.Option.Basic import Std.Tactic.Omega diff --git a/Std/Data/List.lean b/Std/Data/List.lean index 2c472a904d..137c762db9 100644 --- a/Std/Data/List.lean +++ b/Std/Data/List.lean @@ -1,7 +1,6 @@ import Std.Data.List.Basic import Std.Data.List.Count import Std.Data.List.Init.Attach -import Std.Data.List.Init.Basic import Std.Data.List.Init.Lemmas import Std.Data.List.Lemmas import Std.Data.List.Pairwise diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index bdab46df03..a60b09b962 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -3,9 +3,7 @@ Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ -import Std.Classes.SetNotation import Std.Data.Option.Init.Lemmas -import Std.Data.Array.Init.Lemmas namespace List diff --git a/Std/Data/List/Count.lean b/Std/Data/List/Count.lean index 005bf24721..5f966f1fb3 100644 --- a/Std/Data/List/Count.lean +++ b/Std/Data/List/Count.lean @@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M -/ import Std.Data.List.Basic import Std.Data.List.Lemmas +import Std.Data.List.Init.Lemmas /-! # Counting in lists diff --git a/Std/Data/List/Init/Basic.lean b/Std/Data/List/Init/Basic.lean deleted file mode 100644 index 7aa74a0a0c..0000000000 --- a/Std/Data/List/Init/Basic.lean +++ /dev/null @@ -1,28 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura --/ - -namespace List - -/-- -Version of `List.zipWith` that continues to the end of both lists, passing `none` to one argument -once the shorter list has run out. --/ --- TODO We should add a tail-recursive version as we do for other `zip` functions. -def zipWithAll (f : Option α → Option β → γ) : List α → List β → List γ - | [], bs => bs.map fun b => f none (some b) - | a :: as, [] => (a :: as).map fun a => f (some a) none - | a :: as, b :: bs => f a b :: zipWithAll f as bs - -@[simp] theorem zipWithAll_nil_right : - zipWithAll f as [] = as.map fun a => f (some a) none := by - cases as <;> rfl - -@[simp] theorem zipWithAll_nil_left : - zipWithAll f [] bs = bs.map fun b => f none (some b) := by - rw [zipWithAll] - -@[simp] theorem zipWithAll_cons_cons : - zipWithAll f (a :: as) (b :: bs) = f (some a) (some b) :: zipWithAll f as bs := rfl diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean index e651829492..76a8f1328b 100644 --- a/Std/Data/List/Init/Lemmas.lean +++ b/Std/Data/List/Init/Lemmas.lean @@ -3,10 +3,6 @@ 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 -/ -import Std.Classes.SetNotation -import Std.Data.Nat.Init.Lemmas -import Std.Data.List.Init.Basic -import Std.Logic namespace List @@ -19,614 +15,9 @@ These are theorems used in the definitions of `Std.Data.List.Basic` and tactics. New theorems should be added to `Std.Data.List.Lemmas` if they are not needed by the bootstrap. -/ -attribute [simp] concat_eq_append append_assoc - -@[simp] theorem get?_nil : @get? α [] n = none := rfl -@[simp] theorem get?_cons_zero : @get? α (a::l) 0 = some a := rfl -@[simp] theorem get?_cons_succ : @get? α (a::l) (n+1) = get? l n := rfl -@[simp] theorem get_cons_zero : get (a::l) (0 : Fin (l.length + 1)) = a := rfl -@[simp] theorem head?_nil : @head? α [] = none := rfl -@[simp] theorem head?_cons : @head? α (a::l) = some a := rfl -@[simp 1100] theorem headD_nil : @headD α [] d = d := rfl -@[simp 1100] theorem headD_cons : @headD α (a::l) d = a := rfl -@[simp] theorem head_cons : @head α (a::l) h = a := rfl -@[simp] theorem tail?_nil : @tail? α [] = none := rfl -@[simp] theorem tail?_cons : @tail? α (a::l) = some l := rfl -@[simp] theorem tail!_cons : @tail! α (a::l) = l := rfl -@[simp 1100] theorem tailD_nil : @tailD α [] l' = l' := rfl -@[simp 1100] theorem tailD_cons : @tailD α (a::l) l' = l := rfl -@[simp] theorem any_nil : [].any f = false := rfl -@[simp] theorem any_cons : (a::l).any f = (f a || l.any f) := rfl -@[simp] theorem all_nil : [].all f = true := rfl -@[simp] theorem all_cons : (a::l).all f = (f a && l.all f) := rfl -@[simp] theorem or_nil : [].or = false := rfl -@[simp] theorem or_cons : (a::l).or = (a || l.or) := rfl -@[simp] theorem and_nil : [].and = true := rfl -@[simp] theorem and_cons : (a::l).and = (a && l.and) := rfl - -/-! ### length -/ - -theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl - -theorem ne_nil_of_length_eq_succ (_ : length l = succ n) : l ≠ [] := fun _ => nomatch l - -theorem length_eq_zero : length l = 0 ↔ l = [] := - ⟨eq_nil_of_length_eq_zero, fun h => h ▸ rfl⟩ - -/-! ### mem -/ - -@[simp] theorem not_mem_nil (a : α) : ¬ a ∈ [] := nofun - -@[simp] theorem mem_cons : a ∈ (b :: l) ↔ a = b ∨ a ∈ l := - ⟨fun h => by cases h <;> simp [Membership.mem, *], - fun | Or.inl rfl => by constructor | Or.inr h => by constructor; assumption⟩ - -theorem mem_cons_self (a : α) (l : List α) : a ∈ a :: l := .head .. - -theorem mem_cons_of_mem (y : α) {a : α} {l : List α} : a ∈ l → a ∈ y :: l := .tail _ - -theorem eq_nil_iff_forall_not_mem {l : List α} : l = [] ↔ ∀ a, a ∉ l := by - cases l <;> simp - -/-! ### append -/ - -@[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl - -theorem append_inj : - ∀ {s₁ s₂ t₁ t₂ : List α}, s₁ ++ t₁ = s₂ ++ t₂ → length s₁ = length s₂ → s₁ = s₂ ∧ t₁ = t₂ - | [], [], t₁, t₂, h, _ => ⟨rfl, h⟩ - | a :: s₁, b :: s₂, t₁, t₂, h, hl => by - simp [append_inj (cons.inj h).2 (Nat.succ.inj hl)] at h ⊢; exact h - -theorem append_inj_right (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : t₁ = t₂ := - (append_inj h hl).right - -theorem append_inj_left (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : s₁ = s₂ := - (append_inj h hl).left - -theorem append_inj' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ ∧ t₁ = t₂ := - append_inj h <| @Nat.add_right_cancel _ (length t₁) _ <| by - let hap := congrArg length h; simp only [length_append, ← hl] at hap; exact hap - -theorem append_inj_right' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : t₁ = t₂ := - (append_inj' h hl).right - -theorem append_inj_left' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ := - (append_inj' h hl).left - -theorem append_right_inj {t₁ t₂ : List α} (s) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ := - ⟨fun h => append_inj_right h rfl, congrArg _⟩ - -theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ := - ⟨fun h => append_inj_left' h rfl, congrArg (· ++ _)⟩ - -@[simp] theorem append_eq_nil : p ++ q = [] ↔ p = [] ∧ q = [] := by - cases p <;> simp - -/-! ### map -/ - -@[simp] theorem map_nil {f : α → β} : map f [] = [] := rfl - -@[simp] theorem map_cons (f : α → β) a l : map f (a :: l) = f a :: map f l := rfl - -@[simp] theorem map_append (f : α → β) : ∀ l₁ l₂, map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by - intro l₁; induction l₁ <;> intros <;> simp_all - -@[simp] theorem map_id (l : List α) : map id l = l := by induction l <;> simp_all - -@[simp] theorem map_id' (l : List α) : map (fun a => a) l = l := by induction l <;> simp_all - -@[simp] theorem mem_map {f : α → β} : ∀ {l : List α}, b ∈ l.map f ↔ ∃ a, a ∈ l ∧ f a = b - | [] => by simp - | _ :: l => by simp [mem_map (l := l), eq_comm (a := b)] - -theorem mem_map_of_mem (f : α → β) (h : a ∈ l) : f a ∈ map f l := mem_map.2 ⟨_, h, rfl⟩ - -@[simp] theorem map_map (g : β → γ) (f : α → β) (l : List α) : - map g (map f l) = map (g ∘ f) l := by induction l <;> simp_all - -/-! ### bind -/ - -@[simp] theorem nil_bind (f : α → List β) : List.bind [] f = [] := by simp [join, List.bind] - -@[simp] theorem cons_bind x xs (f : α → List β) : - List.bind (x :: xs) f = f x ++ List.bind xs f := by simp [join, List.bind] - -@[simp] theorem append_bind xs ys (f : α → List β) : - List.bind (xs ++ ys) f = List.bind xs f ++ List.bind ys f := by - induction xs; {rfl}; simp_all [cons_bind, append_assoc] - -@[simp] theorem bind_id (l : List (List α)) : List.bind l id = l.join := by simp [List.bind] - -/-! ### join -/ - -@[simp] theorem join_nil : List.join ([] : List (List α)) = [] := rfl - -@[simp] theorem join_cons : (l :: ls).join = l ++ ls.join := rfl - -/-! ### bounded quantifiers over Lists -/ - -theorem forall_mem_cons {p : α → Prop} {a : α} {l : List α} : - (∀ x, x ∈ a :: l → p x) ↔ p a ∧ ∀ x, x ∈ l → p x := - ⟨fun H => ⟨H _ (.head ..), fun _ h => H _ (.tail _ h)⟩, - fun ⟨H₁, H₂⟩ _ => fun | .head .. => H₁ | .tail _ h => H₂ _ h⟩ - -/-! ### reverse -/ - -@[simp] theorem reverseAux_nil : reverseAux [] r = r := rfl -@[simp] theorem reverseAux_cons : reverseAux (a::l) r = reverseAux l (a::r) := rfl - -theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs := - reverseAux_eq_append .. - -theorem reverse_map (f : α → β) (l : List α) : (l.map f).reverse = l.reverse.map f := by - induction l <;> simp [*] - -@[simp] theorem reverse_eq_nil_iff {xs : List α} : xs.reverse = [] ↔ xs = [] := by - match xs with - | [] => simp - | x :: xs => simp - -/-! ### nth element -/ - -theorem get_of_mem : ∀ {a} {l : List α}, a ∈ l → ∃ n, get l n = a - | _, _ :: _, .head .. => ⟨⟨0, Nat.succ_pos _⟩, rfl⟩ - | _, _ :: _, .tail _ m => let ⟨⟨n, h⟩, e⟩ := get_of_mem m; ⟨⟨n+1, Nat.succ_lt_succ h⟩, e⟩ - -theorem get_mem : ∀ (l : List α) n h, get l ⟨n, h⟩ ∈ l - | _ :: _, 0, _ => .head .. - | _ :: l, _+1, _ => .tail _ (get_mem l ..) - -theorem mem_iff_get {a} {l : List α} : a ∈ l ↔ ∃ n, get l n = a := - ⟨get_of_mem, fun ⟨_, e⟩ => e ▸ get_mem ..⟩ - -theorem get?_len_le : ∀ {l : List α} {n}, length l ≤ n → l.get? n = none - | [], _, _ => rfl - | _ :: l, _+1, h => get?_len_le (l := l) <| Nat.le_of_succ_le_succ h - -theorem get?_eq_get : ∀ {l : List α} {n} (h : n < l.length), l.get? n = some (get l ⟨n, h⟩) - | _ :: _, 0, _ => rfl - | _ :: l, _+1, _ => get?_eq_get (l := l) _ - -theorem get?_eq_some : l.get? n = some a ↔ ∃ h, get l ⟨n, h⟩ = a := - ⟨fun e => - have : n < length l := Nat.gt_of_not_le fun hn => by cases get?_len_le hn ▸ e - ⟨this, by rwa [get?_eq_get this, Option.some.injEq] at e⟩, - fun ⟨h, e⟩ => e ▸ get?_eq_get _⟩ - -@[simp] theorem get?_eq_none : l.get? n = none ↔ length l ≤ n := - ⟨fun e => Nat.ge_of_not_lt (fun h' => by cases e ▸ get?_eq_some.2 ⟨h', rfl⟩), get?_len_le⟩ - -@[simp] theorem get?_map (f : α → β) : ∀ l n, (map f l).get? n = (l.get? n).map f - | [], _ => rfl - | _ :: _, 0 => rfl - | _ :: l, n+1 => get?_map f l n - -@[simp] theorem get?_concat_length : ∀ (l : List α) (a : α), (l ++ [a]).get? l.length = some a - | [], a => rfl - | b :: l, a => by rw [cons_append, length_cons]; simp only [get?, get?_concat_length] - -theorem getLast_eq_get : ∀ (l : List α) (h : l ≠ []), - getLast l h = l.get ⟨l.length - 1, by - match l with - | [] => contradiction - | a :: l => exact Nat.le_refl _⟩ - | [a], h => rfl - | a :: b :: l, h => by - simp [getLast, get, Nat.succ_sub_succ, getLast_eq_get] - -@[simp] theorem getLast?_nil : @getLast? α [] = none := rfl - -theorem getLast?_eq_getLast : ∀ l h, @getLast? α l = some (getLast l h) - | [], h => nomatch h rfl - | _::_, _ => rfl - -theorem getLast?_eq_get? : ∀ (l : List α), getLast? l = l.get? (l.length - 1) - | [] => rfl - | a::l => by rw [getLast?_eq_getLast (a::l) nofun, getLast_eq_get, get?_eq_get] - -@[simp] theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by - simp [getLast?_eq_get?, Nat.succ_sub_succ] - -/-! ### take and drop -/ - -@[simp] theorem take_append_drop : ∀ (n : Nat) (l : List α), take n l ++ drop n l = l - | 0, _ => rfl - | _+1, [] => rfl - | n+1, x :: xs => congrArg (cons x) <| take_append_drop n xs - -@[simp] theorem length_drop : ∀ (i : Nat) (l : List α), length (drop i l) = length l - i - | 0, _ => rfl - | succ i, [] => Eq.symm (Nat.zero_sub (succ i)) - | succ i, x :: l => calc - length (drop (succ i) (x :: l)) = length l - i := length_drop i l - _ = succ (length l) - succ i := (Nat.succ_sub_succ_eq_sub (length l) i).symm - -theorem drop_length_le {l : List α} (h : l.length ≤ i) : drop i l = [] := - length_eq_zero.1 (length_drop .. ▸ Nat.sub_eq_zero_of_le h) - -theorem take_length_le {l : List α} (h : l.length ≤ i) : take i l = l := by - have := take_append_drop i l - rw [drop_length_le h, append_nil] at this; exact this - -@[simp] theorem take_zero (l : List α) : l.take 0 = [] := rfl - -@[simp] theorem take_nil : ([] : List α).take i = [] := by cases i <;> rfl - -@[simp] theorem take_cons_succ : (a::as).take (i+1) = a :: as.take i := rfl - -@[simp] theorem drop_zero (l : List α) : l.drop 0 = l := rfl - -@[simp] theorem drop_succ_cons : (a :: l).drop (n + 1) = l.drop n := rfl - -@[simp] theorem drop_length (l : List α) : drop l.length l = [] := drop_length_le (Nat.le_refl _) - -@[simp] theorem take_length (l : List α) : take l.length l = l := take_length_le (Nat.le_refl _) - -theorem take_concat_get (l : List α) (i : Nat) (h : i < l.length) : - (l.take i).concat l[i] = l.take (i+1) := - Eq.symm <| (append_left_inj _).1 <| (take_append_drop (i+1) l).trans <| by - rw [concat_eq_append, append_assoc, singleton_append, get_drop_eq_drop, take_append_drop] - -theorem reverse_concat (l : List α) (a : α) : (l.concat a).reverse = a :: l.reverse := by - rw [concat_eq_append, reverse_append]; rfl - -/-! ### takeWhile and dropWhile -/ - -@[simp] theorem dropWhile_nil : ([] : List α).dropWhile p = [] := rfl - -theorem dropWhile_cons : - (x :: xs : List α).dropWhile p = if p x then xs.dropWhile p else x :: xs := by - split <;> simp_all [dropWhile] - -/-! ### foldlM and foldrM -/ - -@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β → α → m β) (b) : - l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl - -@[simp] theorem foldlM_nil [Monad m] (f : β → α → m β) (b) : [].foldlM f b = pure b := rfl - -@[simp] theorem foldlM_cons [Monad m] (f : β → α → m β) (b) (a) (l : List α) : - (a :: l).foldlM f b = f b a >>= l.foldlM f := by - simp [List.foldlM] - -@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : List α) : - (l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by - induction l generalizing b <;> simp [*] - -@[simp] theorem foldrM_nil [Monad m] (f : α → β → m β) (b) : [].foldrM f b = pure b := rfl - -@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α → β → m β) (b) : - (a :: l).foldrM f b = l.foldrM f b >>= f a := by - simp only [foldrM] - induction l <;> simp_all - -@[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α → β → m β) (b) : - l.reverse.foldrM f b = l.foldlM (fun x y => f y x) b := - (foldlM_reverse ..).symm.trans <| by simp - -theorem foldl_eq_foldlM (f : β → α → β) (b) (l : List α) : - l.foldl f b = l.foldlM (m := Id) f b := by - induction l generalizing b <;> simp [*, foldl] - -theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) : - l.foldr f b = l.foldrM (m := Id) f b := by - induction l <;> simp [*, foldr] - -/-! ### foldl and foldr -/ - -@[simp] theorem foldl_reverse (l : List α) (f : β → α → β) (b) : - l.reverse.foldl f b = l.foldr (fun x y => f y x) b := by simp [foldl_eq_foldlM, foldr_eq_foldrM] - -@[simp] theorem foldr_reverse (l : List α) (f : α → β → β) (b) : - l.reverse.foldr f b = l.foldl (fun x y => f y x) b := - (foldl_reverse ..).symm.trans <| by simp - -@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α → β → m β) (b) (l l' : List α) : - (l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by - induction l <;> simp [*] - -@[simp] theorem foldl_append {β : Type _} (f : β → α → β) (b) (l l' : List α) : - (l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM] - -@[simp] theorem foldr_append (f : α → β → β) (b) (l l' : List α) : - (l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM] - -@[simp] theorem foldl_nil : [].foldl f b = b := rfl - -@[simp] theorem foldl_cons (l : List α) (b : β) : (a :: l).foldl f b = l.foldl f (f b a) := rfl - -@[simp] theorem foldr_nil : [].foldr f b = b := rfl - -@[simp] theorem foldr_cons (l : List α) : (a :: l).foldr f b = f a (l.foldr f b) := rfl - -@[simp] theorem foldr_self_append (l : List α) : l.foldr cons l' = l ++ l' := by - induction l <;> simp [*] - -theorem foldr_self (l : List α) : l.foldr cons [] = l := by simp - -/-! ### mapM -/ - -/-- Alternate (non-tail-recursive) form of mapM for proofs. -/ -def mapM' [Monad m] (f : α → m β) : List α → m (List β) - | [] => pure [] - | a :: l => return (← f a) :: (← l.mapM' f) - -@[simp] theorem mapM'_nil [Monad m] {f : α → m β} : mapM' f [] = pure [] := rfl -@[simp] theorem mapM'_cons [Monad m] {f : α → m β} : - mapM' f (a :: l) = return ((← f a) :: (← l.mapM' f)) := - rfl - -theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α) : - mapM' f l = mapM f l := by simp [go, mapM] where - go : ∀ l acc, mapM.loop f l acc = return acc.reverse ++ (← mapM' f l) - | [], acc => by simp [mapM.loop, mapM'] - | a::l, acc => by simp [go l, mapM.loop, mapM'] - -@[simp] theorem mapM_nil [Monad m] (f : α → m β) : [].mapM f = pure [] := rfl - -@[simp] theorem mapM_cons [Monad m] [LawfulMonad m] (f : α → m β) : - (a :: l).mapM f = (return (← f a) :: (← l.mapM f)) := by simp [← mapM'_eq_mapM, mapM'] - -@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α → m β) {l₁ l₂ : List α} : - (l₁ ++ l₂).mapM f = (return (← l₁.mapM f) ++ (← l₂.mapM f)) := by induction l₁ <;> simp [*] - -/-! ### forM -/ - --- We use `List.forM` as the simp normal form, rather that `ForM.forM`. --- As such we need to replace `List.forM_nil` and `List.forM_cons` from Lean: - -@[simp] theorem forM_nil' [Monad m] : ([] : List α).forM f = (pure .unit : m PUnit) := rfl - -@[simp] theorem forM_cons' [Monad m] : - (a::as).forM f = (f a >>= fun _ => as.forM f : m PUnit) := - List.forM_cons _ _ _ - -/-! ### eraseIdx -/ - -@[simp] theorem eraseIdx_nil : ([] : List α).eraseIdx i = [] := rfl -@[simp] theorem eraseIdx_cons_zero : (a::as).eraseIdx 0 = as := rfl -@[simp] theorem eraseIdx_cons_succ : (a::as).eraseIdx (i+1) = a :: as.eraseIdx i := rfl - -/-! ### find? -/ - -@[simp] theorem find?_nil : ([] : List α).find? p = none := rfl -theorem find?_cons : (a::as).find? p = match p a with | true => some a | false => as.find? p := - rfl - -/-! ### filter -/ - -@[simp] theorem filter_nil (p : α → Bool) : filter p [] = [] := rfl - -@[simp] theorem filter_cons_of_pos {p : α → Bool} {a : α} (l) (pa : p a) : - filter p (a :: l) = a :: filter p l := by rw [filter, pa] - -@[simp] theorem filter_cons_of_neg {p : α → Bool} {a : α} (l) (pa : ¬ p a) : - filter p (a :: l) = filter p l := by rw [filter, eq_false_of_ne_true pa] - -theorem filter_cons : - (x :: xs : List α).filter p = if p x then x :: (xs.filter p) else xs.filter p := by - split <;> simp [*] - -theorem mem_filter : x ∈ filter p as ↔ x ∈ as ∧ p x := by - induction as with - | nil => simp [filter] - | cons a as ih => - by_cases h : p a <;> simp [*, or_and_right] - · exact or_congr_left (and_iff_left_of_imp fun | rfl => h).symm - · exact (or_iff_right fun ⟨rfl, h'⟩ => h h').symm - -theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a ∈ l, ¬p a := by +theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a, a ∈ l → ¬p a := by simp only [eq_nil_iff_forall_not_mem, mem_filter, not_and] -/-! ### findSome? -/ - -@[simp] theorem findSome?_nil : ([] : List α).findSome? f = none := rfl -theorem findSome?_cons {f : α → Option β} : - (a::as).findSome? f = match f a with | some b => some b | none => as.findSome? f := - rfl - -/-! ### replace -/ - -@[simp] theorem replace_nil [BEq α] : ([] : List α).replace a b = [] := rfl -theorem replace_cons [BEq α] {a : α} : - (a::as).replace b c = match a == b with | true => c::as | false => a :: replace as b c := - rfl -@[simp] theorem replace_cons_self [BEq α] [LawfulBEq α] {a : α} : (a::as).replace a b = b::as := by - simp [replace_cons] - -/-! ### elem -/ - -@[simp] theorem elem_nil [BEq α] : ([] : List α).elem a = false := rfl -theorem elem_cons [BEq α] {a : α} : - (a::as).elem b = match b == a with | true => true | false => as.elem b := - rfl -@[simp] theorem elem_cons_self [BEq α] [LawfulBEq α] {a : α} : (a::as).elem a = true := by - simp [elem_cons] - -/-! ### lookup -/ - -@[simp] theorem lookup_nil [BEq α] : ([] : List (α × β)).lookup a = none := rfl -theorem lookup_cons [BEq α] {k : α} : - ((k,b)::es).lookup a = match a == k with | true => some b | false => es.lookup a := - rfl -@[simp] theorem lookup_cons_self [BEq α] [LawfulBEq α] {k : α} : ((k,b)::es).lookup k = some b := by - simp [lookup_cons] - -/-! ### zipWith -/ - -@[simp] theorem zipWith_nil_left {f : α → β → γ} : zipWith f [] l = [] := by - rfl - -@[simp] theorem zipWith_nil_right {f : α → β → γ} : zipWith f l [] = [] := by - simp [zipWith] - -@[simp] theorem zipWith_cons_cons {f : α → β → γ} : - zipWith f (a :: as) (b :: bs) = f a b :: zipWith f as bs := by - rfl - -theorem zipWith_get? {f : α → β → γ} : - (List.zipWith f as bs).get? i = match as.get? i, bs.get? i with - | some a, some b => some (f a b) | _, _ => none := by - induction as generalizing bs i with - | nil => cases bs with - | nil => simp - | cons b bs => simp - | cons a as aih => cases bs with - | nil => simp - | cons b bs => cases i <;> simp_all - -/-! ### zipWithAll -/ - -theorem zipWithAll_get? {f : Option α → Option β → γ} : - (zipWithAll f as bs).get? i = match as.get? i, bs.get? i with - | none, none => .none | a?, b? => some (f a? b?) := by - induction as generalizing bs i with - | nil => induction bs generalizing i with - | nil => simp - | cons b bs bih => cases i <;> simp_all - | cons a as aih => cases bs with - | nil => - specialize @aih [] - cases i <;> simp_all - | cons b bs => cases i <;> simp_all - -/-! ### zip -/ - -@[simp] theorem zip_nil_left : zip ([] : List α) (l : List β) = [] := by - rfl - -@[simp] theorem zip_nil_right : zip (l : List α) ([] : List β) = [] := by - simp [zip] - -@[simp] theorem zip_cons_cons : zip (a :: as) (b :: bs) = (a, b) :: zip as bs := by - rfl - -/-! ### unzip -/ - -@[simp] theorem unzip_nil : ([] : List (α × β)).unzip = ([], []) := rfl -@[simp] theorem unzip_cons {h : α × β} : - (h :: t).unzip = match unzip t with | (al, bl) => (h.1::al, h.2::bl) := rfl - -/-! ### all / any -/ - -@[simp] theorem all_eq_true {l : List α} : l.all p ↔ ∀ x ∈ l, p x := by induction l <;> simp [*] - -@[simp] theorem any_eq_true {l : List α} : l.any p ↔ ∃ x ∈ l, p x := by induction l <;> simp [*] - -/-! ### enumFrom -/ - -@[simp] theorem enumFrom_nil : ([] : List α).enumFrom i = [] := rfl -@[simp] theorem enumFrom_cons : (a::as).enumFrom i = (i, a) :: as.enumFrom (i+1) := rfl - -/-! ### iota -/ - -@[simp] theorem iota_zero : iota 0 = [] := rfl -@[simp] theorem iota_succ : iota (i+1) = (i+1) :: iota i := rfl - -/-! ### intersperse -/ - -@[simp] theorem intersperse_nil (sep : α) : ([] : List α).intersperse sep = [] := rfl -@[simp] theorem intersperse_single (sep : α) : [x].intersperse sep = [x] := rfl -@[simp] theorem intersperse_cons₂ (sep : α) : - (x::y::zs).intersperse sep = x::sep::((y::zs).intersperse sep) := rfl - -/-! ### isPrefixOf -/ - -@[simp] theorem isPrefixOf_nil_left [BEq α] : isPrefixOf ([] : List α) l = true := by - simp [isPrefixOf] -@[simp] theorem isPrefixOf_cons_nil [BEq α] : isPrefixOf (a::as) ([] : List α) = false := rfl -theorem isPrefixOf_cons₂ [BEq α] {a : α} : - isPrefixOf (a::as) (b::bs) = (a == b && isPrefixOf as bs) := rfl -@[simp] theorem isPrefixOf_cons₂_self [BEq α] [LawfulBEq α] {a : α} : - isPrefixOf (a::as) (a::bs) = isPrefixOf as bs := by simp [isPrefixOf_cons₂] - -/-! ### isEqv -/ - -@[simp] theorem isEqv_nil_nil : isEqv ([] : List α) [] eqv = true := rfl -@[simp] theorem isEqv_nil_cons : isEqv ([] : List α) (a::as) eqv = false := rfl -@[simp] theorem isEqv_cons_nil : isEqv (a::as : List α) [] eqv = false := rfl -theorem isEqv_cons₂ : isEqv (a::as) (b::bs) eqv = (eqv a b && isEqv as bs eqv) := rfl - -/-! ### dropLast -/ - -@[simp] theorem dropLast_nil : ([] : List α).dropLast = [] := rfl -@[simp] theorem dropLast_single : [x].dropLast = [] := rfl -@[simp] theorem dropLast_cons₂ : - (x::y::zs).dropLast = x :: (y::zs).dropLast := rfl - --- We may want to replace these `simp` attributes with explicit equational lemmas, --- as we already have for all the non-monadic functions. -attribute [simp] mapA forA filterAuxM firstM anyM allM findM? findSomeM? - --- Previously `range.loop`, `mapM.loop`, `filterMapM.loop`, `forIn.loop`, `forIn'.loop` --- had attribute `@[simp]`. --- We don't currently provide simp lemmas, --- as this is an internal implementation and they don't seem to be needed. - -/-! ### minimum? -/ - -@[simp] theorem minimum?_nil [Min α] : ([] : List α).minimum? = none := rfl - --- We don't put `@[simp]` on `minimum?_cons`, --- because the definition in terms of `foldl` is not useful for proofs. -theorem minimum?_cons [Min α] {xs : List α} : (x :: xs).minimum? = foldl min x xs := rfl - -@[simp] theorem minimum?_eq_none_iff {xs : List α} [Min α] : xs.minimum? = none ↔ xs = [] := by - cases xs <;> simp [minimum?] - -theorem minimum?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b) : - {xs : List α} → xs.minimum? = some a → a ∈ xs := by - intro xs - match xs with - | nil => simp - | x :: xs => - simp only [minimum?_cons, Option.some.injEq, List.mem_cons] - intro eq - induction xs generalizing x with - | nil => - simp at eq - simp [eq] - | cons y xs ind => - simp at eq - have p := ind _ eq - cases p with - | inl p => - cases min_eq_or x y with | _ q => simp [p, q] - | inr p => simp [p, mem_cons] - -theorem le_minimum?_iff [Min α] [LE α] - (le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) : - {xs : List α} → xs.minimum? = some a → ∀ x, x ≤ a ↔ ∀ b ∈ xs, x ≤ b - | nil => by simp - | cons x xs => by - rw [minimum?] - intro eq y - simp only [Option.some.injEq] at eq - induction xs generalizing x with - | nil => - simp at eq - simp [eq] - | cons z xs ih => - simp at eq - simp [ih _ eq, le_min_iff, and_assoc] - --- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `min_eq_or`, --- and `le_min_iff`. -theorem minimum?_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 α} : - xs.minimum? = some a ↔ a ∈ xs ∧ ∀ b ∈ xs, a ≤ b := by - refine ⟨fun h => ⟨minimum?_mem min_eq_or h, (le_minimum?_iff le_min_iff h _).1 (le_refl _)⟩, ?_⟩ - intro ⟨h₁, h₂⟩ - cases xs with - | nil => simp at h₁ - | cons x xs => - exact congrArg some <| anti.1 - ((le_minimum?_iff le_min_iff (xs := x::xs) rfl _).1 (le_refl _) _ h₁) - (h₂ _ (minimum?_mem min_eq_or (xs := x::xs) rfl)) - -- A specialization of `minimum?_eq_some_iff` to Nat. theorem minimum?_eq_some_iff' {xs : List Nat} : xs.minimum? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, a ≤ b) := diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 106b3f4841..ad71e8e001 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -953,7 +953,7 @@ theorem get?_modifyNth (f : α → α) : | n+1, a :: l, m+1 => (get?_modifyNth f n l m).trans <| by cases l.get? m <;> by_cases h : n = m <;> - simp only [h, if_pos, if_true, if_false, Option.map, mt Nat.succ.inj, not_false_iff] + simp only [h, if_pos, if_neg, Option.map, mt Nat.succ.inj, not_false_iff] theorem modifyNthTail_length (f : List α → List α) (H : ∀ l, length (f l) = length l) : ∀ n l, length (modifyNthTail f n l) = length l diff --git a/Std/Data/Nat.lean b/Std/Data/Nat.lean index 959a5fe27d..6fd2edd7ca 100644 --- a/Std/Data/Nat.lean +++ b/Std/Data/Nat.lean @@ -2,7 +2,4 @@ import Std.Data.Nat.Basic import Std.Data.Nat.Bitwise import Std.Data.Nat.Gcd import Std.Data.Nat.Init.Basic -import Std.Data.Nat.Init.Dvd -import Std.Data.Nat.Init.Gcd -import Std.Data.Nat.Init.Lemmas import Std.Data.Nat.Lemmas diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean index 22924c8450..dc6324c2df 100644 --- a/Std/Data/Nat/Bitwise.lean +++ b/Std/Data/Nat/Bitwise.lean @@ -363,13 +363,13 @@ theorem bitwise_lt_two_pow (left : x < 2^n) (right : y < 2^n) : (Nat.bitwise f x | succ n hyp => unfold bitwise if x_zero : x = 0 then - simp only [x_zero, if_true] + simp only [x_zero, if_pos] by_cases p : f false true = true <;> simp [p, right] else if y_zero : y = 0 then - simp only [x_zero, y_zero, if_false, if_true] + simp only [x_zero, y_zero, if_neg, if_pos] by_cases p : f true false = true <;> simp [p, left] else - simp only [x_zero, y_zero, if_false] + simp only [x_zero, y_zero, if_neg] have hyp1 := hyp (div_two_le_of_lt_two left) (div_two_le_of_lt_two right) by_cases p : f (decide (x % 2 = 1)) (decide (y % 2 = 1)) = true <;> simp [p, pow_succ, mul_succ, Nat.add_assoc] diff --git a/Std/Data/Nat/Gcd.lean b/Std/Data/Nat/Gcd.lean index a2a91694e1..27842c51ad 100644 --- a/Std/Data/Nat/Gcd.lean +++ b/Std/Data/Nat/Gcd.lean @@ -3,7 +3,6 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro -/ -import Std.Data.Nat.Init.Gcd import Std.Data.Nat.Lemmas /-! diff --git a/Std/Data/Nat/Init/Dvd.lean b/Std/Data/Nat/Init/Dvd.lean deleted file mode 100644 index 0950a6541c..0000000000 --- a/Std/Data/Nat/Init/Dvd.lean +++ /dev/null @@ -1,95 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro --/ -import Std.Data.Nat.Init.Basic -import Std.Data.Nat.Init.Lemmas - -namespace Nat - -protected theorem dvd_refl (a : Nat) : a ∣ a := ⟨1, by simp⟩ - -protected theorem dvd_zero (a : Nat) : a ∣ 0 := ⟨0, by simp⟩ - -protected theorem dvd_mul_left (a b : Nat) : a ∣ b * a := ⟨b, Nat.mul_comm b a⟩ - -protected theorem dvd_mul_right (a b : Nat) : a ∣ a * b := ⟨b, rfl⟩ - -protected theorem dvd_trans {a b c : Nat} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c := - match h₁, h₂ with - | ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ => - ⟨d * e, show c = a * (d * e) by simp[h₃,h₄, Nat.mul_assoc]⟩ - -protected theorem eq_zero_of_zero_dvd {a : Nat} (h : 0 ∣ a) : a = 0 := - let ⟨c, H'⟩ := h; H'.trans c.zero_mul - -@[simp] protected theorem zero_dvd {n : Nat} : 0 ∣ n ↔ n = 0 := - ⟨Nat.eq_zero_of_zero_dvd, fun h => h.symm ▸ Nat.dvd_zero 0⟩ - -protected theorem dvd_add {a b c : Nat} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := - let ⟨d, hd⟩ := h₁; let ⟨e, he⟩ := h₂; ⟨d + e, by simp [Nat.left_distrib, hd, he]⟩ - -protected theorem dvd_add_iff_right {k m n : Nat} (h : k ∣ m) : k ∣ n ↔ k ∣ m + n := - ⟨Nat.dvd_add h, - match m, h with - | _, ⟨d, rfl⟩ => fun ⟨e, he⟩ => - ⟨e - d, by rw [Nat.mul_sub_left_distrib, ← he, Nat.add_sub_cancel_left]⟩⟩ - -protected theorem dvd_add_iff_left {k m n : Nat} (h : k ∣ n) : k ∣ m ↔ k ∣ m + n := by - rw [Nat.add_comm]; exact Nat.dvd_add_iff_right h - -theorem dvd_mod_iff {k m n : Nat} (h: k ∣ n) : k ∣ m % n ↔ k ∣ m := - have := Nat.dvd_add_iff_left <| Nat.dvd_trans h <| Nat.dvd_mul_right n (m / n) - by rwa [mod_add_div] at this - -theorem le_of_dvd {m n : Nat} (h : 0 < n) : m ∣ n → m ≤ n - | ⟨k, e⟩ => by - revert h - rw [e] - match k with - | 0 => intro hn; simp at hn - | pk+1 => - intro - have := Nat.mul_le_mul_left m (succ_pos pk) - rwa [Nat.mul_one] at this - -protected theorem dvd_antisymm : ∀ {m n : Nat}, m ∣ n → n ∣ m → m = n - | _, 0, _, h₂ => Nat.eq_zero_of_zero_dvd h₂ - | 0, _, h₁, _ => (Nat.eq_zero_of_zero_dvd h₁).symm - | _+1, _+1, h₁, h₂ => Nat.le_antisymm (le_of_dvd (succ_pos _) h₁) (le_of_dvd (succ_pos _) h₂) - -theorem pos_of_dvd_of_pos {m n : Nat} (H1 : m ∣ n) (H2 : 0 < n) : 0 < m := - Nat.pos_of_ne_zero fun m0 => Nat.ne_of_gt H2 <| Nat.eq_zero_of_zero_dvd (m0 ▸ H1) - -@[simp] protected theorem one_dvd (n : Nat) : 1 ∣ n := ⟨n, n.one_mul.symm⟩ - -theorem eq_one_of_dvd_one {n : Nat} (H : n ∣ 1) : n = 1 := Nat.dvd_antisymm H n.one_dvd - -theorem mod_eq_zero_of_dvd {m n : Nat} (H : m ∣ n) : n % m = 0 := by - let ⟨z, H⟩ := H; rw [H, mul_mod_right] - -theorem dvd_of_mod_eq_zero {m n : Nat} (H : n % m = 0) : m ∣ n := by - exists n / m - have := (mod_add_div n m).symm - rwa [H, Nat.zero_add] at this - -theorem dvd_iff_mod_eq_zero (m n : Nat) : m ∣ n ↔ n % m = 0 := - ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ - -instance decidable_dvd : @DecidableRel Nat (·∣·) := - fun _ _ => decidable_of_decidable_of_iff (dvd_iff_mod_eq_zero _ _).symm - -theorem emod_pos_of_not_dvd {a b : Nat} (h : ¬ a ∣ b) : 0 < b % a := by - rw [dvd_iff_mod_eq_zero] at h - exact Nat.pos_of_ne_zero h - - -protected theorem mul_div_cancel' {n m : Nat} (H : n ∣ m) : n * (m / n) = m := by - have := mod_add_div m n - rwa [mod_eq_zero_of_dvd H, Nat.zero_add] at this - -protected theorem div_mul_cancel {n m : Nat} (H : n ∣ m) : m / n * n = m := by - rw [Nat.mul_comm, Nat.mul_div_cancel' H] - -end Nat diff --git a/Std/Data/Nat/Init/Gcd.lean b/Std/Data/Nat/Init/Gcd.lean deleted file mode 100644 index a43d5cf293..0000000000 --- a/Std/Data/Nat/Init/Gcd.lean +++ /dev/null @@ -1,42 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro --/ -import Std.Data.Nat.Init.Basic -import Std.Data.Nat.Init.Dvd - -namespace Nat - -theorem gcd_rec (m n : Nat) : gcd m n = gcd (n % m) m := - match m with - | 0 => by have := (mod_zero n).symm; rwa [gcd_zero_right] - | _ + 1 => by simp [gcd_succ] - -@[elab_as_elim] theorem gcd.induction {P : Nat → Nat → Prop} (m n : Nat) - (H0 : ∀n, P 0 n) (H1 : ∀ m n, 0 < m → P (n % m) m → P m n) : P m n := - Nat.strongInductionOn (motive := fun m => ∀ n, P m n) m - (fun - | 0, _ => H0 - | _+1, IH => fun _ => H1 _ _ (succ_pos _) (IH _ (mod_lt _ (succ_pos _)) _) ) - n - -theorem gcd_dvd (m n : Nat) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) := by - induction m, n using gcd.induction with - | H0 n => rw [gcd_zero_left]; exact ⟨Nat.dvd_zero n, Nat.dvd_refl n⟩ - | H1 m n _ IH => rw [← gcd_rec] at IH; exact ⟨IH.2, (dvd_mod_iff IH.2).1 IH.1⟩ - -theorem gcd_dvd_left (m n : Nat) : gcd m n ∣ m := (gcd_dvd m n).left - -theorem gcd_dvd_right (m n : Nat) : gcd m n ∣ n := (gcd_dvd m n).right - -theorem gcd_le_left (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h <| gcd_dvd_left m n - -theorem gcd_le_right (n) (h : 0 < n) : gcd m n ≤ n := le_of_dvd h <| gcd_dvd_right m n - -theorem dvd_gcd : k ∣ m → k ∣ n → k ∣ gcd m n := by - induction m, n using gcd.induction with intro km kn - | H0 n => rw [gcd_zero_left]; exact kn - | H1 n m _ IH => rw [gcd_rec]; exact IH ((dvd_mod_iff km).2 kn) km - -end Nat diff --git a/Std/Data/Nat/Init/Lemmas.lean b/Std/Data/Nat/Init/Lemmas.lean deleted file mode 100644 index 8399dd6e8d..0000000000 --- a/Std/Data/Nat/Init/Lemmas.lean +++ /dev/null @@ -1,298 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro --/ -import Std.Logic - -namespace Nat - -/-! ### le/lt -/ - -theorem ne_of_gt {a b : Nat} (h : b < a) : a ≠ b := (ne_of_lt h).symm - -protected theorem pos_of_ne_zero {n : Nat} : n ≠ 0 → 0 < n := (eq_zero_or_pos n).resolve_left - -@[simp] protected theorem not_le {a b : Nat} : ¬ a ≤ b ↔ b < a := - ⟨Nat.gt_of_not_le, Nat.not_le_of_gt⟩ - -protected alias ⟨lt_of_not_ge, _⟩ := Nat.not_le -protected alias ⟨lt_of_not_le, not_le_of_lt⟩ := Nat.not_le -protected alias ⟨_, lt_le_asymm⟩ := Nat.not_le - -@[simp] protected theorem not_lt {a b : Nat} : ¬ a < b ↔ b ≤ a := - ⟨Nat.ge_of_not_lt, flip Nat.not_le_of_gt⟩ - -protected alias ⟨le_of_not_gt, not_lt_of_ge⟩ := Nat.not_lt -protected alias ⟨le_of_not_lt, not_lt_of_le⟩ := Nat.not_lt -protected alias ⟨_, le_lt_asymm⟩ := Nat.not_lt - -alias ne_of_lt' := ne_of_gt - -protected theorem le_of_not_le {a b : Nat} (h : ¬ b ≤ a) : a ≤ b := Nat.le_of_lt (Nat.not_le.1 h) -protected alias le_of_not_ge := Nat.le_of_not_le - -protected theorem le_antisymm_iff {a b : Nat} : a = b ↔ a ≤ b ∧ b ≤ a := - ⟨fun | rfl => ⟨Nat.le_refl _, Nat.le_refl _⟩, fun ⟨hle, hge⟩ => Nat.le_antisymm hle hge⟩ -protected alias eq_iff_le_and_ge := Nat.le_antisymm_iff - -protected theorem lt_or_gt_of_ne {a b : Nat} : a ≠ b → a < b ∨ b < a := by - rw [← Nat.not_le, ← Nat.not_le, ← Decidable.not_and_iff_or_not_not, and_comm] - exact mt Nat.le_antisymm_iff.2 -protected alias lt_or_lt_of_ne := Nat.lt_or_gt_of_ne -@[deprecated] protected alias lt_connex := Nat.lt_or_gt_of_ne - - - -/-! ## zero/one/two -/ - -protected theorem pos_iff_ne_zero : 0 < n ↔ n ≠ 0 := ⟨ne_of_gt, Nat.pos_of_ne_zero⟩ - -/-! ### succ/pred -/ - -theorem succ_pred_eq_of_pos : ∀ {n}, 0 < n → succ (pred n) = n - | _+1, _ => rfl - -theorem exists_eq_succ_of_ne_zero : ∀ {n}, n ≠ 0 → ∃ k, n = succ k - | _+1, _ => ⟨_, rfl⟩ - -/-! ### add -/ - -protected theorem add_le_add_iff_right {n : Nat} : m + n ≤ k + n ↔ m ≤ k := - ⟨Nat.le_of_add_le_add_right, fun h => Nat.add_le_add_right h _⟩ - -theorem eq_zero_of_add_eq_zero : ∀ {n m}, n + m = 0 → n = 0 ∧ m = 0 - | 0, 0, _ => ⟨rfl, rfl⟩ - | _+1, 0, h => Nat.noConfusion h - -protected theorem eq_zero_of_add_eq_zero_left (h : n + m = 0) : m = 0 := - (Nat.eq_zero_of_add_eq_zero h).2 - -/-! ### sub -/ - -attribute [simp] Nat.zero_sub Nat.add_sub_cancel succ_sub_succ_eq_sub - -theorem succ_sub {m n : Nat} (h : n ≤ m) : succ m - n = succ (m - n) := by - let ⟨k, hk⟩ := Nat.le.dest h - rw [← hk, Nat.add_sub_cancel_left, ← add_succ, Nat.add_sub_cancel_left] - -protected theorem sub_pos_of_lt (h : m < n) : 0 < n - m := - Nat.pos_iff_ne_zero.2 (Nat.sub_ne_zero_of_lt h) - -protected theorem sub_le_sub_left (h : n ≤ m) (k : Nat) : k - m ≤ k - n := - match m, le.dest h with - | _, ⟨a, rfl⟩ => by rw [← Nat.sub_sub]; apply sub_le - -protected theorem sub_le_sub_right {n m : Nat} (h : n ≤ m) : ∀ k, n - k ≤ m - k - | 0 => h - | z+1 => pred_le_pred (Nat.sub_le_sub_right h z) - -protected theorem lt_of_sub_ne_zero (h : n - m ≠ 0) : m < n := - Nat.not_le.1 (mt Nat.sub_eq_zero_of_le h) - -protected theorem sub_ne_zero_iff_lt : n - m ≠ 0 ↔ m < n := - ⟨Nat.lt_of_sub_ne_zero, Nat.sub_ne_zero_of_lt⟩ - -protected theorem lt_of_sub_pos (h : 0 < n - m) : m < n := - Nat.lt_of_sub_ne_zero (Nat.pos_iff_ne_zero.1 h) - -protected theorem lt_of_sub_eq_succ (h : m - n = succ l) : n < m := - Nat.lt_of_sub_pos (h ▸ Nat.zero_lt_succ _) - -protected theorem sub_lt_left_of_lt_add {n k m : Nat} (H : n ≤ k) (h : k < n + m) : k - n < m := by - have := Nat.sub_le_sub_right (succ_le_of_lt h) n - rwa [Nat.add_sub_cancel_left, Nat.succ_sub H] at this - -protected theorem sub_lt_right_of_lt_add {n k m : Nat} (H : n ≤ k) (h : k < m + n) : k - n < m := - Nat.sub_lt_left_of_lt_add H (Nat.add_comm .. ▸ h) - -protected theorem le_of_sub_eq_zero : ∀ {n m}, n - m = 0 → n ≤ m - | 0, _, _ => Nat.zero_le .. - | _+1, _+1, h => Nat.succ_le_succ <| Nat.le_of_sub_eq_zero (Nat.succ_sub_succ .. ▸ h) - -protected theorem le_of_sub_le_sub_right : ∀ {n m k : Nat}, k ≤ m → n - k ≤ m - k → n ≤ m - | 0, _, _, _, _ => Nat.zero_le .. - | _+1, _, 0, _, h₁ => h₁ - | _+1, _+1, _+1, h₀, h₁ => by - simp only [Nat.succ_sub_succ] at h₁ - exact succ_le_succ <| Nat.le_of_sub_le_sub_right (le_of_succ_le_succ h₀) h₁ - -protected theorem sub_le_sub_iff_right {n : Nat} (h : k ≤ m) : n - k ≤ m - k ↔ n ≤ m := - ⟨Nat.le_of_sub_le_sub_right h, fun h => Nat.sub_le_sub_right h _⟩ - -protected theorem sub_eq_iff_eq_add {c : Nat} (h : b ≤ a) : a - b = c ↔ a = c + b := - ⟨fun | rfl => by rw [Nat.sub_add_cancel h], fun heq => by rw [heq, Nat.add_sub_cancel]⟩ - -protected theorem sub_eq_iff_eq_add' {c : Nat} (h : b ≤ a) : a - b = c ↔ a = b + c := by - rw [Nat.add_comm, Nat.sub_eq_iff_eq_add h] - -/-! ### min/max -/ - -protected theorem min_eq_min (a : Nat) : Nat.min a b = min a b := rfl - -protected theorem max_eq_max (a : Nat) : Nat.max a b = max a b := rfl - -protected theorem min_comm (a b : Nat) : min a b = min b a := by - simp [Nat.min_def]; split <;> split <;> try simp [*] - · next h₁ h₂ => exact Nat.le_antisymm h₁ h₂ - · next h₁ h₂ => cases not_or_intro h₁ h₂ <| Nat.le_total .. - -protected theorem min_le_right (a b : Nat) : min a b ≤ b := by rw [Nat.min_def]; split <;> simp [*] - -protected theorem min_le_left (a b : Nat) : min a b ≤ a := Nat.min_comm .. ▸ Nat.min_le_right .. - -protected theorem min_eq_left {a b : Nat} (h : a ≤ b) : min a b = a := if_pos h - -protected theorem min_eq_right {a b : Nat} (h : b ≤ a) : min a b = b := by - rw [Nat.min_comm]; exact Nat.min_eq_left h - -protected theorem max_comm (a b : Nat) : max a b = max b a := by - simp only [Nat.max_def] - by_cases h₁ : a ≤ b <;> by_cases h₂ : b ≤ a <;> simp [h₁, h₂] - · exact Nat.le_antisymm h₂ h₁ - · cases not_or_intro h₁ h₂ <| Nat.le_total .. - -protected theorem le_max_left (a b : Nat) : a ≤ max a b := by rw [Nat.max_def]; split <;> simp [*] - -protected theorem le_max_right (a b : Nat) : b ≤ max a b := Nat.max_comm .. ▸ Nat.le_max_left .. - -protected theorem le_min_of_le_of_le {a b c : Nat} : a ≤ b → a ≤ c → a ≤ min b c := by - intros; cases Nat.le_total b c with - | inl h => rw [Nat.min_eq_left h]; assumption - | inr h => rw [Nat.min_eq_right h]; assumption - -protected theorem le_min {a b c : Nat} : a ≤ min b c ↔ a ≤ b ∧ a ≤ c := - ⟨fun h => ⟨Nat.le_trans h (Nat.min_le_left ..), Nat.le_trans h (Nat.min_le_right ..)⟩, - fun ⟨h₁, h₂⟩ => Nat.le_min_of_le_of_le h₁ h₂⟩ - -protected theorem lt_min {a b c : Nat} : a < min b c ↔ a < b ∧ a < c := Nat.le_min - -/-! ### div/mod -/ - -theorem div_eq_sub_div (h₁ : 0 < b) (h₂ : b ≤ a) : a / b = (a - b) / b + 1 := by - rw [div_eq a, if_pos]; constructor <;> assumption - - -theorem mod_add_div (m k : Nat) : m % k + k * (m / k) = m := by - induction m, k using mod.inductionOn with rw [div_eq, mod_eq] - | base x y h => simp [h] - | ind x y h IH => simp [h]; rw [Nat.mul_succ, ← Nat.add_assoc, IH, Nat.sub_add_cancel h.2] - -@[simp] protected theorem div_one (n : Nat) : n / 1 = n := by - have := mod_add_div n 1 - rwa [mod_one, Nat.zero_add, Nat.one_mul] at this - -@[simp] protected theorem div_zero (n : Nat) : n / 0 = 0 := by - rw [div_eq]; simp [Nat.lt_irrefl] - -@[simp] protected theorem zero_div (b : Nat) : 0 / b = 0 := - (div_eq 0 b).trans <| if_neg <| And.rec Nat.not_le_of_gt - -theorem le_div_iff_mul_le (k0 : 0 < k) : x ≤ y / k ↔ x * k ≤ y := by - induction y, k using mod.inductionOn generalizing x with - (rw [div_eq]; simp [h]; cases x with | zero => simp [zero_le] | succ x => ?_) - | base y k h => - simp [not_succ_le_zero x, succ_mul, Nat.add_comm] - refine Nat.lt_of_lt_of_le ?_ (Nat.le_add_right ..) - exact Nat.not_le.1 fun h' => h ⟨k0, h'⟩ - | ind y k h IH => - rw [← add_one, Nat.add_le_add_iff_right, IH k0, succ_mul, - ← Nat.add_sub_cancel (x*k) k, Nat.sub_le_sub_iff_right h.2, Nat.add_sub_cancel] - -theorem div_mul_le_self : ∀ (m n : Nat), m / n * n ≤ m - | m, 0 => by simp - | m, n+1 => (le_div_iff_mul_le (Nat.succ_pos _)).1 (Nat.le_refl _) - -theorem div_lt_iff_lt_mul (Hk : 0 < k) : x / k < y ↔ x < y * k := by - rw [← Nat.not_le, ← Nat.not_le]; exact not_congr (le_div_iff_mul_le Hk) - -@[simp] theorem add_div_right (x : Nat) {z : Nat} (H : 0 < z) : (x + z) / z = succ (x / z) := by - rw [div_eq_sub_div H (Nat.le_add_left _ _), Nat.add_sub_cancel] - -@[simp] theorem add_div_left (x : Nat) {z : Nat} (H : 0 < z) : (z + x) / z = succ (x / z) := by - rw [Nat.add_comm, add_div_right x H] - -theorem add_mul_div_left (x z : Nat) {y : Nat} (H : 0 < y) : (x + y * z) / y = x / y + z := by - induction z with - | zero => rw [Nat.mul_zero, Nat.add_zero, Nat.add_zero] - | succ z ih => rw [mul_succ, ← Nat.add_assoc, add_div_right _ H, ih]; rfl - -theorem add_mul_div_right (x y : Nat) {z : Nat} (H : 0 < z) : (x + y * z) / z = x / z + y := by - rw [Nat.mul_comm, add_mul_div_left _ _ H] - -@[simp] theorem add_mod_right (x z : Nat) : (x + z) % z = x % z := by - rw [mod_eq_sub_mod (Nat.le_add_left ..), Nat.add_sub_cancel] - -@[simp] theorem add_mod_left (x z : Nat) : (x + z) % x = z % x := by - rw [Nat.add_comm, add_mod_right] - -@[simp] theorem add_mul_mod_self_left (x y z : Nat) : (x + y * z) % y = x % y := by - match z with - | 0 => rw [Nat.mul_zero, Nat.add_zero] - | succ z => rw [mul_succ, ← Nat.add_assoc, add_mod_right, add_mul_mod_self_left (z := z)] - -@[simp] theorem add_mul_mod_self_right (x y z : Nat) : (x + y * z) % z = x % z := by - rw [Nat.mul_comm, add_mul_mod_self_left] - -@[simp] theorem mul_mod_right (m n : Nat) : (m * n) % m = 0 := by - rw [← Nat.zero_add (m * n), add_mul_mod_self_left, zero_mod] - -@[simp] theorem mul_mod_left (m n : Nat) : (m * n) % n = 0 := by - rw [Nat.mul_comm, mul_mod_right] - -protected theorem div_eq_of_lt_le (lo : k * n ≤ m) (hi : m < succ k * n) : m / n = k := -have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun hn => by - rw [hn, Nat.mul_zero] at hi lo; exact absurd lo (Nat.not_le_of_gt hi) -Nat.le_antisymm - (le_of_lt_succ ((Nat.div_lt_iff_lt_mul npos).2 hi)) - ((Nat.le_div_iff_mul_le npos).2 lo) - -theorem sub_mul_div (x n p : Nat) (h₁ : n*p ≤ x) : (x - n*p) / n = x / n - p := by - match eq_zero_or_pos n with - | .inl h₀ => rw [h₀, Nat.div_zero, Nat.div_zero, Nat.zero_sub] - | .inr h₀ => induction p with - | zero => rw [Nat.mul_zero, Nat.sub_zero, Nat.sub_zero] - | succ p IH => - have h₂ : n * p ≤ x := Nat.le_trans (Nat.mul_le_mul_left _ (le_succ _)) h₁ - have h₃ : x - n * p ≥ n := by - apply Nat.le_of_add_le_add_right - rw [Nat.sub_add_cancel h₂, Nat.add_comm] - rw [mul_succ] at h₁ - exact h₁ - rw [sub_succ, ← IH h₂, div_eq_sub_div h₀ h₃] - simp [add_one, Nat.pred_succ, mul_succ, Nat.sub_sub] - -theorem mul_sub_div (x n p : Nat) (h₁ : x < n*p) : (n * p - succ x) / n = p - succ (x / n) := by - have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun n0 => by - rw [n0, Nat.zero_mul] at h₁; exact not_lt_zero _ h₁ - apply Nat.div_eq_of_lt_le - · rw [Nat.mul_sub_right_distrib, Nat.mul_comm] - exact Nat.sub_le_sub_left ((div_lt_iff_lt_mul npos).1 (lt_succ_self _)) _ - · show succ (pred (n * p - x)) ≤ (succ (pred (p - x / n))) * n - rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁), - fun h => succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)] -- TODO: why is the function needed? - · rw [Nat.mul_sub_right_distrib, Nat.mul_comm] - exact Nat.sub_le_sub_left (div_mul_le_self ..) _ - · rwa [div_lt_iff_lt_mul npos, Nat.mul_comm] - -theorem mul_mod_mul_left (z x y : Nat) : (z * x) % (z * y) = z * (x % y) := - if y0 : y = 0 then by - rw [y0, Nat.mul_zero, mod_zero, mod_zero] - else if z0 : z = 0 then by - rw [z0, Nat.zero_mul, Nat.zero_mul, Nat.zero_mul, mod_zero] - else by - induction x using Nat.strongInductionOn with - | _ n IH => - have y0 : y > 0 := Nat.pos_of_ne_zero y0 - have z0 : z > 0 := Nat.pos_of_ne_zero z0 - cases Nat.lt_or_ge n y with - | inl yn => rw [mod_eq_of_lt yn, mod_eq_of_lt (Nat.mul_lt_mul_of_pos_left yn z0)] - | inr yn => - rw [mod_eq_sub_mod yn, mod_eq_sub_mod (Nat.mul_le_mul_left z yn), - ← Nat.mul_sub_left_distrib] - exact IH _ (sub_lt (Nat.lt_of_lt_of_le y0 yn) y0) - -/-! ### pow -/ - -protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide) -@[deprecated] alias pow_two_pos := Nat.two_pow_pos -- deprecated 2024-02-09 diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index 74bb5a6581..fd70d5646c 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -3,10 +3,8 @@ Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ -import Std.Logic import Std.Tactic.Alias -import Std.Data.Nat.Init.Lemmas -import Std.Data.Nat.Init.Dvd +import Std.Tactic.Init import Std.Data.Nat.Basic import Std.Data.Ord @@ -160,12 +158,6 @@ protected alias lt_or_gt := Nat.ne_iff_lt_or_gt protected alias le_or_ge := Nat.le_total protected alias le_or_le := Nat.le_total -protected theorem lt_trichotomy (a b : Nat) : a < b ∨ a = b ∨ b < a := - if h : a = b then .inr (.inl h) else - match Nat.lt_or_gt_of_ne h with - | .inl h => .inl h - | .inr h => .inr (.inr h) - protected theorem eq_or_lt_of_not_lt {a b : Nat} (hnlt : ¬ a < b) : a = b ∨ b < a := (Nat.lt_trichotomy ..).resolve_left hnlt @@ -319,6 +311,9 @@ theorem lt_of_le_pred (h : 0 < m) : n ≤ pred m → n < m := (le_pred_iff_lt h) theorem le_pred_of_lt (h : n < m) : n ≤ pred m := (le_pred_iff_lt (Nat.zero_lt_of_lt h)).2 h +theorem exists_eq_succ_of_ne_zero : ∀ {n}, n ≠ 0 → ∃ k, n = succ k + | _+1, _ => ⟨_, rfl⟩ + /-! ## add -/ protected theorem add_add_add_comm (a b c d : Nat) : (a + b) + (c + d) = (a + c) + (b + d) := by @@ -813,11 +808,6 @@ protected theorem div_le_of_le_mul {m n : Nat} : ∀ {k}, m ≤ k * n → m / k rw [← h2] at h3 exact Nat.le_trans h1 h3 -theorem div_eq_of_lt (h₀ : a < b) : a / b = 0 := by - rw [div_eq a, if_neg] - intro h₁ - apply Nat.not_le_of_gt h₀ h₁.right - @[simp] theorem mul_div_right (n : Nat) {m : Nat} (H : 0 < m) : m * n / m = n := by induction n <;> simp_all [mul_succ] @@ -1028,7 +1018,7 @@ protected theorem pow_le_pow_iff_right {a n m : Nat} (h : 1 < a) : a ^ n ≤ a ^ m ↔ n ≤ m := by constructor · by_contra w - simp at w + simp [Decidable.not_imp_iff_and_not] at w apply Nat.lt_irrefl (a ^ n) exact Nat.lt_of_le_of_lt w.1 (Nat.pow_lt_pow_of_lt h w.2) · intro w @@ -1266,3 +1256,6 @@ instance decidableExistsLT [h : DecidablePred p] : DecidablePred fun n => ∃ m instance decidableExistsLE [DecidablePred p] : DecidablePred fun n => ∃ m : Nat, m ≤ n ∧ p m := fun n => decidable_of_iff (∃ m, m < n + 1 ∧ p m) (exists_congr fun _ => and_congr_left' Nat.lt_succ_iff) + +@[deprecated] protected alias lt_connex := Nat.lt_or_gt_of_ne +@[deprecated] alias pow_two_pos := Nat.two_pow_pos -- deprecated 2024-02-09 diff --git a/Std/Data/Option/Basic.lean b/Std/Data/Option/Basic.lean index 644e2bcd61..131a4ada36 100644 --- a/Std/Data/Option/Basic.lean +++ b/Std/Data/Option/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Classes.SetNotation namespace Option diff --git a/Std/Data/Option/Lemmas.lean b/Std/Data/Option/Lemmas.lean index fea0a04c28..5ef860bbb7 100644 --- a/Std/Data/Option/Lemmas.lean +++ b/Std/Data/Option/Lemmas.lean @@ -6,7 +6,6 @@ Authors: Mario Carneiro import Std.Data.Option.Init.Lemmas import Std.Data.Option.Basic import Std.Tactic.Ext.Attr -import Std.Logic namespace Option diff --git a/Std/Data/PairingHeap.lean b/Std/Data/PairingHeap.lean index 312b9e3f59..fd30bd0c44 100644 --- a/Std/Data/PairingHeap.lean +++ b/Std/Data/PairingHeap.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuyang Zhao -/ import Std.Classes.Order -import Std.Logic namespace Std.PairingHeapImp diff --git a/Std/Data/Prod.lean b/Std/Data/Prod.lean deleted file mode 100644 index 78ce8cfb58..0000000000 --- a/Std/Data/Prod.lean +++ /dev/null @@ -1 +0,0 @@ -import Std.Data.Prod.Lex diff --git a/Std/Data/Prod/Lex.lean b/Std/Data/Prod/Lex.lean deleted file mode 100644 index 2bb21568dc..0000000000 --- a/Std/Data/Prod/Lex.lean +++ /dev/null @@ -1,32 +0,0 @@ -/- -Copyright (c) 2022 Jannis Limperg. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jannis Limperg --/ - -namespace Prod - -theorem lex_def (r : α → α → Prop) (s : β → β → Prop) {p q : α × β} : - Prod.Lex r s p q ↔ r p.1 q.1 ∨ p.1 = q.1 ∧ s p.2 q.2 := - ⟨fun h => by cases h <;> simp [*], fun h => - match p, q, h with - | (a, b), (c, d), Or.inl h => Lex.left _ _ h - | (a, b), (c, d), Or.inr ⟨e, h⟩ => by subst e; exact Lex.right _ h⟩ - -namespace Lex - -instance [αeqDec : DecidableEq α] {r : α → α → Prop} [rDec : DecidableRel r] - {s : β → β → Prop} [sDec : DecidableRel s] : DecidableRel (Prod.Lex r s) - | (a, b), (a', b') => - match rDec a a' with - | isTrue raa' => isTrue $ left b b' raa' - | isFalse nraa' => - match αeqDec a a' with - | isTrue eq => by - subst eq - cases sDec b b' with - | isTrue sbb' => exact isTrue $ right a sbb' - | isFalse nsbb' => - apply isFalse; intro contra; cases contra <;> contradiction - | isFalse neqaa' => by - apply isFalse; intro contra; cases contra <;> contradiction diff --git a/Std/Data/RBMap/Basic.lean b/Std/Data/RBMap/Basic.lean index bf69dc8b5a..f404c6c5f3 100644 --- a/Std/Data/RBMap/Basic.lean +++ b/Std/Data/RBMap/Basic.lean @@ -5,8 +5,7 @@ Authors: Leonardo de Moura, Mario Carneiro -/ import Std.Classes.Order import Std.Control.ForInStep.Basic -import Std.Logic -import Std.Tactic.HaveI +import Std.Tactic.Lint.Misc /-! # Red-black trees diff --git a/Std/Data/RBMap/WF.lean b/Std/Data/RBMap/WF.lean index 7c8bd18775..ddc72ea38f 100644 --- a/Std/Data/RBMap/WF.lean +++ b/Std/Data/RBMap/WF.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Logic import Std.Data.RBMap.Basic import Std.Tactic.SeqFocus diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 958daba086..74c85883ad 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -7,8 +7,9 @@ import Std.Data.Char import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.String.Basic -import Std.Tactic.SeqFocus import Std.Tactic.Ext.Attr +import Std.Tactic.Lint.Misc +import Std.Tactic.SeqFocus import Std.Tactic.Simpa @[simp] theorem Char.length_toString (c : Char) : c.toString.length = 1 := rfl diff --git a/Std/Data/Sum/Basic.lean b/Std/Data/Sum/Basic.lean index 2d60f9ea1c..c5e93ed8f3 100644 --- a/Std/Data/Sum/Basic.lean +++ b/Std/Data/Sum/Basic.lean @@ -4,8 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Yury G. Kudryashov -/ -import Std.Logic - /-! # Disjoint union of types diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index fe87ee037a..9cf6bf6b2b 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 François G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ -import Std.Data.Nat.Init.Lemmas import Std.Tactic.Ext.Attr /-! ### UInt8 -/ diff --git a/Std/Lean/HashSet.lean b/Std/Lean/HashSet.lean index dd71cd3cfc..272ea4dab0 100644 --- a/Std/Lean/HashSet.lean +++ b/Std/Lean/HashSet.lean @@ -5,7 +5,6 @@ Authors: Jannis Limperg -/ import Lean.Data.HashSet -import Std.Classes.SetNotation namespace Lean.HashSet diff --git a/Std/Lean/Meta/LazyDiscrTree.lean b/Std/Lean/Meta/LazyDiscrTree.lean index f8b0adadd8..75818cd497 100644 --- a/Std/Lean/Meta/LazyDiscrTree.lean +++ b/Std/Lean/Meta/LazyDiscrTree.lean @@ -6,7 +6,6 @@ Authors: Joe Hendrix, Scott Morrison import Lean.Meta.DiscrTree import Std.Lean.Name -import Std.Data.Nat.Init.Lemmas /-! # Lazy Discrimination Tree diff --git a/Std/Lean/Position.lean b/Std/Lean/Position.lean index 60ea2d058a..8574d846f1 100644 --- a/Std/Lean/Position.lean +++ b/Std/Lean/Position.lean @@ -3,8 +3,6 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Lean.Syntax -import Lean.Data.Lsp.Utf16 import Lean.Meta.Tactic.TryThis /-- Gets the LSP range of syntax `stx`. -/ diff --git a/Std/Logic.lean b/Std/Logic.lean index 1d6f50171f..43a9b31f66 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -10,721 +10,22 @@ import Std.Tactic.Lint.Misc instance {f : α → β} [DecidablePred p] : DecidablePred (p ∘ f) := inferInstanceAs <| DecidablePred fun x => p (f x) -theorem Function.comp_def {α β δ} (f : β → δ) (g : α → β) : f ∘ g = fun x => f (g x) := rfl - -/-! ## not -/ - -theorem Not.intro {a : Prop} (h : a → False) : ¬a := h - -/-- Ex falso for negation. From `¬a` and `a` anything follows. This is the same as `absurd` with -the arguments flipped, but it is in the `not` namespace so that projection notation can be used. -/ -def Not.elim {α : Sort _} (H1 : ¬a) (H2 : a) : α := absurd H2 H1 - -theorem Not.imp {a b : Prop} (H2 : ¬b) (H1 : a → b) : ¬a := mt H1 H2 - -theorem not_congr (h : a ↔ b) : ¬a ↔ ¬b := ⟨mt h.2, mt h.1⟩ - -theorem not_not_not : ¬¬¬a ↔ ¬a := ⟨mt not_not_intro, not_not_intro⟩ - -theorem not_not_of_not_imp : ¬(a → b) → ¬¬a := mt Not.elim - -theorem not_of_not_imp {a : Prop} : ¬(a → b) → ¬b := mt fun h _ => h - -@[simp] theorem imp_not_self : (a → ¬a) ↔ ¬a := ⟨fun h ha => h ha ha, fun h _ => h⟩ - -/-! ## iff -/ - --- This is needed for `calc` to work with `iff`. -instance : Trans Iff Iff Iff where - trans p q := p.trans q - -theorem iff_def : (a ↔ b) ↔ (a → b) ∧ (b → a) := iff_iff_implies_and_implies .. - -theorem iff_def' : (a ↔ b) ↔ (b → a) ∧ (a → b) := iff_def.trans And.comm - -/-- Non-dependent eliminator for `Iff`. -/ -def Iff.elim (f : (a → b) → (b → a) → α) (h : a ↔ b) : α := f h.1 h.2 - -theorem Eq.to_iff : a = b → (a ↔ b) | rfl => Iff.rfl - -theorem iff_of_eq : a = b → (a ↔ b) := Eq.to_iff - -theorem neq_of_not_iff : ¬(a ↔ b) → a ≠ b := mt Eq.to_iff - -theorem iff_iff_eq : (a ↔ b) ↔ a = b := ⟨propext, iff_of_eq⟩ - -@[simp] theorem eq_iff_iff {p q : Prop} : (p = q) ↔ (p ↔ q) := iff_iff_eq.symm - -theorem of_iff_true (h : a ↔ True) : a := h.2 ⟨⟩ - -theorem not_of_iff_false : (a ↔ False) → ¬a := Iff.mp - -theorem iff_of_true (ha : a) (hb : b) : a ↔ b := ⟨fun _ => hb, fun _ => ha⟩ - -theorem iff_of_false (ha : ¬a) (hb : ¬b) : a ↔ b := ⟨ha.elim, hb.elim⟩ - -theorem iff_true_left (ha : a) : (a ↔ b) ↔ b := ⟨fun h => h.1 ha, iff_of_true ha⟩ - -theorem iff_true_right (ha : a) : (b ↔ a) ↔ b := Iff.comm.trans (iff_true_left ha) - -theorem iff_false_left (ha : ¬a) : (a ↔ b) ↔ ¬b := ⟨fun h => mt h.2 ha, iff_of_false ha⟩ - -theorem iff_false_right (ha : ¬a) : (b ↔ a) ↔ ¬b := Iff.comm.trans (iff_false_left ha) - -theorem iff_true_intro (h : a) : a ↔ True := iff_of_true h ⟨⟩ - -theorem iff_false_intro (h : ¬a) : a ↔ False := iff_of_false h id - -theorem not_iff_false_intro (h : a) : ¬a ↔ False := iff_false_intro (not_not_intro h) - -theorem iff_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a ↔ b) ↔ (c ↔ d) := - ⟨fun h => h₁.symm.trans <| h.trans h₂, fun h => h₁.trans <| h.trans h₂.symm⟩ - -theorem not_true : (¬True) ↔ False := iff_false_intro (not_not_intro ⟨⟩) - -theorem not_false_iff : (¬False) ↔ True := iff_true_intro not_false - -theorem ne_self_iff_false (a : α) : a ≠ a ↔ False := not_iff_false_intro rfl - -theorem eq_self_iff_true (a : α) : a = a ↔ True := iff_true_intro rfl - -theorem heq_self_iff_true (a : α) : HEq a a ↔ True := iff_true_intro HEq.rfl - -theorem iff_not_self : ¬(a ↔ ¬a) | H => let f h := H.1 h h; f (H.2 f) - -@[simp] theorem not_iff_self : ¬(¬a ↔ a) | H => iff_not_self H.symm - -theorem true_iff_false : (True ↔ False) ↔ False := iff_false_intro (fun h => h.1 ⟨⟩) - -theorem false_iff_true : (False ↔ True) ↔ False := iff_false_intro (fun h => h.2 ⟨⟩) - -theorem false_of_true_iff_false : (True ↔ False) → False := fun h => h.1 ⟨⟩ - -theorem false_of_true_eq_false : (True = False) → False := fun h => h ▸ trivial - -theorem true_eq_false_of_false : False → (True = False) := False.elim - -theorem eq_comm {a b : α} : a = b ↔ b = a := ⟨Eq.symm, Eq.symm⟩ - -/-! ## implies -/ - -@[nolint unusedArguments] -theorem imp_intro {α β : Prop} (h : α) : β → α := fun _ => h - -theorem imp_imp_imp {a b c d : Prop} (h₀ : c → a) (h₁ : b → d) : (a → b) → (c → d) := (h₁ ∘ · ∘ h₀) - -theorem imp_iff_right {a : Prop} (ha : a) : (a → b) ↔ b := ⟨fun f => f ha, imp_intro⟩ - --- This is not marked `@[simp]` because we have `implies_true : (α → True) = True` in core. -theorem imp_true_iff (α : Sort u) : (α → True) ↔ True := iff_true_intro fun _ => trivial - -theorem false_imp_iff (a : Prop) : (False → a) ↔ True := iff_true_intro False.elim - -theorem true_imp_iff (α : Prop) : (True → α) ↔ α := ⟨fun h => h trivial, fun h _ => h⟩ - -@[simp] theorem imp_self : (a → a) ↔ True := iff_true_intro id - -theorem imp_false : (a → False) ↔ ¬a := Iff.rfl - -theorem imp.swap : (a → b → c) ↔ (b → a → c) := ⟨flip, flip⟩ - -theorem imp_not_comm : (a → ¬b) ↔ (b → ¬a) := imp.swap - -theorem imp_congr_left (h : a ↔ b) : (a → c) ↔ (b → c) := - ⟨fun hac ha => hac (h.2 ha), fun hbc ha => hbc (h.1 ha)⟩ - -theorem imp_congr_right (h : a → (b ↔ c)) : (a → b) ↔ (a → c) := - ⟨fun hab ha => (h ha).1 (hab ha), fun hcd ha => (h ha).2 (hcd ha)⟩ - -theorem imp_congr_ctx (h₁ : a ↔ c) (h₂ : c → (b ↔ d)) : (a → b) ↔ (c → d) := - (imp_congr_left h₁).trans (imp_congr_right h₂) - -theorem imp_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a → b) ↔ (c → d) := imp_congr_ctx h₁ fun _ => h₂ - -theorem imp_iff_not (hb : ¬b) : a → b ↔ ¬a := imp_congr_right fun _ => iff_false_intro hb - -/-! ## and -/ - -/-- Non-dependent eliminator for `And`. -/ -abbrev And.elim (f : a → b → α) (h : a ∧ b) : α := f h.1 h.2 - --- TODO: rename and_self to and_self_eq -theorem and_self_iff : a ∧ a ↔ a := and_self _ ▸ .rfl - -theorem And.symm : a ∧ b → b ∧ a | ⟨ha, hb⟩ => ⟨hb, ha⟩ - -theorem And.imp (f : a → c) (g : b → d) (h : a ∧ b) : c ∧ d := ⟨f h.1, g h.2⟩ - -theorem And.imp_left (h : a → b) : a ∧ c → b ∧ c := .imp h id - -theorem And.imp_right (h : a → b) : c ∧ a → c ∧ b := .imp id h - -theorem and_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : a ∧ b ↔ c ∧ d := - ⟨And.imp h₁.1 h₂.1, And.imp h₁.2 h₂.2⟩ - -theorem and_comm : a ∧ b ↔ b ∧ a := And.comm - -theorem and_congr_right (h : a → (b ↔ c)) : a ∧ b ↔ a ∧ c := -⟨fun ⟨ha, hb⟩ => ⟨ha, (h ha).1 hb⟩, fun ⟨ha, hb⟩ => ⟨ha, (h ha).2 hb⟩⟩ - -theorem and_congr_left (h : c → (a ↔ b)) : a ∧ c ↔ b ∧ c := - and_comm.trans <| (and_congr_right h).trans and_comm - -theorem and_congr_left' (h : a ↔ b) : a ∧ c ↔ b ∧ c := and_congr h .rfl - -theorem and_congr_right' (h : b ↔ c) : a ∧ b ↔ a ∧ c := and_congr .rfl h - -theorem and_congr_right_eq (h : a → b = c) : (a ∧ b) = (a ∧ c) := - propext <| and_congr_right fun hc => h hc ▸ .rfl - -theorem and_congr_left_eq (h : c → a = b) : (a ∧ c) = (b ∧ c) := - propext <| and_congr_left fun hc => h hc ▸ .rfl - -theorem and_assoc : (a ∧ b) ∧ c ↔ a ∧ (b ∧ c) := - ⟨fun ⟨⟨ha, hb⟩, hc⟩ => ⟨ha, hb, hc⟩, fun ⟨ha, hb, hc⟩ => ⟨⟨ha, hb⟩, hc⟩⟩ - -theorem and_left_comm : a ∧ (b ∧ c) ↔ b ∧ (a ∧ c) := by - rw [← and_assoc, ← and_assoc, @and_comm a b] - -theorem and_right_comm : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b := by - simp only [and_left_comm, and_comm] - -theorem and_rotate : a ∧ b ∧ c ↔ b ∧ c ∧ a := by - simp only [and_left_comm, and_comm] - -theorem and_and_and_comm : (a ∧ b) ∧ c ∧ d ↔ (a ∧ c) ∧ b ∧ d := by - rw [← and_assoc, @and_right_comm a, and_assoc] - -theorem and_and_left : a ∧ b ∧ c ↔ (a ∧ b) ∧ a ∧ c := by - rw [and_and_and_comm, and_self] - -theorem and_and_right : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b ∧ c := by - rw [and_and_and_comm, and_self] - -theorem and_iff_left_of_imp (h : a → b) : (a ∧ b) ↔ a := - ⟨And.left, fun ha => ⟨ha, h ha⟩⟩ - -theorem and_iff_right_of_imp (h : b → a) : (a ∧ b) ↔ b := - ⟨And.right, fun hb => ⟨h hb, hb⟩⟩ - -theorem and_iff_left (hb : b) : a ∧ b ↔ a := and_iff_left_of_imp fun _ => hb - -theorem and_iff_right (ha : a) : a ∧ b ↔ b := and_iff_right_of_imp fun _ => ha - -@[simp] theorem and_iff_left_iff_imp : ((a ∧ b) ↔ a) ↔ (a → b) := - ⟨fun h ha => (h.2 ha).2, and_iff_left_of_imp⟩ - -@[simp] theorem and_iff_right_iff_imp : ((a ∧ b) ↔ b) ↔ (b → a) := - ⟨fun h ha => (h.2 ha).1, and_iff_right_of_imp⟩ - -@[simp] theorem iff_self_and : (p ↔ p ∧ q) ↔ (p → q) := by - rw [@Iff.comm p, and_iff_left_iff_imp] - -@[simp] theorem iff_and_self : (p ↔ q ∧ p) ↔ (p → q) := by rw [and_comm, iff_self_and] - -@[simp] theorem and_congr_right_iff : (a ∧ b ↔ a ∧ c) ↔ (a → (b ↔ c)) := - ⟨fun h ha => by simp [ha] at h; exact h, and_congr_right⟩ - -@[simp] theorem and_congr_left_iff : (a ∧ c ↔ b ∧ c) ↔ c → (a ↔ b) := by - simp only [and_comm, ← and_congr_right_iff] - -@[simp] theorem and_self_left : a ∧ a ∧ b ↔ a ∧ b := - ⟨fun h => ⟨h.1, h.2.2⟩, fun h => ⟨h.1, h.1, h.2⟩⟩ - -@[simp] theorem and_self_right : (a ∧ b) ∧ b ↔ a ∧ b := - ⟨fun h => ⟨h.1.1, h.2⟩, fun h => ⟨⟨h.1, h.2⟩, h.2⟩⟩ - -theorem not_and_of_not_left (b : Prop) : ¬a → ¬(a ∧ b) := mt And.left - -theorem not_and_of_not_right (a : Prop) {b : Prop} : ¬b → ¬(a ∧ b) := mt And.right - -@[simp] theorem and_not_self : ¬(a ∧ ¬a) | ⟨ha, hn⟩ => hn ha - -@[simp] theorem not_and_self : ¬(¬a ∧ a) | ⟨hn, ha⟩ => hn ha - -theorem and_not_self_iff (a : Prop) : a ∧ ¬a ↔ False := iff_false_intro and_not_self - -theorem not_and_self_iff (a : Prop) : ¬a ∧ a ↔ False := iff_false_intro not_and_self - -/-! ## or -/ - -theorem not_not_em (a : Prop) : ¬¬(a ∨ ¬a) := fun h => h (.inr (h ∘ .inl)) - --- TODO: rename or_self to or_self_eq -theorem or_self_iff : a ∨ a ↔ a := or_self _ ▸ .rfl - -theorem Or.symm : a ∨ b → b ∨ a := .rec .inr .inl - -theorem Or.imp (f : a → c) (g : b → d) (h : a ∨ b) : c ∨ d := h.elim (inl ∘ f) (inr ∘ g) - -theorem Or.imp_left (f : a → b) : a ∨ c → b ∨ c := .imp f id - -theorem Or.imp_right (f : b → c) : a ∨ b → a ∨ c := .imp id f - -theorem or_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a ∨ b) ↔ (c ∨ d) := ⟨.imp h₁.1 h₂.1, .imp h₁.2 h₂.2⟩ - -theorem or_congr_left (h : a ↔ b) : a ∨ c ↔ b ∨ c := or_congr h .rfl - -theorem or_congr_right (h : b ↔ c) : a ∨ b ↔ a ∨ c := or_congr .rfl h - -theorem Or.comm : a ∨ b ↔ b ∨ a := ⟨Or.symm, Or.symm⟩ - -theorem or_comm : a ∨ b ↔ b ∨ a := Or.comm - -theorem or_assoc : (a ∨ b) ∨ c ↔ a ∨ (b ∨ c) := - ⟨.rec (.imp_right .inl) (.inr ∘ .inr), .rec (.inl ∘ .inl) (.imp_left .inr)⟩ - -theorem Or.resolve_left {a b : Prop} (h: a ∨ b) (na : ¬a) : b := h.elim (absurd · na) id - -theorem Or.neg_resolve_left (h : ¬a ∨ b) (ha : a) : b := h.elim (absurd ha) id - -theorem Or.resolve_right {a b : Prop} (h: a ∨ b) (nb : ¬b) : a := h.elim id (absurd · nb) - -theorem Or.neg_resolve_right (h : a ∨ ¬b) (nb : b) : a := h.elim id (absurd nb) - -theorem or_left_comm : a ∨ (b ∨ c) ↔ b ∨ (a ∨ c) := by rw [← or_assoc, ← or_assoc, @or_comm a b] - -theorem or_right_comm : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b := by rw [or_assoc, or_assoc, @or_comm b] - -theorem or_or_or_comm : (a ∨ b) ∨ c ∨ d ↔ (a ∨ c) ∨ b ∨ d := by - rw [← or_assoc, @or_right_comm a, or_assoc] - -theorem or_or_distrib_left : a ∨ b ∨ c ↔ (a ∨ b) ∨ a ∨ c := by rw [or_or_or_comm, or_self] - -theorem or_or_distrib_right : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b ∨ c := by rw [or_or_or_comm, or_self] - -theorem or_rotate : a ∨ b ∨ c ↔ b ∨ c ∨ a := by simp only [or_left_comm, Or.comm] - -theorem or_iff_right_of_imp (ha : a → b) : (a ∨ b) ↔ b := ⟨Or.rec ha id, .inr⟩ - -theorem or_iff_left_of_imp (hb : b → a) : (a ∨ b) ↔ a := ⟨Or.rec id hb, .inl⟩ - -theorem not_or_intro {a b : Prop} (ha : ¬a) (hb : ¬b) : ¬(a ∨ b) := (·.elim ha hb) - -@[simp] theorem or_iff_left_iff_imp : (a ∨ b ↔ a) ↔ (b → a) := - ⟨fun h hb => h.1 (Or.inr hb), or_iff_left_of_imp⟩ - -@[simp] theorem or_iff_right_iff_imp : (a ∨ b ↔ b) ↔ (a → b) := by - rw [or_comm, or_iff_left_iff_imp] - -theorem or_iff_left (hb : ¬b) : a ∨ b ↔ a := or_iff_left_iff_imp.2 hb.elim - -theorem or_iff_right (ha : ¬a) : a ∨ b ↔ b := or_iff_right_iff_imp.2 ha.elim - -/-! ## distributivity -/ - -theorem not_imp_of_and_not : a ∧ ¬b → ¬(a → b) - | ⟨ha, hb⟩, h => hb <| h ha - -theorem imp_and {α} : (α → b ∧ c) ↔ (α → b) ∧ (α → c) := - ⟨fun h => ⟨fun ha => (h ha).1, fun ha => (h ha).2⟩, fun h ha => ⟨h.1 ha, h.2 ha⟩⟩ - -@[simp] theorem and_imp : (a ∧ b → c) ↔ (a → b → c) := - ⟨fun h ha hb => h ⟨ha, hb⟩, fun h ⟨ha, hb⟩ => h ha hb⟩ - -@[simp] theorem not_and : ¬(a ∧ b) ↔ (a → ¬b) := and_imp - -theorem not_and' : ¬(a ∧ b) ↔ b → ¬a := not_and.trans imp_not_comm - -/-- `∧` distributes over `∨` (on the left). -/ -theorem and_or_left : a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) := - ⟨fun ⟨ha, hbc⟩ => hbc.imp (.intro ha) (.intro ha), Or.rec (.imp_right .inl) (.imp_right .inr)⟩ - -/-- `∧` distributes over `∨` (on the right). -/ -theorem or_and_right : (a ∨ b) ∧ c ↔ (a ∧ c) ∨ (b ∧ c) := by - simp [and_comm, and_or_left] - -/-- `∨` distributes over `∧` (on the left). -/ -theorem or_and_left : a ∨ (b ∧ c) ↔ (a ∨ b) ∧ (a ∨ c) := - ⟨Or.rec (fun ha => ⟨.inl ha, .inl ha⟩) (.imp .inr .inr), - And.rec <| .rec (fun _ => .inl ·) (.imp_right ∘ .intro)⟩ - -/-- `∨` distributes over `∧` (on the right). -/ -theorem and_or_right : (a ∧ b) ∨ c ↔ (a ∨ c) ∧ (b ∨ c) := by - simp [or_comm, or_and_left] - -theorem or_imp : (a ∨ b → c) ↔ (a → c) ∧ (b → c) := - ⟨fun h => ⟨h ∘ .inl, h ∘ .inr⟩, fun ⟨ha, hb⟩ => Or.rec ha hb⟩ - -theorem not_or : ¬(p ∨ q) ↔ ¬p ∧ ¬q := or_imp - -theorem not_and_of_not_or_not (h : ¬a ∨ ¬b) : ¬(a ∧ b) := h.elim (mt (·.1)) (mt (·.2)) - -@[simp] theorem or_self_left : a ∨ a ∨ b ↔ a ∨ b := ⟨.rec .inl id, .rec .inl (.inr ∘ .inr)⟩ - -@[simp] theorem or_self_right : (a ∨ b) ∨ b ↔ a ∨ b := ⟨.rec id .inr, .rec (.inl ∘ .inl) .inr⟩ +@[deprecated] alias proofIrrel := proof_irrel /-! ## exists and forall -/ -section quantifiers -variable {p q : α → Prop} {b : Prop} - -theorem forall_imp (h : ∀ a, p a → q a) : (∀ a, p a) → ∀ a, q a := -fun h' a => h a (h' a) - -@[simp] theorem forall_exists_index {q : (∃ x, p x) → Prop} : - (∀ h, q h) ↔ ∀ x (h : p x), q ⟨x, h⟩ := - ⟨fun h x hpx => h ⟨x, hpx⟩, fun h ⟨x, hpx⟩ => h x hpx⟩ - -theorem Exists.imp (h : ∀ a, p a → q a) : (∃ a, p a) → ∃ a, q a - | ⟨a, hp⟩ => ⟨a, h a hp⟩ - -theorem Exists.imp' {β} {q : β → Prop} (f : α → β) (hpq : ∀ a, p a → q (f a)) : - (∃ a, p a) → ∃ b, q b - | ⟨_, hp⟩ => ⟨_, hpq _ hp⟩ - -theorem exists_imp : ((∃ x, p x) → b) ↔ ∀ x, p x → b := forall_exists_index - -@[simp] theorem exists_const (α) [i : Nonempty α] : (∃ _ : α, b) ↔ b := - ⟨fun ⟨_, h⟩ => h, i.elim Exists.intro⟩ - -section forall_congr - --- Port note: this is `forall_congr` from Lean 3. In Lean 4, there is already something --- with that name and a slightly different type. -theorem forall_congr' (h : ∀ a, p a ↔ q a) : (∀ a, p a) ↔ ∀ a, q a := - ⟨fun H a => (h a).1 (H a), fun H a => (h a).2 (H a)⟩ - -theorem exists_congr (h : ∀ a, p a ↔ q a) : (∃ a, p a) ↔ ∃ a, q a := - ⟨Exists.imp fun x => (h x).1, Exists.imp fun x => (h x).2⟩ - -variable {β : α → Sort _} -theorem forall₂_congr {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) : - (∀ a b, p a b) ↔ ∀ a b, q a b := - forall_congr' fun a => forall_congr' <| h a - -theorem exists₂_congr {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) : - (∃ a b, p a b) ↔ ∃ a b, q a b := - exists_congr fun a => exists_congr <| h a - -variable {γ : ∀ a, β a → Sort _} -theorem forall₃_congr {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) : - (∀ a b c, p a b c) ↔ ∀ a b c, q a b c := - forall_congr' fun a => forall₂_congr <| h a - -theorem exists₃_congr {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) : - (∃ a b c, p a b c) ↔ ∃ a b c, q a b c := - exists_congr fun a => exists₂_congr <| h a - -variable {δ : ∀ a b, γ a b → Sort _} -theorem forall₄_congr {p q : ∀ a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) : - (∀ a b c d, p a b c d) ↔ ∀ a b c d, q a b c d := - forall_congr' fun a => forall₃_congr <| h a - -theorem exists₄_congr {p q : ∀ a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) : - (∃ a b c d, p a b c d) ↔ ∃ a b c d, q a b c d := - exists_congr fun a => exists₃_congr <| h a - -variable {ε : ∀ a b c, δ a b c → Sort _} -theorem forall₅_congr {p q : ∀ a b c d, ε a b c d → Prop} - (h : ∀ a b c d e, p a b c d e ↔ q a b c d e) : - (∀ a b c d e, p a b c d e) ↔ ∀ a b c d e, q a b c d e := - forall_congr' fun a => forall₄_congr <| h a - -theorem exists₅_congr {p q : ∀ a b c d, ε a b c d → Prop} - (h : ∀ a b c d e, p a b c d e ↔ q a b c d e) : - (∃ a b c d e, p a b c d e) ↔ ∃ a b c d e, q a b c d e := - exists_congr fun a => exists₄_congr <| h a - -end forall_congr - -@[simp] theorem not_exists : (¬∃ x, p x) ↔ ∀ x, ¬p x := exists_imp - alias ⟨forall_not_of_not_exists, not_exists_of_forall_not⟩ := not_exists -theorem forall_and : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := - ⟨fun h => ⟨fun x => (h x).1, fun x => (h x).2⟩, fun ⟨h₁, h₂⟩ x => ⟨h₁ x, h₂ x⟩⟩ - -theorem exists_or : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ ∃ x, q x := - ⟨fun | ⟨x, .inl h⟩ => .inl ⟨x, h⟩ | ⟨x, .inr h⟩ => .inr ⟨x, h⟩, - fun | .inl ⟨x, h⟩ => ⟨x, .inl h⟩ | .inr ⟨x, h⟩ => ⟨x, .inr h⟩⟩ - -@[simp] theorem exists_false : ¬(∃ _a : α, False) := fun ⟨_, h⟩ => h - -@[simp] theorem forall_const (α : Sort _) [i : Nonempty α] : (α → b) ↔ b := - ⟨i.elim, fun hb _ => hb⟩ - -theorem Exists.nonempty : (∃ x, p x) → Nonempty α | ⟨x, _⟩ => ⟨x⟩ - -/-- Extract an element from a existential statement, using `Classical.choose`. -/ --- This enables projection notation. -@[reducible] noncomputable def Exists.choose (P : ∃ a, p a) : α := Classical.choose P - -/-- Show that an element extracted from `P : ∃ a, p a` using `P.choose` satisfies `p`. -/ -theorem Exists.choose_spec {p : α → Prop} (P : ∃ a, p a) : p P.choose := Classical.choose_spec P - -theorem not_forall_of_exists_not {p : α → Prop} : (∃ x, ¬p x) → ¬∀ x, p x - | ⟨x, hn⟩, h => hn (h x) - -@[simp] theorem forall_eq {p : α → Prop} {a' : α} : (∀ a, a = a' → p a) ↔ p a' := - ⟨fun h => h a' rfl, fun h _ e => e.symm ▸ h⟩ - -@[simp] theorem forall_eq' {a' : α} : (∀ a, a' = a → p a) ↔ p a' := by simp [@eq_comm _ a'] - -@[simp] theorem exists_eq : ∃ a, a = a' := ⟨_, rfl⟩ - -@[simp] theorem exists_eq' : ∃ a, a' = a := ⟨_, rfl⟩ - -@[simp] theorem exists_eq_left : (∃ a, a = a' ∧ p a) ↔ p a' := - ⟨fun ⟨_, e, h⟩ => e ▸ h, fun h => ⟨_, rfl, h⟩⟩ - -@[simp] theorem exists_eq_right : (∃ a, p a ∧ a = a') ↔ p a' := - (exists_congr <| by exact fun a => And.comm).trans exists_eq_left - -@[simp] theorem exists_and_left : (∃ x, b ∧ p x) ↔ b ∧ (∃ x, p x) := - ⟨fun ⟨x, h, hp⟩ => ⟨h, x, hp⟩, fun ⟨h, x, hp⟩ => ⟨x, h, hp⟩⟩ - -@[simp] theorem exists_and_right : (∃ x, p x ∧ b) ↔ (∃ x, p x) ∧ b := by simp [And.comm] - -@[simp] theorem exists_eq_left' : (∃ a, a' = a ∧ p a) ↔ p a' := by simp [@eq_comm _ a'] - --- this theorem is needed to simplify the output of `List.mem_cons_iff` -@[simp] theorem forall_eq_or_imp : (∀ a, a = a' ∨ q a → p a) ↔ p a' ∧ ∀ a, q a → p a := by - simp only [or_imp, forall_and, forall_eq] - -@[simp] theorem exists_eq_or_imp : (∃ a, (a = a' ∨ q a) ∧ p a) ↔ p a' ∨ ∃ a, q a ∧ p a := by - simp only [or_and_right, exists_or, exists_eq_left] - -@[simp] theorem exists_eq_right_right : (∃ (a : α), p a ∧ q a ∧ a = a') ↔ p a' ∧ q a' := by - simp [← and_assoc] - -@[simp] theorem exists_eq_right_right' : (∃ (a : α), p a ∧ q a ∧ a' = a) ↔ p a' ∧ q a' := by - (conv in _=_ => rw [eq_comm]); simp - -@[simp] theorem exists_prop : (∃ _h : a, b) ↔ a ∧ b := - ⟨fun ⟨hp, hq⟩ => ⟨hp, hq⟩, fun ⟨hp, hq⟩ => ⟨hp, hq⟩⟩ - -@[simp] theorem exists_apply_eq_apply (f : α → β) (a' : α) : ∃ a, f a = f a' := ⟨a', rfl⟩ - -theorem forall_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∀ h' : p, q h') ↔ q h := - @forall_const (q h) p ⟨h⟩ - -theorem forall_comm {p : α → β → Prop} : (∀ a b, p a b) ↔ (∀ b a, p a b) := - ⟨fun h b a => h a b, fun h a b => h b a⟩ - -theorem exists_comm {p : α → β → Prop} : (∃ a b, p a b) ↔ (∃ b a, p a b) := - ⟨fun ⟨a, b, h⟩ => ⟨b, a, h⟩, fun ⟨b, a, h⟩ => ⟨a, b, h⟩⟩ - -@[simp] theorem forall_apply_eq_imp_iff {f : α → β} {p : β → Prop} : - (∀ b a, f a = b → p b) ↔ ∀ a, p (f a) := by simp [forall_comm] - -@[simp] theorem forall_eq_apply_imp_iff {f : α → β} {p : β → Prop} : - (∀ b a, b = f a → p b) ↔ ∀ a, p (f a) := by simp [forall_comm] - -@[simp] theorem forall_apply_eq_imp_iff₂ {f : α → β} {p : α → Prop} {q : β → Prop} : - (∀ b a, p a → f a = b → q b) ↔ ∀ a, p a → q (f a) := - ⟨fun h a ha => h (f a) a ha rfl, fun h _ a ha hb => hb ▸ h a ha⟩ - -theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬p) : (∀ h' : p, q h') ↔ True := - iff_true_intro fun h => hn.elim h - -end quantifiers - /-! ## decidable -/ -theorem Decidable.not_not [Decidable p] : ¬¬p ↔ p := ⟨of_not_not, not_not_intro⟩ - -theorem Decidable.by_contra [Decidable p] : (¬p → False) → p := of_not_not - -/-- Construct a non-Prop by cases on an `Or`, when the left conjunct is decidable. -/ -protected def Or.by_cases [Decidable p] {α : Sort u} (h : p ∨ q) (h₁ : p → α) (h₂ : q → α) : α := - if hp : p then h₁ hp else h₂ (h.resolve_left hp) - -/-- Construct a non-Prop by cases on an `Or`, when the right conjunct is decidable. -/ -protected def Or.by_cases' [Decidable q] {α : Sort u} (h : p ∨ q) (h₁ : p → α) (h₂ : q → α) : α := - if hq : q then h₂ hq else h₁ (h.resolve_right hq) - -instance exists_prop_decidable {p} (P : p → Prop) - [Decidable p] [∀ h, Decidable (P h)] : Decidable (∃ h, P h) := -if h : p then - decidable_of_decidable_of_iff ⟨fun h2 => ⟨h, h2⟩, fun ⟨_, h2⟩ => h2⟩ -else isFalse fun ⟨h', _⟩ => h h' - -instance forall_prop_decidable {p} (P : p → Prop) - [Decidable p] [∀ h, Decidable (P h)] : Decidable (∀ h, P h) := -if h : p then - decidable_of_decidable_of_iff ⟨fun h2 _ => h2, fun al => al h⟩ -else isTrue fun h2 => absurd h2 h - -theorem decide_eq_true_iff (p : Prop) [Decidable p] : (decide p = true) ↔ p := by simp - -@[simp] theorem decide_eq_false_iff_not (p : Prop) {_ : Decidable p} : (decide p = false) ↔ ¬p := - ⟨of_decide_eq_false, decide_eq_false⟩ - -@[simp] theorem decide_eq_decide {p q : Prop} {_ : Decidable p} {_ : Decidable q} : - decide p = decide q ↔ (p ↔ q) := - ⟨fun h => by rw [← decide_eq_true_iff p, h, decide_eq_true_iff], fun h => by simp [h]⟩ - -theorem Decidable.of_not_imp [Decidable a] (h : ¬(a → b)) : a := - byContradiction (not_not_of_not_imp h) - -theorem Decidable.not_imp_symm [Decidable a] (h : ¬a → b) (hb : ¬b) : a := - byContradiction <| hb ∘ h - -theorem Decidable.not_imp_comm [Decidable a] [Decidable b] : (¬a → b) ↔ (¬b → a) := - ⟨not_imp_symm, not_imp_symm⟩ - -theorem Decidable.not_imp_self [Decidable a] : (¬a → a) ↔ a := by - have := @imp_not_self (¬a); rwa [not_not] at this - -theorem Decidable.or_iff_not_imp_left [Decidable a] : a ∨ b ↔ (¬a → b) := - ⟨Or.resolve_left, fun h => dite _ .inl (.inr ∘ h)⟩ - -theorem Decidable.or_iff_not_imp_right [Decidable b] : a ∨ b ↔ (¬b → a) := -or_comm.trans or_iff_not_imp_left - -theorem Decidable.not_imp_not [Decidable a] : (¬a → ¬b) ↔ (b → a) := -⟨fun h hb => byContradiction (h · hb), mt⟩ - -theorem Decidable.not_or_of_imp [Decidable a] (h : a → b) : ¬a ∨ b := - if ha : a then .inr (h ha) else .inl ha - -theorem Decidable.imp_iff_not_or [Decidable a] : (a → b) ↔ (¬a ∨ b) := - ⟨not_or_of_imp, Or.neg_resolve_left⟩ - -theorem Decidable.imp_iff_or_not [Decidable b] : b → a ↔ a ∨ ¬b := - Decidable.imp_iff_not_or.trans or_comm - -theorem Decidable.imp_or [Decidable a] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) := by - by_cases a <;> simp_all - -theorem Decidable.imp_or' [Decidable b] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) := - if h : b then by simp [h] else by - rw [eq_false h, false_or]; exact (or_iff_right_of_imp fun hx x => (hx x).elim).symm - -theorem Decidable.not_imp_iff_and_not [Decidable a] : ¬(a → b) ↔ a ∧ ¬b := - ⟨fun h => ⟨of_not_imp h, not_of_not_imp h⟩, not_imp_of_and_not⟩ - -theorem Decidable.peirce (a b : Prop) [Decidable a] : ((a → b) → a) → a := - if ha : a then fun _ => ha else fun h => h ha.elim - -theorem peirce' {a : Prop} (H : ∀ b : Prop, (a → b) → a) : a := H _ id - -theorem Decidable.not_iff_not [Decidable a] [Decidable b] : (¬a ↔ ¬b) ↔ (a ↔ b) := by - rw [@iff_def (¬a), @iff_def' a]; exact and_congr not_imp_not not_imp_not - -theorem Decidable.not_iff_comm [Decidable a] [Decidable b] : (¬a ↔ b) ↔ (¬b ↔ a) := by - rw [@iff_def (¬a), @iff_def (¬b)]; exact and_congr not_imp_comm imp_not_comm - -theorem Decidable.not_iff [Decidable b] : ¬(a ↔ b) ↔ (¬a ↔ b) := by - by_cases h : b <;> simp [h, iff_true, iff_false] - -theorem Decidable.iff_not_comm [Decidable a] [Decidable b] : (a ↔ ¬b) ↔ (b ↔ ¬a) := by - rw [@iff_def a, @iff_def b]; exact and_congr imp_not_comm not_imp_comm - -theorem Decidable.iff_iff_and_or_not_and_not {a b : Prop} [Decidable b] : - (a ↔ b) ↔ (a ∧ b) ∨ (¬a ∧ ¬b) := - ⟨fun e => if h : b then .inl ⟨e.2 h, h⟩ else .inr ⟨mt e.1 h, h⟩, - Or.rec (And.rec iff_of_true) (And.rec iff_of_false)⟩ - -theorem Decidable.iff_iff_not_or_and_or_not [Decidable a] [Decidable b] : - (a ↔ b) ↔ (¬a ∨ b) ∧ (a ∨ ¬b) := by - rw [iff_iff_implies_and_implies a b]; simp only [imp_iff_not_or, Or.comm] - -theorem Decidable.not_and_not_right [Decidable b] : ¬(a ∧ ¬b) ↔ (a → b) := - ⟨fun h ha => not_imp_symm (And.intro ha) h, fun h ⟨ha, hb⟩ => hb <| h ha⟩ - -theorem Decidable.not_and_iff_or_not_not [Decidable a] : ¬(a ∧ b) ↔ ¬a ∨ ¬b := - ⟨fun h => if ha : a then .inr (h ⟨ha, ·⟩) else .inl ha, not_and_of_not_or_not⟩ - -theorem Decidable.not_and_iff_or_not_not' [Decidable b] : ¬(a ∧ b) ↔ ¬a ∨ ¬b := - ⟨fun h => if hb : b then .inl (h ⟨·, hb⟩) else .inr hb, not_and_of_not_or_not⟩ - -theorem Decidable.or_iff_not_and_not [Decidable a] [Decidable b] : a ∨ b ↔ ¬(¬a ∧ ¬b) := by - rw [← not_or, not_not] - -theorem Decidable.and_iff_not_or_not [Decidable a] [Decidable b] : a ∧ b ↔ ¬(¬a ∨ ¬b) := by - rw [← not_and_iff_or_not_not, not_not] - -theorem Decidable.imp_iff_right_iff [Decidable a] : (a → b ↔ b) ↔ a ∨ b := - ⟨fun H => (Decidable.em a).imp_right fun ha' => H.1 fun ha => (ha' ha).elim, - fun H => H.elim imp_iff_right fun hb => iff_of_true (fun _ => hb) hb⟩ - -theorem Decidable.and_or_imp [Decidable a] : a ∧ b ∨ (a → c) ↔ a → b ∨ c := - if ha : a then by simp only [ha, true_and, true_imp_iff] - else by simp only [ha, false_or, false_and, false_imp_iff] - -theorem Decidable.or_congr_left' [Decidable c] (h : ¬c → (a ↔ b)) : a ∨ c ↔ b ∨ c := by - rw [or_iff_not_imp_right, or_iff_not_imp_right]; exact imp_congr_right h - -theorem Decidable.or_congr_right' [Decidable a] (h : ¬a → (b ↔ c)) : a ∨ b ↔ a ∨ c := by - rw [or_iff_not_imp_left, or_iff_not_imp_left]; exact imp_congr_right h - -/-- Transfer decidability of `a` to decidability of `b`, if the propositions are equivalent. -**Important**: this function should be used instead of `rw` on `decidable b`, because the -kernel will get stuck reducing the usage of `propext` otherwise, -and `dec_trivial` will not work. -/ -@[inline] def decidable_of_iff (a : Prop) (h : a ↔ b) [Decidable a] : Decidable b := - decidable_of_decidable_of_iff h - -/-- Transfer decidability of `b` to decidability of `a`, if the propositions are equivalent. -This is the same as `decidable_of_iff` but the iff is flipped. -/ -@[inline] def decidable_of_iff' (b : Prop) (h : a ↔ b) [Decidable b] : Decidable a := - decidable_of_decidable_of_iff h.symm - -instance Decidable.predToBool (p : α → Prop) [DecidablePred p] : - CoeDep (α → Prop) p (α → Bool) := ⟨fun b => decide <| p b⟩ - -/-- Prove that `a` is decidable by constructing a boolean `b` and a proof that `b ↔ a`. -(This is sometimes taken as an alternate definition of decidability.) -/ -def decidable_of_bool : ∀ (b : Bool), (b ↔ a) → Decidable a - | true, h => isTrue (h.1 rfl) - | false, h => isFalse (mt h.2 Bool.noConfusion) - -protected theorem Decidable.not_forall {p : α → Prop} [Decidable (∃ x, ¬p x)] - [∀ x, Decidable (p x)] : (¬∀ x, p x) ↔ ∃ x, ¬p x := - ⟨Decidable.not_imp_symm fun nx x => Decidable.not_imp_symm (fun h => ⟨x, h⟩) nx, - not_forall_of_exists_not⟩ - protected alias ⟨Decidable.exists_not_of_not_forall, _⟩ := Decidable.not_forall -protected theorem Decidable.not_forall_not {p : α → Prop} [Decidable (∃ x, p x)] : - (¬∀ x, ¬p x) ↔ ∃ x, p x := - (@Decidable.not_iff_comm _ _ _ (decidable_of_iff (¬∃ x, p x) not_exists)).1 not_exists - -protected theorem Decidable.not_exists_not {p : α → Prop} [∀ x, Decidable (p x)] : - (¬∃ x, ¬p x) ↔ ∀ x, p x := by - simp only [not_exists, Decidable.not_not] - /-! ## classical logic -/ namespace Classical -/-- The Double Negation Theorem: `¬¬P` is equivalent to `P`. -The left-to-right direction, double negation elimination (DNE), -is classically true but not constructively. -/ -@[scoped simp] theorem not_not : ¬¬a ↔ a := Decidable.not_not - -@[simp] theorem not_forall {p : α → Prop} : (¬∀ x, p x) ↔ ∃ x, ¬p x := - Decidable.not_forall - alias ⟨exists_not_of_not_forall, _⟩ := not_forall -theorem not_forall_not {p : α → Prop} : (¬∀ x, ¬p x) ↔ ∃ x, p x := Decidable.not_forall_not - -theorem not_exists_not {p : α → Prop} : (¬∃ x, ¬p x) ↔ ∀ x, p x := Decidable.not_exists_not - -theorem forall_or_exists_not (P : α → Prop) : (∀ a, P a) ∨ ∃ a, ¬ P a := by - rw [← not_forall]; exact em _ - -theorem exists_or_forall_not (P : α → Prop) : (∃ a, P a) ∨ ∀ a, ¬ P a := by - rw [← not_exists]; exact em _ - -theorem or_iff_not_imp_left : a ∨ b ↔ (¬a → b) := - Decidable.or_iff_not_imp_left - -theorem or_iff_not_imp_right : a ∨ b ↔ (¬b → a) := - Decidable.or_iff_not_imp_right - -theorem not_imp_iff_and_not : ¬(a → b) ↔ a ∧ ¬b := - Decidable.not_imp_iff_and_not - -theorem not_and_iff_or_not_not : ¬(a ∧ b) ↔ ¬a ∨ ¬b := - Decidable.not_and_iff_or_not_not - -theorem not_iff : ¬(a ↔ b) ↔ (¬a ↔ b) := - Decidable.not_iff - end Classical /-! ## equality -/ @@ -824,92 +125,11 @@ theorem ne_of_mem_of_not_mem' (h : a ∈ s) : a ∉ t → s ≠ t := mt fun e => end Mem -/-! ## if-then-else -/ - -@[simp] theorem if_true {h : Decidable True} (t e : α) : ite True t e = t := if_pos trivial - -@[simp] theorem if_false {h : Decidable False} (t e : α) : ite False t e = e := if_neg id - -theorem ite_id [Decidable c] {α} (t : α) : (if c then t else t) = t := by split <;> rfl - -/-- A function applied to a `dite` is a `dite` of that function applied to each of the branches. -/ -theorem apply_dite (f : α → β) (P : Prop) [Decidable P] (x : P → α) (y : ¬P → α) : - f (dite P x y) = dite P (fun h => f (x h)) (fun h => f (y h)) := by - by_cases h : P <;> simp [h] - -/-- A function applied to a `ite` is a `ite` of that function applied to each of the branches. -/ -theorem apply_ite (f : α → β) (P : Prop) [Decidable P] (x y : α) : - f (ite P x y) = ite P (f x) (f y) := - apply_dite f P (fun _ => x) (fun _ => y) - -/-- Negation of the condition `P : Prop` in a `dite` is the same as swapping the branches. -/ -@[simp] theorem dite_not (P : Prop) {_ : Decidable P} (x : ¬P → α) (y : ¬¬P → α) : - dite (¬P) x y = dite P (fun h => y (not_not_intro h)) x := by - by_cases h : P <;> simp [h] - -/-- Negation of the condition `P : Prop` in a `ite` is the same as swapping the branches. -/ -@[simp] theorem ite_not (P : Prop) {_ : Decidable P} (x y : α) : ite (¬P) x y = ite P y x := - dite_not P (fun _ => x) (fun _ => y) - -@[simp] theorem dite_eq_left_iff {P : Prop} [Decidable P] {B : ¬ P → α} : - dite P (fun _ => a) B = a ↔ ∀ h, B h = a := by - by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false] - -@[simp] theorem dite_eq_right_iff {P : Prop} [Decidable P] {A : P → α} : - (dite P A fun _ => b) = b ↔ ∀ h, A h = b := by - by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false] - -@[simp] theorem ite_eq_left_iff {P : Prop} [Decidable P] : ite P a b = a ↔ ¬P → b = a := - dite_eq_left_iff - -@[simp] theorem ite_eq_right_iff {P : Prop} [Decidable P] : ite P a b = b ↔ P → a = b := - dite_eq_right_iff - -/-- A `dite` whose results do not actually depend on the condition may be reduced to an `ite`. -/ -@[simp] theorem dite_eq_ite [Decidable P] : (dite P (fun _ => a) fun _ => b) = ite P a b := rfl - --- We don't mark this as `simp` as it is already handled by `ite_eq_right_iff`. -theorem ite_some_none_eq_none [Decidable P] : - (if P then some x else none) = none ↔ ¬ P := by - simp only [ite_eq_right_iff] - -@[simp] theorem ite_some_none_eq_some [Decidable P] : - (if P then some x else none) = some y ↔ P ∧ x = y := by - split <;> simp_all - /-! ## miscellaneous -/ -attribute [simp] inline - -/-- Ex falso, the nondependent eliminator for the `Empty` type. -/ -def Empty.elim : Empty → C := nofun - -instance : Subsingleton Empty := ⟨fun a => a.elim⟩ - -instance : DecidableEq Empty := fun a => a.elim - -/-- Ex falso, the nondependent eliminator for the `PEmpty` type. -/ -def PEmpty.elim : PEmpty → C := nofun - -instance : Subsingleton PEmpty := ⟨fun a => a.elim⟩ - -instance : DecidableEq PEmpty := fun a => a.elim - -@[simp] theorem not_nonempty_empty : ¬Nonempty Empty := fun ⟨h⟩ => h.elim - +@[simp] theorem not_nonempty_empty : ¬Nonempty Empty := fun ⟨h⟩ => h.elim @[simp] theorem not_nonempty_pempty : ¬Nonempty PEmpty := fun ⟨h⟩ => h.elim -instance [Subsingleton α] [Subsingleton β] : Subsingleton (α × β) := - ⟨fun {..} {..} => by congr <;> apply Subsingleton.elim⟩ - -instance : Inhabited (Sort _) := ⟨PUnit⟩ - -instance : Inhabited default := ⟨PUnit.unit⟩ - -instance {α β} [Inhabited α] : Inhabited (PSum α β) := ⟨PSum.inl default⟩ - -instance {α β} [Inhabited β] : Inhabited (PSum α β) := ⟨PSum.inr default⟩ - -- TODO(Mario): profile first, this is a dangerous instance -- instance (priority := 10) {α} [Subsingleton α] : DecidableEq α -- | a, b => isTrue (Subsingleton.elim a b) @@ -925,14 +145,5 @@ theorem subsingleton_of_forall_eq (x : α) (h : ∀ y, y = x) : Subsingleton α theorem subsingleton_iff_forall_eq (x : α) : Subsingleton α ↔ ∀ y, y = x := ⟨fun _ y => Subsingleton.elim y x, subsingleton_of_forall_eq x⟩ -example [Subsingleton α] (p : α → Prop) : Subsingleton (Subtype p) := - ⟨fun ⟨x, _⟩ ⟨y, _⟩ => by congr; exact Subsingleton.elim x y⟩ - -theorem false_ne_true : False ≠ True := fun h => h.symm ▸ trivial - -theorem Bool.eq_iff_iff {a b : Bool} : a = b ↔ (a ↔ b) := by cases b <;> simp - -theorem ne_comm {α} {a b : α} : a ≠ b ↔ b ≠ a := ⟨Ne.symm, Ne.symm⟩ - theorem congr_eqRec {β : α → Sort _} (f : (x : α) → β x → γ) (h : x = x') (y : β x) : f x' (Eq.rec y h) = f x y := by cases h; rfl diff --git a/Std/Tactic/HaveI.lean b/Std/Tactic/HaveI.lean deleted file mode 100644 index 91177c3543..0000000000 --- a/Std/Tactic/HaveI.lean +++ /dev/null @@ -1,63 +0,0 @@ -/- -Copyright (c) 2022 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ -import Lean.Elab.ElabRules -open Lean Elab Parser Term Meta Macro - -/-! -Defines variants of `have` and `let` syntax which do not produce `let_fun` or `let` bindings, -but instead inline the value instead. - -This is useful to declare local instances and proofs in theorem statements -and subgoals, where the extra binding is inconvenient. --/ - -namespace Std.Tactic - -/-- `haveI` behaves like `have`, but inlines the value instead of producing a `let_fun` term. -/ -@[term_parser] def «haveI» := leading_parser - withPosition ("haveI " >> haveDecl) >> optSemicolon termParser -/-- `letI` behaves like `let`, but inlines the value instead of producing a `let_fun` term. -/ -@[term_parser] def «letI» := leading_parser - withPosition ("letI " >> haveDecl) >> optSemicolon termParser - -macro_rules - | `(haveI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) => - `(haveI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body) - | `(haveI _ $bs* := $val; $body) => `(haveI x $bs* : _ := $val; $body) - | `(haveI _ $bs* : $ty := $val; $body) => `(haveI x $bs* : $ty := $val; $body) - | `(haveI $x:ident $bs* := $val; $body) => `(haveI $x $bs* : _ := $val; $body) - | `(haveI $_:ident $_* : $_ := $_; $_) => throwUnsupported -- handled by elab - -macro_rules - | `(letI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) => - `(letI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body) - | `(letI _ $bs* := $val; $body) => `(letI x $bs* : _ := $val; $body) - | `(letI _ $bs* : $ty := $val; $body) => `(letI x $bs* : $ty := $val; $body) - | `(letI $x:ident $bs* := $val; $body) => `(letI $x $bs* : _ := $val; $body) - | `(letI $_:ident $_* : $_ := $_; $_) => throwUnsupported -- handled by elab - -elab_rules <= expectedType - | `(haveI $x:ident $bs* : $ty := $val; $body) => do - let (ty, val) ← elabBinders bs fun bs => do - let ty ← elabType ty - let val ← elabTermEnsuringType val ty - pure (← mkForallFVars bs ty, ← mkLambdaFVars bs val) - withLocalDeclD x.getId ty fun x => do - return (← (← elabTerm body expectedType).abstractM #[x]).instantiate #[val] - -elab_rules <= expectedType - | `(letI $x:ident $bs* : $ty := $val; $body) => do - let (ty, val) ← elabBinders bs fun bs => do - let ty ← elabType ty - let val ← elabTermEnsuringType val ty - pure (← mkForallFVars bs ty, ← mkLambdaFVars bs val) - withLetDecl x.getId ty val fun x => do - return (← (← elabTerm body expectedType).abstractM #[x]).instantiate #[val] - -/-- `haveI` behaves like `have`, but inlines the value instead of producing a `let_fun` term. -/ -macro "haveI" d:haveDecl : tactic => `(tactic| refine_lift haveI $d:haveDecl; ?_) -/-- `letI` behaves like `let`, but inlines the value instead of producing a `let_fun` term. -/ -macro "letI" d:haveDecl : tactic => `(tactic| refine_lift letI $d:haveDecl; ?_) diff --git a/Std/Tactic/Omega.lean b/Std/Tactic/Omega.lean index 2e9cff9076..aa637bf4dd 100644 --- a/Std/Tactic/Omega.lean +++ b/Std/Tactic/Omega.lean @@ -5,7 +5,6 @@ Authors: Scott Morrison -/ import Std.Tactic.Omega.Frontend - /-! # `omega` diff --git a/Std/Tactic/Omega/Int.lean b/Std/Tactic/Omega/Int.lean index 2fd621c6d9..15615fba7c 100644 --- a/Std/Tactic/Omega/Int.lean +++ b/Std/Tactic/Omega/Int.lean @@ -5,7 +5,6 @@ Authors: Scott Morrison -/ import Std.Classes.Order import Std.Data.Int.Init.Order -import Std.Data.Prod.Lex /-! # Lemmas about `Nat` and `Int` needed internally by `omega`. diff --git a/Std/Tactic/Omega/IntList.lean b/Std/Tactic/Omega/IntList.lean index 99dd7ed227..b4392fe543 100644 --- a/Std/Tactic/Omega/IntList.lean +++ b/Std/Tactic/Omega/IntList.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.List.Init.Lemmas -import Std.Data.Nat.Init.Gcd import Std.Data.Int.Init.DivMod import Std.Data.Option.Init.Lemmas import Std.Tactic.Simpa diff --git a/Std/Tactic/Omega/Logic.lean b/Std/Tactic/Omega/Logic.lean index 7f699a7731..86a695df0b 100644 --- a/Std/Tactic/Omega/Logic.lean +++ b/Std/Tactic/Omega/Logic.lean @@ -5,7 +5,6 @@ Authors: Scott Morrison -/ import Std.Tactic.Alias -import Std.Logic /-! # Specializations of basic logic lemmas @@ -13,7 +12,7 @@ import Std.Logic These are useful for `omega` while constructing proofs, but not considered generally useful so are hidden in the `Std.Tactic.Omega` namespace. -If you find yourself needing them elsewhere, please move them first to `Std.Logic`. +If you find yourself needing them elsewhere, please move them first to another file. -/ namespace Std.Tactic.Omega diff --git a/Std/Tactic/Omega/MinNatAbs.lean b/Std/Tactic/Omega/MinNatAbs.lean index 274d2c6ddc..88621f0709 100644 --- a/Std/Tactic/Omega/MinNatAbs.lean +++ b/Std/Tactic/Omega/MinNatAbs.lean @@ -6,6 +6,7 @@ Authors: Scott Morrison import Std.Data.List.Init.Lemmas import Std.Data.Int.Init.Order import Std.Data.Option.Lemmas +import Std.Tactic.Init /-! # `List.nonzeroMinimum`, `List.minNatAbs`, `List.maxNatAbs` diff --git a/Std/Tactic/Omega/OmegaM.lean b/Std/Tactic/Omega/OmegaM.lean index 0be6dc0383..d4f20ec405 100644 --- a/Std/Tactic/Omega/OmegaM.lean +++ b/Std/Tactic/Omega/OmegaM.lean @@ -8,6 +8,7 @@ import Std.Tactic.Omega.LinearCombo import Std.Tactic.Omega.Config import Std.Lean.Expr import Std.Lean.HashSet +import Std.Classes.SetNotation /-! # The `OmegaM` state monad. diff --git a/Std/Tactic/PermuteGoals.lean b/Std/Tactic/PermuteGoals.lean index e085e8b944..8f267c50f4 100644 --- a/Std/Tactic/PermuteGoals.lean +++ b/Std/Tactic/PermuteGoals.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Mario Carneiro -/ import Std.Data.List.Basic +import Lean.Elab.Tactic.Basic /-! # The `on_goal`, `pick_goal`, and `swap` tactics. diff --git a/Std/Tactic/RunCmd.lean b/Std/Tactic/RunCmd.lean deleted file mode 100644 index e2887935ac..0000000000 --- a/Std/Tactic/RunCmd.lean +++ /dev/null @@ -1,84 +0,0 @@ -/- -Copyright (c) 2018 Sebastian Ullrich. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sebastian Ullrich, Mario Carneiro --/ -import Lean.Elab.Eval -import Lean.Elab.Command -import Std.Tactic.Lint.Misc - -/-! -Defines commands to compile and execute a command / term / tactic on the spot: - -* `run_cmd doSeq` command which executes code in `CommandElabM Unit`. - This is almost the same as `#eval show CommandElabM Unit from do doSeq`, - except that it doesn't print an empty diagnostic. - -* `run_tac doSeq` tactic which executes code in `TacticM Unit`. - -* `by_elab doSeq` term which executes code in `TermElabM Expr` to produce an expression. --/ - -namespace Std.Tactic.RunCmd -open Lean Meta Elab Command Term Tactic - -/-- -The `run_cmd doSeq` command executes code in `CommandElabM Unit`. -This is almost the same as `#eval show CommandElabM Unit from do doSeq`, -except that it doesn't print an empty diagnostic. --/ -elab (name := runCmd) "run_cmd " elems:doSeq : command => do - ← liftTermElabM <| - unsafe evalTerm (CommandElabM Unit) - (mkApp (mkConst ``CommandElabM) (mkConst ``Unit)) - (← `(discard do $elems)) - -/-- -The `run_elab doSeq` command executes code in `TermElabM Unit`. -This is almost the same as `#eval show TermElabM Unit from do doSeq`, -except that it doesn't print an empty diagnostic. --/ -elab (name := runElab) "run_elab " elems:doSeq : command => do - ← liftTermElabM <| - unsafe evalTerm (CommandElabM Unit) - (mkApp (mkConst ``CommandElabM) (mkConst ``Unit)) - (← `(Command.liftTermElabM <| discard do $elems)) - -/-- -The `run_meta doSeq` command executes code in `MetaM Unit`. -This is almost the same as `#eval show MetaM Unit from do doSeq`, -except that it doesn't print an empty diagnostic. - -(This is effectively a synonym for `run_elab`.) --/ -macro (name := runMeta) "run_meta " elems:doSeq : command => - `(command| run_elab (show MetaM Unit from do $elems)) - -/-- The `run_tac doSeq` tactic executes code in `TacticM Unit`. -/ -elab (name := runTac) "run_tac " e:doSeq : tactic => do - ← unsafe evalTerm (TacticM Unit) (mkApp (mkConst ``TacticM) (mkConst ``Unit)) - (← `(discard do $e)) - -/-- -* The `by_elab doSeq` expression runs the `doSeq` as a `TermElabM Expr` to - synthesize the expression. -* `by_elab fun expectedType? => do doSeq` receives the expected type (an `Option Expr`) - as well. --/ -syntax (name := byElab) "by_elab " doSeq : term - -/-- Elaborator for `by_elab`. -/ -@[term_elab byElab, nolint unusedHavesSuffices] -def elabRunElab : TermElab := fun -| `(by_elab $cmds:doSeq), expectedType? => do - if let `(Lean.Parser.Term.doSeq| $e:term) := cmds then - if e matches `(Lean.Parser.Term.doSeq| fun $[$_args]* => $_) then - let tac ← unsafe evalTerm - (Option Expr → TermElabM Expr) - (Lean.mkForall `x .default - (mkApp (mkConst ``Option) (mkConst ``Expr)) - (mkApp (mkConst ``TermElabM) (mkConst ``Expr))) e - return ← tac expectedType? - (← unsafe evalTerm (TermElabM Expr) (mkApp (mkConst ``TermElabM) (mkConst ``Expr)) - (← `(do $cmds))) -| _, _ => throwUnsupportedSyntax diff --git a/Std/Tactic/SolveByElim.lean b/Std/Tactic/SolveByElim.lean index 104d4c7ab7..522b3558b2 100644 --- a/Std/Tactic/SolveByElim.lean +++ b/Std/Tactic/SolveByElim.lean @@ -294,7 +294,7 @@ where if cfg.backtracking then backtrack cfg `Meta.Tactic.solveByElim (applyLemmas cfg lemmas ctx) else - repeat1' (maxIters := cfg.maxDepth) (applyFirstLemma cfg lemmas ctx) + Lean.Meta.repeat1' (maxIters := cfg.maxDepth) (applyFirstLemma cfg lemmas ctx) /-- A `MetaM` analogue of the `apply_rules` user tactic. diff --git a/Std/Tactic/SolveByElim/Backtrack.lean b/Std/Tactic/SolveByElim/Backtrack.lean index 63d36e889a..91f5606b47 100644 --- a/Std/Tactic/SolveByElim/Backtrack.lean +++ b/Std/Tactic/SolveByElim/Backtrack.lean @@ -6,6 +6,7 @@ Authors: Scott Morrison import Std.Control.Nondet.Basic import Std.Data.List.Basic import Std.Lean.Except +import Std.Lean.Meta.Basic /-! # `backtrack` diff --git a/Std/Util/ExtendedBinder.lean b/Std/Util/ExtendedBinder.lean index dfdbcc62ff..e49b2f3f3c 100644 --- a/Std/Util/ExtendedBinder.lean +++ b/Std/Util/ExtendedBinder.lean @@ -13,41 +13,6 @@ Defines an extended binder syntax supporting `∀ ε > 0, ...` etc. namespace Std.ExtendedBinder open Lean -/-- -The syntax category of binder predicates contains predicates like `> 0`, `∈ s`, etc. -(`: t` should not be a binder predicate because it would clash with the built-in syntax for ∀/∃.) --/ -declare_syntax_cat binderPred - -/-- -`satisfies_binder_pred% t pred` expands to a proposition expressing that `t` satisfies `pred`. --/ -syntax "satisfies_binder_pred% " term:max binderPred : term - --- Extend ∀ and ∃ to binder predicates. - -/-- -The notation `∃ x < 2, p x` is shorthand for `∃ x, x < 2 ∧ p x`, -and similarly for other binary operators. --/ -syntax "∃ " binderIdent binderPred ", " term : term -/-- -The notation `∀ x < 2, p x` is shorthand for `∀ x, x < 2 → p x`, -and similarly for other binary operators. --/ -syntax "∀ " binderIdent binderPred ", " term : term - -macro_rules - | `(∃ $x:ident $pred:binderPred, $p) => - `(∃ $x:ident, satisfies_binder_pred% $x $pred ∧ $p) - | `(∃ _ $pred:binderPred, $p) => - `(∃ x, satisfies_binder_pred% x $pred ∧ $p) - -macro_rules - | `(∀ $x:ident $pred:binderPred, $p) => - `(∀ $x:ident, satisfies_binder_pred% $x $pred → $p) - | `(∀ _ $pred:binderPred, $p) => - `(∀ x, satisfies_binder_pred% x $pred → $p) -- We also provide special versions of ∀/∃ that take a list of extended binders. -- The built-in binders are not reused because that results in overloaded syntax. @@ -99,27 +64,6 @@ syntax (name := binderPredicate) (docComment)? (Parser.Term.attributes)? (attrKi "binder_predicate" optNamedName optNamedPrio ppSpace ident (ppSpace macroArg)* " => " term : command --- adapted from the macro macro -open Elab Command in -elab_rules : command - | `($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind binder_predicate%$tk - $[(name := $name?)]? $[(priority := $prio?)]? $x $args:macroArg* => $rhs) => do - let prio ← liftMacroM do evalOptPrio prio? - let (stxParts, patArgs) := (← args.mapM expandMacroArg).unzip - let name ← match name? with - | some name => pure name.getId - | none => liftMacroM do mkNameFromParserSyntax `binderTerm (mkNullNode stxParts) - let nameTk := name?.getD (mkIdentFrom tk name) - /- The command `syntax [] ...` adds the current namespace to the syntax node kind. - So, we must include current namespace when we create a pattern for the following - `macro_rules` commands. -/ - let pat : TSyntax `binderPred := ⟨(mkNode ((← getCurrNamespace) ++ name) patArgs).1⟩ - elabCommand <|<- - `($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind syntax%$tk - (name := $nameTk) (priority := $(quote prio)) $[$stxParts]* : binderPred - $[$doc?:docComment]? macro_rules%$tk - | `(satisfies_binder_pred% $$($x):term $pat:binderPred) => $rhs) - open Linter.MissingDocs Parser Term in /-- Missing docs handler for `binder_predicate` -/ @[missing_docs_handler binderPredicate] @@ -127,14 +71,3 @@ def checkBinderPredicate : SimpleHandler := fun stx => do if stx[0].isNone && stx[2][0][0].getKind != ``«local» then if stx[4].isNone then lint stx[3] "binder predicate" else lintNamed stx[4][0][3] "binder predicate" - -/-- Declare `∃ x > y, ...` as syntax for `∃ x, x > y ∧ ...` -/ -binder_predicate x " > " y:term => `($x > $y) -/-- Declare `∃ x ≥ y, ...` as syntax for `∃ x, x ≥ y ∧ ...` -/ -binder_predicate x " ≥ " y:term => `($x ≥ $y) -/-- Declare `∃ x < y, ...` as syntax for `∃ x, x < y ∧ ...` -/ -binder_predicate x " < " y:term => `($x < $y) -/-- Declare `∃ x ≤ y, ...` as syntax for `∃ x, x ≤ y ∧ ...` -/ -binder_predicate x " ≤ " y:term => `($x ≤ $y) -/-- Declare `∃ x ≠ y, ...` as syntax for `∃ x, x ≠ y ∧ ...` -/ -binder_predicate x " ≠ " y:term => `($x ≠ $y) diff --git a/lean-toolchain b/lean-toolchain index 2d47fabe49..cb3c234625 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-14 +leanprover/lean4:nightly-2024-02-15 diff --git a/scripts/nolints.json b/scripts/nolints.json index 274f119219..6a1efa2eaf 100644 --- a/scripts/nolints.json +++ b/scripts/nolints.json @@ -42,4 +42,5 @@ ["docBlame", "Std.BitVec.reduceUShiftRight"], ["docBlame", "Std.BitVec.reduceXOr"], ["docBlame", "Std.BitVec.reduceZeroExtend"], - ["docBlame", "Std.BitVec.reduceZeroExtend'"]] \ No newline at end of file + ["docBlame", "Std.BitVec.reduceZeroExtend'"], + ["unusedArguments", "imp_intro"]] diff --git a/test.lean b/test.lean new file mode 100644 index 0000000000..b3ade4dbd7 --- /dev/null +++ b/test.lean @@ -0,0 +1,9 @@ +import Std + +theorem ofBool_eq_iff_eq (b b' : Bool) : BitVec.ofBool b = BitVec.ofBool b' ↔ b = b' := by + cases b <;> cases b' +--#print ite_t +example (p q : Prop) (h : ¬p) : p → q ↔ true := by + std_apply? + +-- by_cases h : p <;> simp [h] diff --git a/test/isIndependentOf.lean b/test/isIndependentOf.lean index 74348f1d2d..59e9363ad7 100644 --- a/test/isIndependentOf.lean +++ b/test/isIndependentOf.lean @@ -1,3 +1,4 @@ +import Std.Lean.Meta.Basic import Std.Tactic.PermuteGoals import Std.Tactic.GuardMsgs diff --git a/test/lintTC.lean b/test/lintTC.lean index d9c14db5f5..9a2afb7e29 100644 --- a/test/lintTC.lean +++ b/test/lintTC.lean @@ -1,6 +1,5 @@ import Std.Tactic.Lint.TypeClass import Std.Tactic.GuardMsgs -import Std.Tactic.RunCmd open Std.Tactic.Lint diff --git a/test/lintsimp.lean b/test/lintsimp.lean index 7551bafcdd..29c03b2e53 100644 --- a/test/lintsimp.lean +++ b/test/lintsimp.lean @@ -1,6 +1,5 @@ import Std.Tactic.Lint import Std.Tactic.GuardMsgs -import Std.Tactic.RunCmd open Std.Tactic.Lint set_option linter.missingDocs false @@ -13,8 +12,8 @@ def h : Nat := 0 run_meta guard (← [``fg, ``fh].anyM fun n => return (← simpNF.test n).isSome) -@[simp] theorem and_comm : a ∧ b ↔ b ∧ a := And.comm -run_meta guard (← simpComm.test ``and_comm).isSome +@[simp] theorem test_and_comm : a ∧ b ↔ b ∧ a := And.comm +run_meta guard (← simpComm.test ``test_and_comm).isSome @[simp] theorem Prod.mk_fst : (a, b).1 = id a := rfl run_meta guard (← simpVarHead.test ``Prod.mk_fst).isSome diff --git a/test/print_prefix.lean b/test/print_prefix.lean index 4446591040..a80badc41b 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -1,14 +1,17 @@ import Std.Tactic.PrintPrefix import Std.Tactic.GuardMsgs +inductive TEmpty : Type /-- -info: Empty : Type -Empty.casesOn : (motive : Empty → Sort u) → (t : Empty) → motive t -Empty.rec : (motive : Empty → Sort u) → (t : Empty) → motive t -Empty.recOn : (motive : Empty → Sort u) → (t : Empty) → motive t +info: TEmpty : Type +TEmpty.casesOn : (motive : TEmpty → Sort u) → (t : TEmpty) → motive t +TEmpty.noConfusion : {P : Sort u} → {v1 v2 : TEmpty} → v1 = v2 → TEmpty.noConfusionType P v1 v2 +TEmpty.noConfusionType : Sort u → TEmpty → TEmpty → Sort u +TEmpty.rec : (motive : TEmpty → Sort u) → (t : TEmpty) → motive t +TEmpty.recOn : (motive : TEmpty → Sort u) → (t : TEmpty) → motive t -/ #guard_msgs in -#print prefix Empty -- Test type that probably won't change much. +#print prefix TEmpty -- Test type that probably won't change much. /-- -/ diff --git a/test/run_cmd.lean b/test/run_cmd.lean index eeefab07d7..acb2e24065 100644 --- a/test/run_cmd.lean +++ b/test/run_cmd.lean @@ -1,5 +1,4 @@ import Lean.Elab.Tactic.ElabTerm -import Std.Tactic.RunCmd import Std.Tactic.GuardMsgs open Lean Elab Tactic From edae3656f50479db122d619ff16b013265c505c2 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 16 Feb 2024 19:10:30 +1100 Subject: [PATCH 058/213] ripping stuff out --- Std.lean | 3 - Std/Classes/Cast.lean | 62 ------- Std/Control/Lemmas.lean | 1 - Std/Data/BitVec/Lemmas.lean | 2 - Std/Data/ByteArray.lean | 1 - Std/Data/Char.lean | 1 - Std/Data/Fin/Lemmas.lean | 1 - Std/Data/Int/Basic.lean | 173 -------------------- Std/Data/Int/Init/Lemmas.lean | 2 - Std/Data/List/Basic.lean | 1 - Std/Data/List/Lemmas.lean | 1 - Std/Data/Option.lean | 1 - Std/Data/Option/Init/Lemmas.lean | 23 --- Std/Data/Option/Lemmas.lean | 2 - Std/Data/Rat/Basic.lean | 1 - Std/Data/String/Lemmas.lean | 1 - Std/Data/Sum/Lemmas.lean | 1 - Std/Data/UInt.lean | 1 - Std/Lean/Expr.lean | 33 ---- Std/Lean/HashSet.lean | 8 - Std/Tactic/Congr.lean | 2 +- Std/Tactic/Ext.lean | 234 --------------------------- Std/Tactic/Ext/Attr.lean | 109 ------------- Std/Tactic/NormCast.lean | 1 - Std/Tactic/Omega/Coeffs/IntList.lean | 6 + Std/Tactic/Omega/IntList.lean | 1 - lean-toolchain | 2 +- test/ext.lean | 1 - 28 files changed, 8 insertions(+), 667 deletions(-) delete mode 100644 Std/Classes/Cast.lean delete mode 100644 Std/Data/Int/Basic.lean delete mode 100644 Std/Data/Option/Init/Lemmas.lean delete mode 100644 Std/Tactic/Ext.lean delete mode 100644 Std/Tactic/Ext/Attr.lean diff --git a/Std.lean b/Std.lean index 95623d568c..ff33689101 100644 --- a/Std.lean +++ b/Std.lean @@ -1,5 +1,4 @@ import Std.Classes.BEq -import Std.Classes.Cast import Std.Classes.Order import Std.Classes.RatCast import Std.Classes.SatisfiesM @@ -84,8 +83,6 @@ import Std.Tactic.Case import Std.Tactic.Classical import Std.Tactic.Congr import Std.Tactic.Exact -import Std.Tactic.Ext -import Std.Tactic.Ext.Attr import Std.Tactic.FalseOrByContra import Std.Tactic.GuardMsgs import Std.Tactic.Init diff --git a/Std/Classes/Cast.lean b/Std/Classes/Cast.lean deleted file mode 100644 index 9adeb6ebe0..0000000000 --- a/Std/Classes/Cast.lean +++ /dev/null @@ -1,62 +0,0 @@ -/- -Copyright (c) 2014 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro, Gabriel Ebner --/ -import Std.Util.LibraryNote - -/-- Type class for the canonical homomorphism `Nat → R`. -/ -class NatCast (R : Type u) where - /-- The canonical map `Nat → R`. -/ - protected natCast : Nat → R - -instance : NatCast Nat where natCast n := n -instance : NatCast Int where natCast n := Int.ofNat n - -/-- Canonical homomorphism from `Nat` to a additive monoid `R` with a `1`. -This is just the bare function in order to aid in creating instances of `AddMonoidWithOne`. -/ -@[coe, reducible, match_pattern] protected def Nat.cast {R : Type u} [NatCast R] : Nat → R := - NatCast.natCast - --- see note [coercion into rings] -instance [NatCast R] : CoeTail Nat R where coe := Nat.cast - --- see note [coercion into rings] -instance [NatCast R] : CoeHTCT Nat R where coe := Nat.cast - -/-- This instance is needed to ensure that `instCoeNatInt` from core is not used. -/ -instance : Coe Nat Int where coe := Nat.cast - -/-- Type class for the canonical homomorphism `Int → R`. -/ -class IntCast (R : Type u) where - /-- The canonical map `Int → R`. -/ - protected intCast : Int → R - -instance : IntCast Int where intCast n := n - -/-- Canonical homomorphism from `Int` to a additive group `R` with a `1`. -This is just the bare function in order to aid in creating instances of `AddGroupWithOne`. -/ -@[coe, reducible, match_pattern] protected def Int.cast {R : Type u} [IntCast R] : Int → R := - IntCast.intCast - --- see note [coercion into rings] -instance [IntCast R] : CoeTail Int R where coe := Int.cast - --- see note [coercion into rings] -instance [IntCast R] : CoeHTCT Int R where coe := Int.cast - -library_note "coercion into rings" -/-- -Coercions such as `Nat.castCoe` that go from a concrete structure such as -`Nat` to an arbitrary ring `R` should be set up as follows: -```lean -instance : CoeTail Nat R where coe := ... -instance : CoeHTCT Nat R where coe := ... -``` - -It needs to be `CoeTail` instead of `Coe` because otherwise type-class -inference would loop when constructing the transitive coercion `Nat → Nat → Nat → ...`. -Sometimes we also need to declare the `CoeHTCT` instance -if we need to shadow another coercion -(e.g. `Nat.cast` should be used over `Int.ofNat`). --/ diff --git a/Std/Control/Lemmas.lean b/Std/Control/Lemmas.lean index 1a5e388bce..a874ac2473 100644 --- a/Std/Control/Lemmas.lean +++ b/Std/Control/Lemmas.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 François G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ -import Std.Tactic.Ext namespace ReaderT diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index 9faca2e952..f491389098 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -7,8 +7,6 @@ import Std.Data.Bool import Std.Data.BitVec.Basic import Std.Data.Fin.Lemmas import Std.Data.Nat.Lemmas - -import Std.Tactic.Ext import Std.Tactic.Simpa import Std.Tactic.Omega import Std.Util.ProofWanted diff --git a/Std/Data/ByteArray.lean b/Std/Data/ByteArray.lean index 4652153d5c..1a6d6b5df2 100644 --- a/Std/Data/ByteArray.lean +++ b/Std/Data/ByteArray.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ import Std.Data.Array.Lemmas -import Std.Tactic.Ext.Attr namespace ByteArray diff --git a/Std/Data/Char.lean b/Std/Data/Char.lean index 2c3be7cd13..5ee22c51b4 100644 --- a/Std/Data/Char.lean +++ b/Std/Data/Char.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Std.Tactic.Ext.Attr @[ext] theorem Char.ext : {a b : Char} → a.val = b.val → a = b | ⟨_,_⟩, ⟨_,_⟩, rfl => rfl diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 59e1d2d12f..6e9876b85a 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Std.Data.Fin.Basic import Std.Data.Nat.Lemmas -import Std.Tactic.Ext import Std.Tactic.Simpa import Std.Tactic.NormCast.Lemmas import Std.Tactic.Omega diff --git a/Std/Data/Int/Basic.lean b/Std/Data/Int/Basic.lean deleted file mode 100644 index c483dd63c6..0000000000 --- a/Std/Data/Int/Basic.lean +++ /dev/null @@ -1,173 +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 --/ -import Lean.ToExpr - -open Nat - -namespace Int - -/-- -`-[n+1]` is suggestive notation for `negSucc n`, which is the second constructor of -`Int` for making strictly negative numbers by mapping `n : Nat` to `-(n + 1)`. --/ -scoped notation "-[" n "+1]" => negSucc n - -/- ## sign -/ - -/-- -Returns the "sign" of the integer as another integer: `1` for positive numbers, -`-1` for negative numbers, and `0` for `0`. --/ -def sign : Int → Int - | succ _ => 1 - | 0 => 0 - | -[_+1] => -1 - -/-! ## toNat' -/ - -/-- -* If `n : Nat`, then `int.toNat' n = some n` -* If `n : Int` is negative, then `int.toNat' n = none`. --/ -def toNat' : Int → Option Nat - | (n : Nat) => some n - | -[_+1] => none - -/-! ## Quotient and remainder - -There are three main conventions for integer division, -referred here as the E, F, T rounding conventions. -All three pairs satisfy the identity `x % y + (x / y) * y = x` unconditionally, -and satisfy `x / 0 = 0` and `x % 0 = x`. --/ - -/-! ### E-rounding division - -This pair satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0`. --/ - -/-- -Integer division. This version of `Int.div` uses the E-rounding convention -(euclidean division), in which `Int.emod x y` satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0` -and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`. --/ -def ediv : Int → Int → Int - | ofNat m, ofNat n => ofNat (m / n) - | ofNat m, -[n+1] => -ofNat (m / succ n) - | -[_+1], 0 => 0 - | -[m+1], succ n => -[m / succ n +1] - | -[m+1], -[n+1] => ofNat (succ (m / succ n)) - -/-- -Integer modulus. This version of `Int.mod` uses the E-rounding convention -(euclidean division), in which `Int.emod x y` satisfies `0 ≤ emod x y < natAbs y` for `y ≠ 0` -and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`. --/ -def emod : Int → Int → Int - | ofNat m, n => ofNat (m % natAbs n) - | -[m+1], n => subNatNat (natAbs n) (succ (m % natAbs n)) - - -/-! ### F-rounding division - -This pair satisfies `fdiv x y = floor (x / y)`. --/ - -/-- -Integer division. This version of `Int.div` uses the F-rounding convention -(flooring division), in which `Int.fdiv x y` satisfies `fdiv x y = floor (x / y)` -and `Int.fmod` is the unique function satisfying `fmod x y + (fdiv x y) * y = x`. --/ -def fdiv : Int → Int → Int - | 0, _ => 0 - | ofNat m, ofNat n => ofNat (m / n) - | succ m, -[n+1] => -[m / succ n +1] - | -[_+1], 0 => 0 - | -[m+1], succ n => -[m / succ n +1] - | -[m+1], -[n+1] => ofNat (succ m / succ n) - -/-- -Integer modulus. This version of `Int.mod` uses the F-rounding convention -(flooring division), in which `Int.fdiv x y` satisfies `fdiv x y = floor (x / y)` -and `Int.fmod` is the unique function satisfying `fmod x y + (fdiv x y) * y = x`. --/ -def fmod : Int → Int → Int - | 0, _ => 0 - | ofNat m, ofNat n => ofNat (m % n) - | succ m, -[n+1] => subNatNat (m % succ n) n - | -[m+1], ofNat n => subNatNat n (succ (m % n)) - | -[m+1], -[n+1] => -ofNat (succ m % succ n) - -/-! ### T-rounding division - -This pair satisfies `div x y = round_to_zero (x / y)`. -`Int.div` and `Int.mod` are defined in core lean. --/ - -/-- -Core Lean provides instances using T-rounding division, i.e. `Int.div` and `Int.mod`. -We override these here. --/ -instance : Div Int := ⟨Int.ediv⟩ -instance : Mod Int := ⟨Int.emod⟩ - -/-! ## gcd -/ - -/-- Computes the greatest common divisor of two integers, as a `Nat`. -/ -def gcd (m n : Int) : Nat := m.natAbs.gcd n.natAbs - -/-! ## divisibility -/ - -/-- -Divisibility of integers. `a ∣ b` (typed as `\|`) says that -there is some `c` such that `b = a * c`. --/ -instance : Dvd Int := ⟨fun a b => ∃ c, b = a * c⟩ - -/-! ## bit operations -/ - -/-- -Bitwise not - -Interprets the integer as an infinite sequence of bits in two's complement -and complements each bit. -``` -~~~(0:Int) = -1 -~~~(1:Int) = -2 -~~~(-1:Int) = 0 -``` --/ -protected def not : Int -> Int - | Int.ofNat n => Int.negSucc n - | Int.negSucc n => Int.ofNat n - -instance : Complement Int := ⟨.not⟩ - -/-- -Bitwise shift right. - -Conceptually, this treats the integer as an infinite sequence of bits in two's -complement and shifts the value to the right. - -```lean -( 0b0111:Int) >>> 1 = 0b0011 -( 0b1000:Int) >>> 1 = 0b0100 -(-0b1000:Int) >>> 1 = -0b0100 -(-0b0111:Int) >>> 1 = -0b0100 -``` --/ -protected def shiftRight : Int → Nat → Int - | Int.ofNat n, s => Int.ofNat (n >>> s) - | Int.negSucc n, s => Int.negSucc (n >>> s) - -instance : HShiftRight Int Nat Int := ⟨.shiftRight⟩ - -open Lean in -instance : ToExpr Int where - toTypeExpr := .const ``Int [] - toExpr i := match i with - | .ofNat n => mkApp (.const ``Int.ofNat []) (toExpr n) - | .negSucc n => mkApp (.const ``Int.negSucc []) (toExpr n) diff --git a/Std/Data/Int/Init/Lemmas.lean b/Std/Data/Int/Init/Lemmas.lean index 8ea82a6871..cff49bb56a 100644 --- a/Std/Data/Int/Init/Lemmas.lean +++ b/Std/Data/Int/Init/Lemmas.lean @@ -3,8 +3,6 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ -import Std.Classes.Cast -import Std.Data.Int.Basic import Std.Tactic.NormCast.Lemmas open Nat diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index a60b09b962..b717201f83 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ -import Std.Data.Option.Init.Lemmas namespace List diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index ad71e8e001..4ddf7ce5d1 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -10,7 +10,6 @@ import Std.Data.Nat.Lemmas import Std.Data.List.Basic import Std.Data.Option.Lemmas import Std.Classes.BEq -import Std.Tactic.Ext import Std.Tactic.Simpa namespace List diff --git a/Std/Data/Option.lean b/Std/Data/Option.lean index a7f6b1dacf..319f745b7d 100644 --- a/Std/Data/Option.lean +++ b/Std/Data/Option.lean @@ -1,3 +1,2 @@ import Std.Data.Option.Basic -import Std.Data.Option.Init.Lemmas import Std.Data.Option.Lemmas diff --git a/Std/Data/Option/Init/Lemmas.lean b/Std/Data/Option/Init/Lemmas.lean deleted file mode 100644 index eb5f24300c..0000000000 --- a/Std/Data/Option/Init/Lemmas.lean +++ /dev/null @@ -1,23 +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 --/ - -namespace Option - -/-! -# Bootstrapping theorems for Option - -These are theorems used in the definitions of `Std.Data.List.Basic`. -New theorems should be added to `Std.Data.Option.Lemmas` if they are not needed by the bootstrap. --/ - -@[simp] theorem getD_none : getD none a = a := rfl -@[simp] theorem getD_some : getD (some a) b = a := rfl - -@[simp] theorem map_none' (f : α → β) : none.map f = none := rfl -@[simp] theorem map_some' (a) (f : α → β) : (some a).map f = some (f a) := rfl - -@[simp] theorem none_bind (f : α → Option β) : none.bind f = none := rfl -@[simp] theorem some_bind (a) (f : α → Option β) : (some a).bind f = f a := rfl diff --git a/Std/Data/Option/Lemmas.lean b/Std/Data/Option/Lemmas.lean index 5ef860bbb7..ef9afd2e9d 100644 --- a/Std/Data/Option/Lemmas.lean +++ b/Std/Data/Option/Lemmas.lean @@ -3,9 +3,7 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Data.Option.Init.Lemmas import Std.Data.Option.Basic -import Std.Tactic.Ext.Attr namespace Option diff --git a/Std/Data/Rat/Basic.lean b/Std/Data/Rat/Basic.lean index 002855654f..62a49df15a 100644 --- a/Std/Data/Rat/Basic.lean +++ b/Std/Data/Rat/Basic.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Std.Data.Nat.Gcd import Std.Data.Int.DivMod -import Std.Tactic.Ext /-! # Basics for the Rational Numbers -/ diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 74c85883ad..013b21e084 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -7,7 +7,6 @@ import Std.Data.Char import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.String.Basic -import Std.Tactic.Ext.Attr import Std.Tactic.Lint.Misc import Std.Tactic.SeqFocus import Std.Tactic.Simpa diff --git a/Std/Data/Sum/Lemmas.lean b/Std/Data/Sum/Lemmas.lean index 2491660b1a..f7766d2985 100644 --- a/Std/Data/Sum/Lemmas.lean +++ b/Std/Data/Sum/Lemmas.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro, Yury G. Kudryashov -/ import Std.Data.Sum.Basic -import Std.Tactic.Ext /-! # Disjoint union of types diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index 9cf6bf6b2b..04929fa84e 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 François G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ -import Std.Tactic.Ext.Attr /-! ### UInt8 -/ diff --git a/Std/Lean/Expr.lean b/Std/Lean/Expr.lean index 282b27cecf..2367af3892 100644 --- a/Std/Lean/Expr.lean +++ b/Std/Lean/Expr.lean @@ -128,14 +128,6 @@ def isAppOf' (e : Expr) (n : Name) : Bool := | const c .. => c == n | _ => false -/-- If the expression is a constant, return that name. Otherwise return `Name.anonymous`. -/ -def constName (e : Expr) : Name := - e.constName?.getD Name.anonymous - -/-- Return the function (name) and arguments of an application. -/ -def getAppFnArgs (e : Expr) : Name × Array Expr := - withApp e λ e a => (e.constName, a) - /-- Turns an expression that is a natural number literal into a natural number. -/ def natLit! : Expr → Nat | lit (Literal.natVal v) => v @@ -150,28 +142,3 @@ def intLit! (e : Expr) : Int := .negOfNat e.appArg!.natLit! else panic! "not a raw integer literal" - -/-- -Checks if an expression is a "natural number in normal form", -i.e. of the form `OfNat n`, where `n` matches `.lit (.natVal lit)` for some `lit`. -and if so returns `lit`. --/ --- Note that an `Expr.lit (.natVal n)` is not considered in normal form! -def nat? (e : Expr) : Option Nat := do - guard <| e.isAppOfArity ``OfNat.ofNat 3 - let lit (.natVal n) := e.appFn!.appArg! | none - n - -/-- -Checks if an expression is an "integer in normal form", -i.e. either a natural number in normal form, or the negation of a positive natural number, -and if so returns the integer. --/ -def int? (e : Expr) : Option Int := - if e.isAppOfArity ``Neg.neg 3 then - match e.appArg!.nat? with - | none => none - | some 0 => none - | some n => some (-n) - else - e.nat? diff --git a/Std/Lean/HashSet.lean b/Std/Lean/HashSet.lean index 272ea4dab0..0dedb7cd4f 100644 --- a/Std/Lean/HashSet.lean +++ b/Std/Lean/HashSet.lean @@ -73,11 +73,3 @@ protected def ofArray [BEq α] [Hashable α] (as : Array α) : HashSet α := @[inline] protected def ofList [BEq α] [Hashable α] (as : List α) : HashSet α := HashSet.empty.insertMany as - -/-- -`O(|t|)` amortized. Merge two `HashSet`s. --/ -@[inline] -def merge {α : Type u} [BEq α] [Hashable α] (s t : HashSet α) : HashSet α := - t.fold (init := s) fun s a => s.insert a - -- We don't use `insertMany` here because it gives weird universes. diff --git a/Std/Tactic/Congr.lean b/Std/Tactic/Congr.lean index ebdaf0488d..eaa1b808b3 100644 --- a/Std/Tactic/Congr.lean +++ b/Std/Tactic/Congr.lean @@ -5,7 +5,7 @@ Authors: Mario Carneiro, Miyahara Kō -/ import Lean.Meta.Tactic.Congr import Lean.Elab.Tactic.Config -import Std.Tactic.Ext +import Lean.Elab.Tactic.Ext /-! # `congr with` tactic, `rcongr` tactic -/ diff --git a/Std/Tactic/Ext.lean b/Std/Tactic/Ext.lean deleted file mode 100644 index 6681cc2385..0000000000 --- a/Std/Tactic/Ext.lean +++ /dev/null @@ -1,234 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro --/ -import Lean.Elab.Tactic.RCases -import Lean.Linter.Util -import Std.Tactic.Init -import Std.Tactic.Ext.Attr - -namespace Std.Tactic.Ext -open Lean Meta Elab Tactic - -/-- -Constructs the hypotheses for the extensionality lemma. -Calls the continuation `k` with the list of parameters to the structure, -two structure variables `x` and `y`, and a list of pairs `(field, ty)` -where `ty` is `x.field = y.field` or `HEq x.field y.field`. --/ -def withExtHyps (struct : Name) (flat : Term) - (k : Array Expr → (x y : Expr) → Array (Name × Expr) → MetaM α) : MetaM α := do - let flat ← match flat with - | `(true) => pure true - | `(false) => pure false - | _ => throwErrorAt flat "expected 'true' or 'false'" - unless isStructure (← getEnv) struct do throwError "not a structure: {struct}" - let structC ← mkConstWithLevelParams struct - forallTelescope (← inferType structC) fun params _ => do - withNewBinderInfos (params.map (·.fvarId!, BinderInfo.implicit)) do - withLocalDeclD `x (mkAppN structC params) fun x => do - withLocalDeclD `y (mkAppN structC params) fun y => do - let mut hyps := #[] - let fields := if flat then - getStructureFieldsFlattened (← getEnv) struct (includeSubobjectFields := false) - else - getStructureFields (← getEnv) struct - for field in fields do - let x_f ← mkProjection x field - let y_f ← mkProjection y field - if ← isProof x_f then - pure () - else if ← isDefEq (← inferType x_f) (← inferType y_f) then - hyps := hyps.push (field, ← mkEq x_f y_f) - else - hyps := hyps.push (field, ← mkHEq x_f y_f) - k params x y hyps - -/-- -Creates the type of the extensionality lemma for the given structure, -elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example. --/ -scoped elab "ext_type% " flat:term:max ppSpace struct:ident : term => do - withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do - let ty := hyps.foldr (init := ← mkEq x y) fun (f, h) ty => - mkForall f BinderInfo.default h ty - mkForallFVars (params |>.push x |>.push y) ty - -/-- Make an `Iff` application. -/ -def mkIff (p q : Expr) : Expr := mkApp2 (mkConst ``Iff) p q - -/-- Make an n-ary `And` application. `mkAndN []` returns `True`. -/ -def mkAndN : List Expr → Expr - | [] => mkConst ``True - | [p] => p - | p :: ps => mkAnd p (mkAndN ps) - -/-- -Creates the type of the iff-variant of the extensionality lemma for the given structure, -elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example. --/ -scoped elab "ext_iff_type% " flat:term:max ppSpace struct:ident : term => do - withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do - mkForallFVars (params |>.push x |>.push y) <| - mkIff (← mkEq x y) <| mkAndN (hyps.map (·.2)).toList - -macro_rules | `(declare_ext_theorems_for $[(flat := $f)]? $struct:ident $(prio)?) => do - let flat := f.getD (mkIdent `true) - let names ← Macro.resolveGlobalName struct.getId.eraseMacroScopes - let name ← match names.filter (·.2.isEmpty) with - | [] => Macro.throwError s!"unknown constant {struct}" - | [(name, _)] => pure name - | _ => Macro.throwError s!"ambiguous name {struct}" - let extName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext" - let extIffName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext_iff" - `(@[ext $(prio)?] protected theorem $extName:ident : ext_type% $flat $struct:ident := - fun {..} {..} => by intros; subst_eqs; rfl - protected theorem $extIffName:ident : ext_iff_type% $flat $struct:ident := - fun {..} {..} => - ⟨fun h => by cases h; split_ands <;> rfl, - fun _ => by (repeat cases ‹_ ∧ _›); subst_eqs; rfl⟩) - -/-- Apply a single extensionality lemma to `goal`. -/ -def applyExtLemma (goal : MVarId) : MetaM (List MVarId) := goal.withContext do - let tgt ← goal.getType' - unless tgt.isAppOfArity ``Eq 3 do - throwError "applyExtLemma only applies to equations, not{indentExpr tgt}" - let ty := tgt.getArg! 0 - let s ← saveState - for lem in ← getExtLemmas ty do - try - -- Note: We have to do this extra check to ensure that we don't apply e.g. - -- funext to a goal `(?a₁ : ?b) = ?a₂` to produce `(?a₁ x : ?b') = ?a₂ x`, - -- since this will loop. - -- We require that the type of the equality is not changed by the `goal.apply c` line - -- TODO: add flag to apply tactic to toggle unification vs. matching - withNewMCtxDepth do - let c ← mkConstWithFreshMVarLevels lem.declName - let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing (← inferType c) - guard (← isDefEq tgt declTy) - -- We use `newGoals := .all` as this is - -- more useful in practice with dependently typed arguments of `@[ext]` lemmas. - return ← goal.apply (cfg := { newGoals := .all }) (← mkConstWithFreshMVarLevels lem.declName) - catch _ => s.restore - throwError "no applicable extensionality lemma found for{indentExpr ty}" - -/-- Apply a single extensionality lemma to the current goal. -/ -elab "apply_ext_lemma" : tactic => liftMetaTactic applyExtLemma - -/-- -Postprocessor for `withExt` which runs `rintro` with the given patterns when the target is a -pi type. --/ -def tryIntros [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat)) - (k : MVarId → List (TSyntax `rcasesPat) → m Nat) : m Nat := do - match pats with - | [] => k (← (g.intros : TermElabM _)).2 [] - | p::ps => - if (← (g.withContext g.getType' : TermElabM _)).isForall then - let mut n := 0 - for g in ← RCases.rintro #[p] none g do - n := n.max (← tryIntros g ps k) - pure (n + 1) - else k g pats - -/-- -Applies a single extensionality lemma, using `pats` to introduce variables in the result. -Runs continuation `k` on each subgoal. --/ -def withExt1 [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat)) - (k : MVarId → List (TSyntax `rcasesPat) → m Nat) : m Nat := do - let mut n := 0 - for g in ← (applyExtLemma g : TermElabM _) do - n := n.max (← tryIntros g pats k) - pure n - -/-- -Applies a extensionality lemmas recursively, using `pats` to introduce variables in the result. -Runs continuation `k` on each subgoal. --/ -def withExtN [Monad m] [MonadLiftT TermElabM m] [MonadExcept Exception m] - (g : MVarId) (pats : List (TSyntax `rcasesPat)) (k : MVarId → List (TSyntax `rcasesPat) → m Nat) - (depth := 1000000) (failIfUnchanged := true) : m Nat := - match depth with - | 0 => k g pats - | depth+1 => do - if failIfUnchanged then - withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false) - else try - withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false) - catch _ => k g pats - -/-- -Apply extensionality lemmas as much as possible, using `pats` to introduce the variables -in extensionality lemmas like `funext`. Returns a list of subgoals. --/ -def extCore (g : MVarId) (pats : List (TSyntax `rcasesPat)) - (depth := 1000000) (failIfUnchanged := true) : - TermElabM (Nat × Array (MVarId × List (TSyntax `rcasesPat))) := do - StateT.run (m := TermElabM) (s := #[]) - (withExtN g pats (fun g qs => modify (·.push (g, qs)) *> pure 0) depth failIfUnchanged) - -/-- -* `ext pat*` applies extensionality lemmas as much as possible, - using `pat*` to introduce the variables in extensionality lemmas using `rintro`. - For example, this names the variables introduced by lemmas such as `funext`. -* `ext` applies extensionality lemmas as much as possible - but introduces anonymous variables whenever needed. -* `ext pat* : n` applies ext lemmas only up to depth `n`. - -The `ext1 pat*` tactic is like `ext pat*` except that it only applies a single extensionality lemma. - -The `ext?` tactic (note: unimplemented) has the same syntax as the `ext` tactic, -and it gives a suggestion of an equivalent tactic to use in place of `ext`. --/ -syntax "ext" (colGt ppSpace rintroPat)* (" : " num)? : tactic -elab_rules : tactic - | `(tactic| ext $pats* $[: $n]?) => do - let pats := RCases.expandRIntroPats pats - let depth := n.map (·.getNat) |>.getD 1000000 - let (used, gs) ← extCore (← getMainGoal) pats.toList depth - if RCases.linter.unusedRCasesPattern.get (← getOptions) then - if used < pats.size then - Linter.logLint RCases.linter.unusedRCasesPattern (mkNullNode pats[used:].toArray) - m!"`ext` did not consume the patterns: {pats[used:]}" - replaceMainGoal <| gs.map (·.1) |>.toList - -/-- -`ext1 pat*` is like `ext pat*` except that it only applies a single extensionality lemma rather -than recursively applying as many extensionality lemmas as possible. - -The `pat*` patterns are processed using the `rintro` tactic. -If no patterns are supplied, then variables are introduced anonymously using the `intros` tactic. - -The `ext1?` tactic (note: unimplemented) has the same syntax as the `ext1?` tactic, -and it gives a suggestion of an equivalent tactic to use in place of `ext1`. --/ -macro "ext1" xs:(colGt ppSpace rintroPat)* : tactic => - if xs.isEmpty then `(tactic| apply_ext_lemma <;> intros) - else `(tactic| apply_ext_lemma <;> rintro $xs*) - --- TODO -/-- `ext1? pat*` is like `ext1 pat*` but gives a suggestion on what pattern to use -/ -syntax "ext1?" (colGt ppSpace rintroPat)* : tactic -/-- `ext? pat*` is like `ext pat*` but gives a suggestion on what pattern to use -/ -syntax "ext?" (colGt ppSpace rintroPat)* (" : " num)? : tactic - -end Std.Tactic.Ext - -attribute [ext] funext propext Subtype.eq - -@[ext] theorem Prod.ext : {x y : Prod α β} → x.fst = y.fst → x.snd = y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl - -@[ext] theorem PProd.ext : {x y : PProd α β} → x.fst = y.fst → x.snd = y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl - -@[ext] theorem Sigma.ext : {x y : Sigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl - -@[ext] theorem PSigma.ext : {x y : PSigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl - -@[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl -protected theorem Unit.ext (x y : Unit) : x = y := rfl diff --git a/Std/Tactic/Ext/Attr.lean b/Std/Tactic/Ext/Attr.lean deleted file mode 100644 index 7b9245bc4b..0000000000 --- a/Std/Tactic/Ext/Attr.lean +++ /dev/null @@ -1,109 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro --/ -import Lean.Elab.Command - -namespace Std.Tactic.Ext -open Lean Meta - -/-- `declare_ext_theorems_for A` declares the extensionality theorems for the structure `A`. -/ -syntax "declare_ext_theorems_for " ("(" &"flat" " := " term ") ")? ident (ppSpace prio)? : command - -/-- Information about an extensionality theorem, stored in the environment extension. -/ -structure ExtTheorem where - /-- Declaration name of the extensionality theorem. -/ - declName : Name - /-- Priority of the extensionality theorem. -/ - priority : Nat - /-- Key in the discrimination tree. -/ - keys : Array DiscrTree.Key - deriving Inhabited, Repr, BEq, Hashable - -/-- The state of the `ext` extension environment -/ -structure ExtTheorems where - /-- The tree of `ext` extensions. -/ - tree : DiscrTree ExtTheorem := {} - /-- Erased `ext`s. -/ - erased : PHashSet Name := {} - deriving Inhabited - -/-- Discrimation tree settings for the `ext` extension. -/ -def extExt.config : WhnfCoreConfig := {} - -/-- The environment extension to track `@[ext]` lemmas. -/ -initialize extExtension : - SimpleScopedEnvExtension ExtTheorem ExtTheorems ← - registerSimpleScopedEnvExtension { - addEntry := fun { tree, erased } thm => - { tree := tree.insertCore thm.keys thm, erased := erased.erase thm.declName } - initial := {} - } - -/-- Get the list of `@[ext]` lemmas corresponding to the key `ty`, -ordered from high priority to low. -/ -@[inline] def getExtLemmas (ty : Expr) : MetaM (Array ExtTheorem) := do - let extTheorems := extExtension.getState (← getEnv) - let arr ← extTheorems.tree.getMatch ty extExt.config - let erasedArr := arr.filter fun thm => !extTheorems.erased.contains thm.declName - -- Using insertion sort because it is stable and the list of matches should be mostly sorted. - -- Most ext lemmas have default priority. - return erasedArr.insertionSort (·.priority < ·.priority) |>.reverse - -/-- Erases a name marked `ext` by adding it to the state's `erased` field and - removing it from the state's list of `Entry`s. -/ -def ExtTheorems.eraseCore (d : ExtTheorems) (declName : Name) : ExtTheorems := - { d with erased := d.erased.insert declName } - -/-- - Erase a name marked as a `ext` attribute. - Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem` - found somewhere in the state's tree, and is not erased. --/ -def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Name) : - m ExtTheorems := do - unless d.tree.containsValueP (·.declName == declName) && !d.erased.contains declName do - throwError "'{declName}' does not have [ext] attribute" - return d.eraseCore declName - -/-- Registers an extensionality lemma. - -* When `@[ext]` is applied to a structure, it generates `.ext` and `.ext_iff` theorems and registers - them for the `ext` tactic. - -* When `@[ext]` is applied to a theorem, the theorem is registered for the `ext` tactic. - -* You can use `@[ext 9000]` to specify a priority for the attribute. - -* You can use the flag `@[ext (flat := false)]` to prevent flattening all fields of parent - structures in the generated extensionality lemmas. -/ -syntax (name := ext) "ext" (" (" &"flat" " := " term ")")? (ppSpace prio)? : attr - -initialize registerBuiltinAttribute { - name := `ext - descr := "Marks a lemma as extensionality lemma" - add := fun declName stx kind => do - let `(attr| ext $[(flat := $f)]? $(prio)?) := stx - | throwError "unexpected @[ext] attribute {stx}" - if isStructure (← getEnv) declName then - liftCommandElabM <| Elab.Command.elabCommand <| - ← `(declare_ext_theorems_for $[(flat := $f)]? $(mkCIdentFrom stx declName) $[$prio]?) - else MetaM.run' do - if let some flat := f then - throwErrorAt flat "unexpected 'flat' config on @[ext] lemma" - let declTy := (← getConstInfo declName).type - let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing declTy - let failNotEq := throwError - "@[ext] attribute only applies to structures or lemmas proving x = y, got {declTy}" - let some (ty, lhs, rhs) := declTy.eq? | failNotEq - unless lhs.isMVar && rhs.isMVar do failNotEq - let keys ← withReducible <| DiscrTree.mkPath ty extExt.config - let priority ← liftCommandElabM do Elab.liftMacroM do - evalPrio (prio.getD (← `(prio| default))) - extExtension.add {declName, keys, priority} kind - erase := fun declName => do - let s := extExtension.getState (← getEnv) - let s ← s.erase declName - modifyEnv fun env => extExtension.modifyState env fun _ => s -} diff --git a/Std/Tactic/NormCast.lean b/Std/Tactic/NormCast.lean index e79a0971a6..71c511cccc 100644 --- a/Std/Tactic/NormCast.lean +++ b/Std/Tactic/NormCast.lean @@ -6,7 +6,6 @@ Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner import Lean.Elab.Tactic.Conv.Simp import Std.Lean.Meta.Simp import Std.Tactic.NormCast.Ext -import Std.Classes.Cast /-! # The `norm_cast` family of tactics. diff --git a/Std/Tactic/Omega/Coeffs/IntList.lean b/Std/Tactic/Omega/Coeffs/IntList.lean index 94be9e134c..75c731d31e 100644 --- a/Std/Tactic/Omega/Coeffs/IntList.lean +++ b/Std/Tactic/Omega/Coeffs/IntList.lean @@ -39,6 +39,12 @@ abbrev toList (xs : Coeffs) : List Int := xs abbrev ofList (xs : List Int) : Coeffs := xs /-- Are the coefficients all zero? -/ abbrev isZero (xs : Coeffs) : Prop := ∀ x, x ∈ xs → x = 0 + +def foo : DecidablePred isZero := + inferInstanceAs <| DecidablePred (fun (xs : Coeffs) => ∀ x, x ∈ xs → x = 0) + +#check List.decidableBAll +#synth DecidablePred isZero /-- Shim for `IntList.set`. -/ abbrev set (xs : Coeffs) (i : Nat) (y : Int) : Coeffs := IntList.set xs i y /-- Shim for `IntList.get`. -/ diff --git a/Std/Tactic/Omega/IntList.lean b/Std/Tactic/Omega/IntList.lean index b4392fe543..22db6633ef 100644 --- a/Std/Tactic/Omega/IntList.lean +++ b/Std/Tactic/Omega/IntList.lean @@ -5,7 +5,6 @@ Authors: Scott Morrison -/ import Std.Data.List.Init.Lemmas import Std.Data.Int.Init.DivMod -import Std.Data.Option.Init.Lemmas import Std.Tactic.Simpa /-- diff --git a/lean-toolchain b/lean-toolchain index cb3c234625..04371a9e85 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-15 +leanprover/lean4:nightly-2024-02-16 diff --git a/test/ext.lean b/test/ext.lean index ce730a7a5f..77ff61028b 100644 --- a/test/ext.lean +++ b/test/ext.lean @@ -1,4 +1,3 @@ -import Std.Tactic.Ext import Std.Logic import Std.Tactic.GuardMsgs From 74c7d4ef95c0df939eccbfa608fbf57e37789be5 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 16 Feb 2024 20:00:20 +1100 Subject: [PATCH 059/213] finished --- Std.lean | 1 - Std/Classes/Order.lean | 13 -- Std/Data/Array/Basic.lean | 1 - Std/Data/Array/Merge.lean | 1 - Std/Data/BinomialHeap/Basic.lean | 2 +- Std/Data/Nat/Lemmas.lean | 1 - Std/Data/Option.lean | 1 - Std/Data/Option/Basic.lean | 187 ------------------------- Std/Data/Option/Lemmas.lean | 229 +------------------------------ Std/Data/Ord.lean | 134 ------------------ Std/Data/PairingHeap.lean | 2 +- Std/Data/RBMap/Alter.lean | 2 +- Std/Lean/Meta/Basic.lean | 4 - Std/Lean/Meta/DiscrTree.lean | 1 - Std/Tactic/LibrarySearch.lean | 1 - test/congr.lean | 2 +- test/ext.lean | 1 - test/lintTC.lean | 2 - test/lintsimp.lean | 1 - 19 files changed, 8 insertions(+), 578 deletions(-) delete mode 100644 Std/Data/Option/Basic.lean delete mode 100644 Std/Data/Ord.lean diff --git a/Std.lean b/Std.lean index ff33689101..49c041911a 100644 --- a/Std.lean +++ b/Std.lean @@ -29,7 +29,6 @@ import Std.Data.List import Std.Data.MLList import Std.Data.Nat import Std.Data.Option -import Std.Data.Ord import Std.Data.PairingHeap import Std.Data.RBMap import Std.Data.Range diff --git a/Std/Classes/Order.lean b/Std/Classes/Order.lean index ce18d8f9de..f92e96c0dd 100644 --- a/Std/Classes/Order.lean +++ b/Std/Classes/Order.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Data.Ord import Std.Tactic.Simpa /-! ## Ordering -/ @@ -109,15 +108,3 @@ instance (f : α → β) (cmp : β → β → Ordering) [TransCmp cmp] : TransCm le_trans h₁ h₂ := TransCmp.le_trans (α := β) h₁ h₂ end Ordering - -@[simp] theorem ge_iff_le [LE α] {x y : α} : x ≥ y ↔ y ≤ x := Iff.rfl - -@[simp] theorem gt_iff_lt [LT α] {x y : α} : x > y ↔ y < x := Iff.rfl - -theorem le_of_eq_of_le {a b c : α} [LE α] (h₁ : a = b) (h₂ : b ≤ c) : a ≤ c := h₁ ▸ h₂ - -theorem le_of_le_of_eq {a b c : α} [LE α] (h₁ : a ≤ b) (h₂ : b = c) : a ≤ c := h₂ ▸ h₁ - -theorem lt_of_eq_of_lt {a b c : α} [LT α] (h₁ : a = b) (h₂ : b < c) : a < c := h₁ ▸ h₂ - -theorem lt_of_lt_of_eq {a b c : α} [LT α] (h₁ : a < b) (h₂ : b = c) : a < c := h₂ ▸ h₁ diff --git a/Std/Data/Array/Basic.lean b/Std/Data/Array/Basic.lean index c52d77d949..c000df3524 100644 --- a/Std/Data/Array/Basic.lean +++ b/Std/Data/Array/Basic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Floris van Doorn, Jannis Limperg -/ import Std.Data.List.Init.Attach -import Std.Data.Ord /-! ## Definitions on Arrays diff --git a/Std/Data/Array/Merge.lean b/Std/Data/Array/Merge.lean index fc7727be02..35c5f4b4b0 100644 --- a/Std/Data/Array/Merge.lean +++ b/Std/Data/Array/Merge.lean @@ -5,7 +5,6 @@ Authors: Jannis Limperg -/ import Std.Data.Nat.Lemmas -import Std.Data.Ord namespace Array diff --git a/Std/Data/BinomialHeap/Basic.lean b/Std/Data/BinomialHeap/Basic.lean index 8f2ed693bb..1756167cf8 100644 --- a/Std/Data/BinomialHeap/Basic.lean +++ b/Std/Data/BinomialHeap/Basic.lean @@ -267,7 +267,7 @@ theorem Heap.realSize_tail (le) (s : Heap α) : (s.tail le).realSize = s.realSiz simp only [Heap.tail] match eq : s.tail? le with | none => cases s with cases eq | nil => rfl - | some tl => simp [Heap.realSize_tail? eq]; rfl + | some tl => simp [Heap.realSize_tail? eq] /-- `O(n log n)`. Monadic fold over the elements of a heap in increasing order, diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index fd70d5646c..cfeec9c78d 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -6,7 +6,6 @@ Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro import Std.Tactic.Alias import Std.Tactic.Init import Std.Data.Nat.Basic -import Std.Data.Ord /-! # Basic lemmas about natural numbers diff --git a/Std/Data/Option.lean b/Std/Data/Option.lean index 319f745b7d..ef8d986852 100644 --- a/Std/Data/Option.lean +++ b/Std/Data/Option.lean @@ -1,2 +1 @@ -import Std.Data.Option.Basic import Std.Data.Option.Lemmas diff --git a/Std/Data/Option/Basic.lean b/Std/Data/Option/Basic.lean deleted file mode 100644 index 131a4ada36..0000000000 --- a/Std/Data/Option/Basic.lean +++ /dev/null @@ -1,187 +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 --/ - -namespace Option - -/-- An elimination principle for `Option`. It is a nondependent version of `Option.recOn`. -/ -@[simp, inline] protected def elim : Option α → β → (α → β) → β - | some x, _, f => f x - | none, y, _ => y - -instance : Membership α (Option α) := ⟨fun a b => b = some a⟩ - -@[simp] theorem mem_def {a : α} {b : Option α} : a ∈ b ↔ b = some a := .rfl - -instance [DecidableEq α] (j : α) (o : Option α) : Decidable (j ∈ o) := - inferInstanceAs <| Decidable (o = some j) - -theorem isNone_iff_eq_none {o : Option α} : o.isNone ↔ o = none := - ⟨Option.eq_none_of_isNone, fun e => e.symm ▸ rfl⟩ - -theorem some_inj {a b : α} : some a = some b ↔ a = b := by simp - -/-- -`o = none` is decidable even if the wrapped type does not have decidable equality. -This is not an instance because it is not definitionally equal to `instance : DecidableEq Option`. -Try to use `o.isNone` or `o.isSome` instead. --/ -@[inline] def decidable_eq_none {o : Option α} : Decidable (o = none) := - decidable_of_decidable_of_iff isNone_iff_eq_none - -instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (∀ a ∈ o, p a) -| none => isTrue (by simp) -| some a => - if h : p a then isTrue fun o e => some_inj.1 e ▸ h - else isFalse <| mt (· _ rfl) h - -instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (∃ a ∈ o, p a) -| none => isFalse nofun -| some a => if h : p a then isTrue ⟨_, rfl, h⟩ else isFalse fun ⟨_, ⟨rfl, hn⟩⟩ => h hn - -/-- Extracts the value `a` from an option that is known to be `some a` for some `a`. -/ -@[inline] def get {α : Type u} : (o : Option α) → isSome o → α - | some x, _ => x - -/-- `guard p a` returns `some a` if `p a` holds, otherwise `none`. -/ -@[inline] def guard (p : α → Prop) [DecidablePred p] (a : α) : Option α := - if p a then some a else none - -/-- -Cast of `Option` to `List`. Returns `[a]` if the input is `some a`, and `[]` if it is `none`. --/ -@[inline] def toList : Option α → List α - | none => [] - | some a => [a] - -/-- -Cast of `Option` to `Array`. Returns `[a]` if the input is `some a`, and `[]` if it is `none`. --/ -@[inline] def toArray : Option α → Array α - | none => #[] - | some a => #[a] - -/-- -Two arguments failsafe function. Returns `f a b` if the inputs are `some a` and `some b`, and -"does nothing" otherwise. --/ -def liftOrGet (f : α → α → α) : Option α → Option α → Option α - | none, none => none - | some a, none => some a - | none, some b => some b - | some a, some b => some (f a b) - -/-- Lifts a relation `α → β → Prop` to a relation `Option α → Option β → Prop` by just adding -`none ~ none`. -/ -inductive Rel (r : α → β → Prop) : Option α → Option β → Prop - /-- If `a ~ b`, then `some a ~ some b` -/ - | some {a b} : r a b → Rel r (some a) (some b) - /-- `none ~ none` -/ - | none : Rel r none none - -/-- -Partial bind. If for some `x : Option α`, `f : Π (a : α), a ∈ x → Option β` is a -partial function defined on `a : α` giving an `Option β`, where `some a = x`, -then `pbind x f h` is essentially the same as `bind x f` -but is defined only when all `x = some a`, using the proof to apply `f`. --/ -@[simp, inline] -def pbind : ∀ x : Option α, (∀ a : α, a ∈ x → Option β) → Option β - | none, _ => none - | some a, f => f a rfl - -/-- -Partial map. If `f : Π a, p a → β` is a partial function defined on `a : α` satisfying `p`, -then `pmap f x h` is essentially the same as `map f x` but is defined only when all members of `x` -satisfy `p`, using the proof to apply `f`. --/ -@[simp, inline] def pmap {p : α → Prop} (f : ∀ a : α, p a → β) : - ∀ x : Option α, (∀ a ∈ x, p a) → Option β - | none, _ => none - | some a, H => f a (H a rfl) - -/-- Flatten an `Option` of `Option`, a specialization of `joinM`. -/ -@[simp, inline] def join (x : Option (Option α)) : Option α := x.bind id - -/-- Map a monadic function which returns `Unit` over an `Option`. -/ -@[inline] protected def forM [Pure m] : Option α → (α → m PUnit) → m PUnit - | none , _ => pure () - | some a, f => f a - -instance : ForM m (Option α) α := - ⟨Option.forM⟩ - -instance : ForIn' m (Option α) α inferInstance where - forIn' x init f := do - match x with - | none => return init - | some a => - match ← f a rfl init with - | .done r | .yield r => return r - -/-- Like `Option.mapM` but for applicative functors. -/ -@[inline] protected def mapA [Applicative m] {α β} (f : α → m β) : Option α → m (Option β) - | none => pure none - | some x => some <$> f x - -/-- -If you maybe have a monadic computation in a `[Monad m]` which produces a term of type `α`, then -there is a naturally associated way to always perform a computation in `m` which maybe produces a -result. --/ -@[inline] def sequence [Monad m] {α : Type u} : Option (m α) → m (Option α) - | none => pure none - | some fn => some <$> fn - -/-- A monadic analogue of `Option.elim`. -/ -@[inline] def elimM [Monad m] (x : m (Option α)) (y : m β) (z : α → m β) : m β := - do (← x).elim y z - -/-- A monadic analogue of `Option.getD`. -/ -@[inline] def getDM [Monad m] (x : Option α) (y : m α) : m α := - match x with - | some a => pure a - | none => y - -instance (α) [BEq α] [LawfulBEq α] : LawfulBEq (Option α) where - rfl {x} := - match x with - | some x => LawfulBEq.rfl (α := α) - | none => rfl - eq_of_beq {x y h} := by - match x, y with - | some x, some y => rw [LawfulBEq.eq_of_beq (α := α) h] - | none, none => rfl - -@[simp] theorem all_none : Option.all p none = true := rfl -@[simp] theorem all_some : Option.all p (some x) = p x := rfl - -/-- The minimum of two optional values. -/ -protected def min [Min α] : Option α → Option α → Option α - | some x, some y => some (Min.min x y) - | some x, none => some x - | none, some y => some y - | none, none => none - -instance [Min α] : Min (Option α) where min := Option.min - -@[simp] theorem min_some_some [Min α] {a b : α} : min (some a) (some b) = some (min a b) := rfl -@[simp] theorem min_some_none [Min α] {a : α} : min (some a) none = some a := rfl -@[simp] theorem min_none_some [Min α] {b : α} : min none (some b) = some b := rfl -@[simp] theorem min_none_none [Min α] : min (none : Option α) none = none := rfl - -/-- The maximum of two optional values. -/ -protected def max [Max α] : Option α → Option α → Option α - | some x, some y => some (Max.max x y) - | some x, none => some x - | none, some y => some y - | none, none => none - -instance [Max α] : Max (Option α) where max := Option.max - -@[simp] theorem max_some_some [Max α] {a b : α} : max (some a) (some b) = some (max a b) := rfl -@[simp] theorem max_some_none [Max α] {a : α} : max (some a) none = some a := rfl -@[simp] theorem max_none_some [Max α] {b : α} : max none (some b) = some b := rfl -@[simp] theorem max_none_none [Max α] : max (none : Option α) none = none := rfl diff --git a/Std/Data/Option/Lemmas.lean b/Std/Data/Option/Lemmas.lean index ef9afd2e9d..5f682e9464 100644 --- a/Std/Data/Option/Lemmas.lean +++ b/Std/Data/Option/Lemmas.lean @@ -3,232 +3,11 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Data.Option.Basic +import Std.Tactic.Alias namespace Option -theorem mem_iff {a : α} {b : Option α} : a ∈ b ↔ b = a := .rfl +@[deprecated] alias to_list_some := toList_some +@[deprecated] alias to_list_none := toList_none -theorem some_ne_none (x : α) : some x ≠ none := nofun - -protected theorem «forall» {p : Option α → Prop} : (∀ x, p x) ↔ p none ∧ ∀ x, p (some x) := - ⟨fun h => ⟨h _, fun _ => h _⟩, fun h x => Option.casesOn x h.1 h.2⟩ - -protected theorem «exists» {p : Option α → Prop} : (∃ x, p x) ↔ p none ∨ ∃ x, p (some x) := - ⟨fun | ⟨none, hx⟩ => .inl hx | ⟨some x, hx⟩ => .inr ⟨x, hx⟩, - fun | .inl h => ⟨_, h⟩ | .inr ⟨_, hx⟩ => ⟨_, hx⟩⟩ - -theorem get_mem : ∀ {o : Option α} (h : isSome o), o.get h ∈ o - | some _, _ => rfl - -theorem get_of_mem : ∀ {o : Option α} (h : isSome o), a ∈ o → o.get h = a - | _, _, rfl => rfl - -theorem not_mem_none (a : α) : a ∉ (none : Option α) := nofun - -@[simp] theorem some_get : ∀ {x : Option α} (h : isSome x), some (x.get h) = x -| some _, _ => rfl - -@[simp] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl - -theorem getD_of_ne_none {x : Option α} (hx : x ≠ none) (y : α) : some (x.getD y) = x := by - cases x; {contradiction}; rw [getD_some] - -theorem getD_eq_iff {o : Option α} {a b} : o.getD a = b ↔ (o = some b ∨ o = none ∧ a = b) := by - cases o <;> simp - -theorem mem_unique {o : Option α} {a b : α} (ha : a ∈ o) (hb : b ∈ o) : a = b := - some.inj <| ha ▸ hb - -@[ext] theorem ext : ∀ {o₁ o₂ : Option α}, (∀ a, a ∈ o₁ ↔ a ∈ o₂) → o₁ = o₂ - | none, none, _ => rfl - | some _, _, H => ((H _).1 rfl).symm - | _, some _, H => (H _).2 rfl - -theorem eq_none_iff_forall_not_mem : o = none ↔ ∀ a, a ∉ o := - ⟨fun e a h => by rw [e] at h; (cases h), fun h => ext <| by simp; exact h⟩ - -@[simp] theorem isSome_none : @isSome α none = false := rfl - -@[simp] theorem isSome_some : isSome (some a) = true := rfl - -theorem isSome_iff_exists : isSome x ↔ ∃ a, x = some a := by cases x <;> simp [isSome] - -@[simp] theorem isNone_none : @isNone α none = true := rfl - -@[simp] theorem isNone_some : isNone (some a) = false := rfl - -@[simp] theorem not_isSome : isSome a = false ↔ a.isNone = true := by - cases a <;> simp - -theorem eq_some_iff_get_eq : o = some a ↔ ∃ h : o.isSome, o.get h = a := by - cases o <;> simp; nofun - -theorem eq_some_of_isSome : ∀ {o : Option α} (h : o.isSome), o = some (o.get h) - | some _, _ => rfl - -theorem not_isSome_iff_eq_none : ¬o.isSome ↔ o = none := by - cases o <;> simp - -theorem ne_none_iff_isSome : o ≠ none ↔ o.isSome := by cases o <;> simp - -theorem ne_none_iff_exists : o ≠ none ↔ ∃ x, some x = o := by cases o <;> simp - -theorem ne_none_iff_exists' : o ≠ none ↔ ∃ x, o = some x := - ne_none_iff_exists.trans <| exists_congr fun _ => eq_comm - -theorem bex_ne_none {p : Option α → Prop} : (∃ x, ∃ (_ : x ≠ none), p x) ↔ ∃ x, p (some x) := - ⟨fun ⟨x, hx, hp⟩ => ⟨x.get <| ne_none_iff_isSome.1 hx, by rwa [some_get]⟩, - fun ⟨x, hx⟩ => ⟨some x, some_ne_none x, hx⟩⟩ - -theorem ball_ne_none {p : Option α → Prop} : (∀ x (_ : x ≠ none), p x) ↔ ∀ x, p (some x) := - ⟨fun h x => h (some x) (some_ne_none x), - fun h x hx => by - have := h <| x.get <| ne_none_iff_isSome.1 hx - simp [some_get] at this ⊢ - exact this⟩ - -@[simp] theorem pure_def : pure = @some α := rfl - -@[simp] theorem bind_eq_bind : bind = @Option.bind α β := rfl - -@[simp] theorem bind_some (x : Option α) : x.bind some = x := by cases x <;> rfl - -@[simp] theorem bind_none (x : Option α) : x.bind (fun _ => none (α := β)) = none := by - cases x <;> rfl - -@[simp] theorem bind_eq_some : x.bind f = some b ↔ ∃ a, x = some a ∧ f a = some b := by - cases x <;> simp - -@[simp] theorem bind_eq_none {o : Option α} {f : α → Option β} : - o.bind f = none ↔ ∀ a, o = some a → f a = none := by cases o <;> simp - -theorem bind_eq_none' {o : Option α} {f : α → Option β} : - o.bind f = none ↔ ∀ b a, a ∈ o → b ∉ f a := by - simp only [eq_none_iff_forall_not_mem, not_exists, not_and, mem_def, bind_eq_some] - -theorem bind_comm {f : α → β → Option γ} (a : Option α) (b : Option β) : - (a.bind fun x => b.bind (f x)) = b.bind fun y => a.bind fun x => f x y := by - cases a <;> cases b <;> rfl - -theorem bind_assoc (x : Option α) (f : α → Option β) (g : β → Option γ) : - (x.bind f).bind g = x.bind fun y => (f y).bind g := by cases x <;> rfl - -theorem join_eq_some : x.join = some a ↔ x = some (some a) := by - simp - -theorem join_ne_none : x.join ≠ none ↔ ∃ z, x = some (some z) := by - simp only [ne_none_iff_exists', join_eq_some, iff_self] - -theorem join_ne_none' : ¬x.join = none ↔ ∃ z, x = some (some z) := - join_ne_none - -theorem join_eq_none : o.join = none ↔ o = none ∨ o = some none := - match o with | none | some none | some (some _) => by simp - -theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl - -@[simp] theorem map_eq_map : Functor.map f = Option.map f := rfl - -theorem map_none : f <$> none = none := rfl - -theorem map_some : f <$> some a = some (f a) := rfl - -@[simp] theorem map_eq_some' : x.map f = some b ↔ ∃ a, x = some a ∧ f a = b := by cases x <;> simp - -theorem map_eq_some : f <$> x = some b ↔ ∃ a, x = some a ∧ f a = b := map_eq_some' - -@[simp] theorem map_eq_none' : x.map f = none ↔ x = none := by - cases x <;> simp only [map_none', map_some', eq_self_iff_true] - -theorem map_eq_none : f <$> x = none ↔ x = none := map_eq_none' - -theorem map_eq_bind {x : Option α} : x.map f = x.bind (some ∘ f) := by - cases x <;> simp [Option.bind] - -theorem map_congr {x : Option α} (h : ∀ a ∈ x, f a = g a) : x.map f = x.map g := by - cases x <;> simp only [map_none', map_some', h, mem_def] - -@[simp] theorem map_id' : Option.map (@id α) = id := map_id -@[simp] theorem map_id'' {x : Option α} : (x.map fun a => a) = x := congrFun map_id x - -@[simp] theorem map_map (h : β → γ) (g : α → β) (x : Option α) : - (x.map g).map h = x.map (h ∘ g) := by - cases x <;> simp only [map_none', map_some', ·∘·] - -theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘ g) = (x.map g).map h := - (map_map ..).symm - -@[simp] theorem map_comp_map (f : α → β) (g : β → γ) : - Option.map g ∘ Option.map f = Option.map (g ∘ f) := by funext x; simp - -theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some' .. - -theorem bind_map_comm {α β} {x : Option (Option α)} {f : α → β} : - x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp - -theorem join_map_eq_map_join {f : α → β} {x : Option (Option α)} : - (x.map (Option.map f)).join = x.join.map f := by cases x <;> simp - -theorem join_join {x : Option (Option (Option α))} : x.join.join = (x.map join).join := by - cases x <;> simp - -theorem mem_of_mem_join {a : α} {x : Option (Option α)} (h : a ∈ x.join) : some a ∈ x := - h.symm ▸ join_eq_some.1 h - -@[simp] theorem some_orElse (a : α) (x : Option α) : (some a <|> x) = some a := rfl - -@[simp] theorem none_orElse (x : Option α) : (none <|> x) = x := rfl - -@[simp] theorem orElse_none (x : Option α) : (x <|> none) = x := by cases x <;> rfl - -theorem map_orElse {x y : Option α} : (x <|> y).map f = (x.map f <|> y.map f) := by - cases x <;> simp - -@[simp] theorem guard_eq_some [DecidablePred p] : guard p a = some b ↔ a = b ∧ p a := by - by_cases h : p a <;> simp [Option.guard, h] - -theorem liftOrGet_eq_or_eq {f : α → α → α} (h : ∀ a b, f a b = a ∨ f a b = b) : - ∀ o₁ o₂, liftOrGet f o₁ o₂ = o₁ ∨ liftOrGet f o₁ o₂ = o₂ - | none, none => .inl rfl - | some a, none => .inl rfl - | none, some b => .inr rfl - | some a, some b => by have := h a b; simp [liftOrGet] at this ⊢; exact this - -@[simp] theorem liftOrGet_none_left {f} {b : Option α} : liftOrGet f none b = b := by - cases b <;> rfl - -@[simp] theorem liftOrGet_none_right {f} {a : Option α} : liftOrGet f a none = a := by - cases a <;> rfl - -@[simp] theorem liftOrGet_some_some {f} {a b : α} : - liftOrGet f (some a) (some b) = f a b := rfl - -theorem elim_none (x : β) (f : α → β) : none.elim x f = x := rfl - -theorem elim_some (x : β) (f : α → β) (a : α) : (some a).elim x f = f a := rfl - -@[simp] theorem getD_map (f : α → β) (x : α) (o : Option α) : - (o.map f).getD (f x) = f (getD o x) := by cases o <;> rfl - -section - -attribute [local instance] Classical.propDecidable - -/-- An arbitrary `some a` with `a : α` if `α` is nonempty, and otherwise `none`. -/ -noncomputable def choice (α : Type _) : Option α := - if h : Nonempty α then some (Classical.choice h) else none - -theorem choice_eq {α : Type _} [Subsingleton α] (a : α) : choice α = some a := by - simp [choice] - rw [dif_pos (⟨a⟩ : Nonempty α)] - simp; apply Subsingleton.elim - -theorem choice_isSome_iff_nonempty {α : Type _} : (choice α).isSome ↔ Nonempty α := - ⟨fun h => ⟨(choice α).get h⟩, fun h => by simp only [choice, dif_pos h, isSome_some]⟩ - -end - -@[simp] theorem to_list_some (a : α) : (a : Option α).toList = [a] := rfl - -@[simp] theorem to_list_none (α : Type _) : (none : Option α).toList = [] := rfl +end Option diff --git a/Std/Data/Ord.lean b/Std/Data/Ord.lean deleted file mode 100644 index eaa53a9544..0000000000 --- a/Std/Data/Ord.lean +++ /dev/null @@ -1,134 +0,0 @@ -/- -Copyright (c) 2022 Jannis Limperg. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jannis Limperg --/ - -namespace Ordering - -deriving instance DecidableEq for Ordering - -/-- Swaps less and greater ordering results -/ -def swap : Ordering → Ordering - | .lt => .gt - | .eq => .eq - | .gt => .lt - -/-- -If `o₁` and `o₂` are `Ordering`, then `o₁.then o₂` returns `o₁` unless it is `.eq`, -in which case it returns `o₂`. Additionally, it has "short-circuiting" semantics similar to -boolean `x && y`: if `o₁` is not `.eq` then the expression for `o₂` is not evaluated. -This is a useful primitive for constructing lexicographic comparator functions: -``` -structure Person where - name : String - age : Nat - -instance : Ord Person where - compare a b := (compare a.name b.name).then (compare b.age a.age) -``` -This example will sort people first by name (in ascending order) and will sort people with -the same name by age (in descending order). (If all fields are sorted ascending and in the same -order as they are listed in the structure, you can also use `deriving Ord` on the structure -definition for the same effect.) --/ -@[macro_inline] def «then» : Ordering → Ordering → Ordering - | .eq, f => f - | o, _ => o - -/-- -Check whether the ordering is 'equal'. --/ -def isEq : Ordering → Bool - | eq => true - | _ => false - -/-- -Check whether the ordering is 'not equal'. --/ -def isNe : Ordering → Bool - | eq => false - | _ => true - -/-- -Check whether the ordering is 'less than'. --/ -def isLT : Ordering → Bool - | lt => true - | _ => false - -/-- -Check whether the ordering is 'greater than'. --/ -def isGT : Ordering → Bool - | gt => true - | _ => false - -/-- -Check whether the ordering is 'greater than or equal'. --/ -def isGE : Ordering → Bool - | lt => false - | _ => true - -end Ordering - -/-- -Compare `a` and `b` lexicographically by `cmp₁` and `cmp₂`. `a` and `b` are -first compared by `cmp₁`. If this returns 'equal', `a` and `b` are compared -by `cmp₂` to break the tie. --/ -@[inline] def compareLex (cmp₁ cmp₂ : α → β → Ordering) (a : α) (b : β) : Ordering := - (cmp₁ a b).then (cmp₂ a b) - -/-- -Compare `x` and `y` by comparing `f x` and `f y`. --/ -@[inline] def compareOn [ord : Ord β] (f : α → β) (x y : α) : Ordering := - compare (f x) (f y) - - -namespace Ord - -/-- -Derive a `BEq` instance from an `Ord` instance. --/ -protected def toBEq (ord : Ord α) : BEq α where - beq x y := ord.compare x y == .eq - -/-- -Derive an `LT` instance from an `Ord` instance. --/ -protected def toLT (_ : Ord α) : LT α := - ltOfOrd - -/-- -Derive an `LE` instance from an `Ord` instance. --/ -protected def toLE (_ : Ord α) : LE α := - leOfOrd - -/-- -Invert the order of an `Ord` instance. --/ -protected def opposite (ord : Ord α) : Ord α where - compare x y := ord.compare y x - -/-- -`ord.on f` compares `x` and `y` by comparing `f x` and `f y` according to `ord`. --/ -protected def on (ord : Ord β) (f : α → β) : Ord α where - compare := compareOn f - -/-- -Derive the lexicographic order on products `α × β` from orders for `α` and `β`. --/ -protected def lex (_ : Ord α) (_ : Ord β) : Ord (α × β) := - lexOrd - -/-- -Create an order which compares elements first by `ord₁` and then, if this -returns 'equal', by `ord₂`. --/ -protected def lex' (ord₁ ord₂ : Ord α) : Ord α where - compare := compareLex ord₁.compare ord₂.compare diff --git a/Std/Data/PairingHeap.lean b/Std/Data/PairingHeap.lean index fd30bd0c44..8eceda2753 100644 --- a/Std/Data/PairingHeap.lean +++ b/Std/Data/PairingHeap.lean @@ -149,7 +149,7 @@ theorem Heap.size_tail (le) {s : Heap α} (h : s.NoSibling) : (s.tail le).size = simp only [Heap.tail] match eq : s.tail? le with | none => cases s with cases eq | nil => rfl - | some tl => simp [Heap.size_tail? h eq]; rfl + | some tl => simp [Heap.size_tail? h eq] theorem Heap.size_deleteMin_lt {s : Heap α} (eq : s.deleteMin le = some (a, s')) : s'.size < s.size := by diff --git a/Std/Data/RBMap/Alter.lean b/Std/Data/RBMap/Alter.lean index 2d9609ad72..6e6d99b455 100644 --- a/Std/Data/RBMap/Alter.lean +++ b/Std/Data/RBMap/Alter.lean @@ -377,7 +377,7 @@ protected theorem Balanced.alter {t : RBNode α} | .black ha hb => exact ⟨_, _, hp.fill (.black ha hb)⟩ theorem modify_eq_alter (t : RBNode α) : t.modify cut f = t.alter cut (.map f) := by - simp [modify, alter]; split <;> simp [Option.map] + simp [modify, alter] /-- The `modify` function preserves the ordering invariants. -/ protected theorem Ordered.modify {t : RBNode α} diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index c6bbb8bac5..f41ad0ed91 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -231,10 +231,6 @@ annotations. -/ def getTypeCleanup (mvarId : MVarId) : MetaM Expr := return (← instantiateMVars (← mvarId.getType)).cleanupAnnotations -/-- Short-hand for applying a constant to the goal. -/ -def applyConst (mvar : MVarId) (c : Name) (cfg : ApplyConfig := {}) : MetaM (List MVarId) := do - mvar.apply (← mkConstWithFreshMVarLevels c) cfg - end MVarId diff --git a/Std/Lean/Meta/DiscrTree.lean b/Std/Lean/Meta/DiscrTree.lean index b14f1bd356..1984950963 100644 --- a/Std/Lean/Meta/DiscrTree.lean +++ b/Std/Lean/Meta/DiscrTree.lean @@ -6,7 +6,6 @@ Authors: Jannis Limperg, Scott Morrison import Lean.Meta.DiscrTree import Std.Data.Array.Merge -import Std.Data.Ord import Std.Lean.Meta.Expr import Std.Lean.PersistentHashMap diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean index 7fb1ffcc22..104c8c67f3 100644 --- a/Std/Tactic/LibrarySearch.lean +++ b/Std/Tactic/LibrarySearch.lean @@ -9,7 +9,6 @@ import Std.Lean.Expr import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Parser -import Std.Data.Option.Basic import Std.Tactic.SolveByElim import Std.Util.Pickle diff --git a/test/congr.lean b/test/congr.lean index 21f327fa43..517c216efd 100644 --- a/test/congr.lean +++ b/test/congr.lean @@ -7,7 +7,7 @@ example (c : Prop → Prop → Prop → Prop) (x x' y z z' : Prop) apply Iff.of_eq -- FIXME: not needed in lean 3 congr · guard_target =ₐ x = x' - apply_ext_lemma + apply_ext_theorem assumption · guard_target =ₐ z = z' ext diff --git a/test/ext.lean b/test/ext.lean index 77ff61028b..e0799efb90 100644 --- a/test/ext.lean +++ b/test/ext.lean @@ -35,7 +35,6 @@ example (a b : C' n) : a = b := by guard_target = a.toB = b.toB; exact mySorry guard_target = a.c = b.c; exact mySorry -open Std.Tactic.Ext example (f g : Nat × Nat → Nat) : f = g := by ext ⟨x, y⟩ guard_target = f (x, y) = g (x, y); exact mySorry diff --git a/test/lintTC.lean b/test/lintTC.lean index d9c14db5f5..c24a1faf0a 100644 --- a/test/lintTC.lean +++ b/test/lintTC.lean @@ -1,7 +1,5 @@ import Std.Tactic.Lint.TypeClass import Std.Tactic.GuardMsgs -import Std.Tactic.RunCmd - open Std.Tactic.Lint namespace A diff --git a/test/lintsimp.lean b/test/lintsimp.lean index 43e1f3267e..29c03b2e53 100644 --- a/test/lintsimp.lean +++ b/test/lintsimp.lean @@ -1,6 +1,5 @@ import Std.Tactic.Lint import Std.Tactic.GuardMsgs -import Std.Tactic.RunCmd open Std.Tactic.Lint set_option linter.missingDocs false From b2811899a29e897ad69782b9869e440571798d8f Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 16 Feb 2024 20:09:52 +1100 Subject: [PATCH 060/213] oops cleanup --- Std/Tactic/Omega/Coeffs/IntList.lean | 6 ------ 1 file changed, 6 deletions(-) diff --git a/Std/Tactic/Omega/Coeffs/IntList.lean b/Std/Tactic/Omega/Coeffs/IntList.lean index 75c731d31e..94be9e134c 100644 --- a/Std/Tactic/Omega/Coeffs/IntList.lean +++ b/Std/Tactic/Omega/Coeffs/IntList.lean @@ -39,12 +39,6 @@ abbrev toList (xs : Coeffs) : List Int := xs abbrev ofList (xs : List Int) : Coeffs := xs /-- Are the coefficients all zero? -/ abbrev isZero (xs : Coeffs) : Prop := ∀ x, x ∈ xs → x = 0 - -def foo : DecidablePred isZero := - inferInstanceAs <| DecidablePred (fun (xs : Coeffs) => ∀ x, x ∈ xs → x = 0) - -#check List.decidableBAll -#synth DecidablePred isZero /-- Shim for `IntList.set`. -/ abbrev set (xs : Coeffs) (i : Nat) (y : Int) : Coeffs := IntList.set xs i y /-- Shim for `IntList.get`. -/ From 426c0f98eeba56e6946efb65d9cbccffcfe23e31 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 17 Feb 2024 11:15:50 +1100 Subject: [PATCH 061/213] update all --- Std.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Std.lean b/Std.lean index 49c041911a..5f8d2267f1 100644 --- a/Std.lean +++ b/Std.lean @@ -1,4 +1,5 @@ import Std.Classes.BEq +import Std.Classes.Cast import Std.Classes.Order import Std.Classes.RatCast import Std.Classes.SatisfiesM From ce2284e66ef7c7adff06920611a2a7f7b0659d95 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 17 Feb 2024 09:13:24 +0000 Subject: [PATCH 062/213] chore: bump to nightly-2024-02-17 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 04371a9e85..c2189c8b41 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-16 +leanprover/lean4:nightly-2024-02-17 From bfa9e0827f3011b17d6d849546105ec8c64a265c Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sun, 18 Feb 2024 19:00:09 +1100 Subject: [PATCH 063/213] bump toolchain --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index c2189c8b41..d2b5dd9c94 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-17 +leanprover/lean4:nightly-2024-02-18 From 269beca4c7a4b49a4f90c886ebe3a9afda76a151 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 19 Feb 2024 09:15:31 +0000 Subject: [PATCH 064/213] chore: bump to nightly-2024-02-19 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index d2b5dd9c94..1fbcac3216 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-18 +leanprover/lean4:nightly-2024-02-19 From fe0a29a260300b22357ddadbceb9e02ce9f4fc9a Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 19 Feb 2024 20:58:02 +1100 Subject: [PATCH 065/213] not sure why that proof broke --- Std.lean | 13 - Std/Data/BitVec/Folds.lean | 1 - Std/Data/BitVec/Lemmas.lean | 1 - Std/Data/Bool.lean | 215 ------ Std/Data/Fin.lean | 1 - Std/Data/Fin/Basic.lean | 39 -- Std/Data/Fin/Iterate.lean | 93 --- Std/Data/Fin/Lemmas.lean | 1 - Std/Data/Int/Order.lean | 1 - Std/Data/List/Basic.lean | 27 - Std/Data/Nat/Bitwise.lean | 2 +- Std/Data/Nat/Lemmas.lean | 999 --------------------------- Std/Lean/Elab/Tactic.lean | 18 - Std/Tactic/Omega.lean | 192 ----- Std/Tactic/Omega/Coeffs/IntList.lean | 108 --- Std/Tactic/Omega/Config.lean | 44 -- Std/Tactic/Omega/Constraint.lean | 253 ------- Std/Tactic/Omega/Core.lean | 691 ------------------ Std/Tactic/Omega/Frontend.lean | 572 --------------- Std/Tactic/Omega/Int.lean | 157 ----- Std/Tactic/Omega/IntList.lean | 405 ----------- Std/Tactic/Omega/LinearCombo.lean | 183 ----- Std/Tactic/Omega/Logic.lean | 31 - Std/Tactic/Omega/MinNatAbs.lean | 133 ---- Std/Tactic/Omega/OmegaM.lean | 218 ------ Std/Tactic/Relation/Rfl.lean | 2 +- test/omega/benchmark.lean | 1 - test/omega/examples.lean | 1 - test/omega/test.lean | 3 - 29 files changed, 2 insertions(+), 4403 deletions(-) delete mode 100644 Std/Data/Fin/Iterate.lean delete mode 100644 Std/Lean/Elab/Tactic.lean delete mode 100644 Std/Tactic/Omega.lean delete mode 100644 Std/Tactic/Omega/Coeffs/IntList.lean delete mode 100644 Std/Tactic/Omega/Config.lean delete mode 100644 Std/Tactic/Omega/Constraint.lean delete mode 100644 Std/Tactic/Omega/Core.lean delete mode 100644 Std/Tactic/Omega/Frontend.lean delete mode 100644 Std/Tactic/Omega/Int.lean delete mode 100644 Std/Tactic/Omega/IntList.lean delete mode 100644 Std/Tactic/Omega/LinearCombo.lean delete mode 100644 Std/Tactic/Omega/Logic.lean delete mode 100644 Std/Tactic/Omega/MinNatAbs.lean delete mode 100644 Std/Tactic/Omega/OmegaM.lean diff --git a/Std.lean b/Std.lean index 0378a3b38c..1b2cb1e4d1 100644 --- a/Std.lean +++ b/Std.lean @@ -40,7 +40,6 @@ import Std.Data.UInt import Std.Lean.AttributeExtra import Std.Lean.CoreM import Std.Lean.Delaborator -import Std.Lean.Elab.Tactic import Std.Lean.Except import Std.Lean.Expr import Std.Lean.Float @@ -100,18 +99,6 @@ import Std.Tactic.NoMatch import Std.Tactic.NormCast import Std.Tactic.NormCast.Ext import Std.Tactic.NormCast.Lemmas -import Std.Tactic.Omega -import Std.Tactic.Omega.Coeffs.IntList -import Std.Tactic.Omega.Config -import Std.Tactic.Omega.Constraint -import Std.Tactic.Omega.Core -import Std.Tactic.Omega.Frontend -import Std.Tactic.Omega.Int -import Std.Tactic.Omega.IntList -import Std.Tactic.Omega.LinearCombo -import Std.Tactic.Omega.Logic -import Std.Tactic.Omega.MinNatAbs -import Std.Tactic.Omega.OmegaM import Std.Tactic.OpenPrivate import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents diff --git a/Std/Data/BitVec/Folds.lean b/Std/Data/BitVec/Folds.lean index ee9ecd079e..952b930006 100644 --- a/Std/Data/BitVec/Folds.lean +++ b/Std/Data/BitVec/Folds.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joe Hendrix -/ import Std.Data.BitVec.Lemmas -import Std.Data.Fin.Iterate import Std.Data.Nat.Lemmas namespace Std.BitVec diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index 3826bf0f13..a3d821abf4 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -8,7 +8,6 @@ import Std.Data.BitVec.Basic import Std.Data.Fin.Lemmas import Std.Data.Nat.Lemmas import Std.Tactic.Simpa -import Std.Tactic.Omega import Std.Util.ProofWanted namespace Std.BitVec diff --git a/Std/Data/Bool.lean b/Std/Data/Bool.lean index eb463d5d76..cc031a0484 100644 --- a/Std/Data/Bool.lean +++ b/Std/Data/Bool.lean @@ -6,229 +6,14 @@ Authors: F. G. Dorais import Std.Tactic.Alias -/-- Boolean exclusive or -/ -abbrev xor : Bool → Bool → Bool := bne - namespace Bool -/- Namespaced versions that can be used instead of prefixing `_root_` -/ -@[inherit_doc not] protected abbrev not := not -@[inherit_doc or] protected abbrev or := or -@[inherit_doc and] protected abbrev and := and -@[inherit_doc xor] protected abbrev xor := xor - -instance (p : Bool → Prop) [inst : DecidablePred p] : Decidable (∀ x, p x) := - match inst true, inst false with - | isFalse ht, _ => isFalse fun h => absurd (h _) ht - | _, isFalse hf => isFalse fun h => absurd (h _) hf - | isTrue ht, isTrue hf => isTrue fun | true => ht | false => hf - -instance (p : Bool → Prop) [inst : DecidablePred p] : Decidable (∃ x, p x) := - match inst true, inst false with - | isTrue ht, _ => isTrue ⟨_, ht⟩ - | _, isTrue hf => isTrue ⟨_, hf⟩ - | isFalse ht, isFalse hf => isFalse fun | ⟨true, h⟩ => absurd h ht | ⟨false, h⟩ => absurd h hf - -instance : LE Bool := ⟨(. → .)⟩ -instance : LT Bool := ⟨(!. && .)⟩ - -instance (x y : Bool) : Decidable (x ≤ y) := inferInstanceAs (Decidable (x → y)) -instance (x y : Bool) : Decidable (x < y) := inferInstanceAs (Decidable (!x && y)) - -instance : Max Bool := ⟨or⟩ -instance : Min Bool := ⟨and⟩ - -theorem false_ne_true : false ≠ true := Bool.noConfusion - -theorem eq_false_or_eq_true : (b : Bool) → b = true ∨ b = false := by decide - -theorem eq_false_iff : {b : Bool} → b = false ↔ b ≠ true := by decide - -theorem ne_false_iff : {b : Bool} → b ≠ false ↔ b = true := by decide - -theorem eq_iff_iff {a b : Bool} : a = b ↔ (a ↔ b) := by cases b <;> simp - -/-! ### and -/ - -@[simp] theorem not_and_self : ∀ (x : Bool), (!x && x) = false := by decide - -@[simp] theorem and_not_self : ∀ (x : Bool), (x && !x) = false := by decide - -theorem and_comm : ∀ (x y : Bool), (x && y) = (y && x) := by decide - -theorem and_left_comm : ∀ (x y z : Bool), (x && (y && z)) = (y && (x && z)) := by decide - -theorem and_right_comm : ∀ (x y z : Bool), ((x && y) && z) = ((x && z) && y) := by decide - -theorem and_or_distrib_left : ∀ (x y z : Bool), (x && (y || z)) = ((x && y) || (x && z)) := by - decide - -theorem and_or_distrib_right : ∀ (x y z : Bool), ((x || y) && z) = ((x && z) || (y && z)) := by - decide - -theorem and_xor_distrib_left : ∀ (x y z : Bool), (x && xor y z) = xor (x && y) (x && z) := by decide - -theorem and_xor_distrib_right : ∀ (x y z : Bool), (xor x y && z) = xor (x && z) (y && z) := by - decide - -/-- De Morgan's law for boolean and -/ -theorem not_and : ∀ (x y : Bool), (!(x && y)) = (!x || !y) := by decide - -theorem and_eq_true_iff : ∀ (x y : Bool), (x && y) = true ↔ x = true ∧ y = true := by decide - -theorem and_eq_false_iff : ∀ (x y : Bool), (x && y) = false ↔ x = false ∨ y = false := by decide - -/-! ### or -/ - -@[simp] theorem not_or_self : ∀ (x : Bool), (!x || x) = true := by decide - -@[simp] theorem or_not_self : ∀ (x : Bool), (x || !x) = true := by decide - -theorem or_comm : ∀ (x y : Bool), (x || y) = (y || x) := by decide - -theorem or_left_comm : ∀ (x y z : Bool), (x || (y || z)) = (y || (x || z)) := by decide - -theorem or_right_comm : ∀ (x y z : Bool), ((x || y) || z) = ((x || z) || y) := by decide - -theorem or_and_distrib_left : ∀ (x y z : Bool), (x || (y && z)) = ((x || y) && (x || z)) := by - decide - -theorem or_and_distrib_right : ∀ (x y z : Bool), ((x && y) || z) = ((x || z) && (y || z)) := by - decide - -/-- De Morgan's law for boolean or -/ -theorem not_or : ∀ (x y : Bool), (!(x || y)) = (!x && !y) := by decide - -theorem or_eq_true_iff : ∀ (x y : Bool), (x || y) = true ↔ x = true ∨ y = true := by decide - -theorem or_eq_false_iff : ∀ (x y : Bool), (x || y) = false ↔ x = false ∧ y = false := by decide - -/-! ### xor -/ - -@[simp] theorem false_xor : ∀ (x : Bool), xor false x = x := by decide - -@[simp] theorem xor_false : ∀ (x : Bool), xor x false = x := by decide - -@[simp] theorem true_xor : ∀ (x : Bool), xor true x = !x := by decide - -@[simp] theorem xor_true : ∀ (x : Bool), xor x true = !x := by decide - -@[simp] theorem not_xor_self : ∀ (x : Bool), xor (!x) x = true := by decide - -@[simp] theorem xor_not_self : ∀ (x : Bool), xor x (!x) = true := by decide - -theorem not_xor : ∀ (x y : Bool), xor (!x) y = !(xor x y) := by decide - -theorem xor_not : ∀ (x y : Bool), xor x (!y) = !(xor x y) := by decide - -@[simp] theorem not_xor_not : ∀ (x y : Bool), xor (!x) (!y) = (xor x y) := by decide - -theorem xor_self : ∀ (x : Bool), xor x x = false := by decide - -theorem xor_comm : ∀ (x y : Bool), xor x y = xor y x := by decide - -theorem xor_left_comm : ∀ (x y z : Bool), xor x (xor y z) = xor y (xor x z) := by decide - -theorem xor_right_comm : ∀ (x y z : Bool), xor (xor x y) z = xor (xor x z) y := by decide - -theorem xor_assoc : ∀ (x y z : Bool), xor (xor x y) z = xor x (xor y z) := by decide - -@[simp] -theorem xor_left_inj : ∀ (x y z : Bool), xor x y = xor x z ↔ y = z := by decide - -@[simp] -theorem xor_right_inj : ∀ (x y z : Bool), xor x z = xor y z ↔ x = y := by decide - -/-! ### le/lt -/ - -@[simp] protected theorem le_true : ∀ (x : Bool), x ≤ true := by decide - -@[simp] protected theorem false_le : ∀ (x : Bool), false ≤ x := by decide - -@[simp] protected theorem le_refl : ∀ (x : Bool), x ≤ x := by decide - -@[simp] protected theorem lt_irrefl : ∀ (x : Bool), ¬ x < x := by decide - -protected theorem le_trans : ∀ {x y z : Bool}, x ≤ y → y ≤ z → x ≤ z := by decide - -protected theorem le_antisymm : ∀ {x y : Bool}, x ≤ y → y ≤ x → x = y := by decide - -protected theorem le_total : ∀ (x y : Bool), x ≤ y ∨ y ≤ x := by decide - -protected theorem lt_asymm : ∀ {x y : Bool}, x < y → ¬ y < x := by decide - -protected theorem lt_trans : ∀ {x y z : Bool}, x < y → y < z → x < z := by decide - -protected theorem lt_iff_le_not_le : ∀ {x y : Bool}, x < y ↔ x ≤ y ∧ ¬ y ≤ x := by decide - -protected theorem lt_of_le_of_lt : ∀ {x y z : Bool}, x ≤ y → y < z → x < z := by decide - -protected theorem lt_of_lt_of_le : ∀ {x y z : Bool}, x < y → y ≤ z → x < z := by decide - -protected theorem le_of_lt : ∀ {x y : Bool}, x < y → x ≤ y := by decide - -protected theorem le_of_eq : ∀ {x y : Bool}, x = y → x ≤ y := by decide - -protected theorem ne_of_lt : ∀ {x y : Bool}, x < y → x ≠ y := by decide - -protected theorem lt_of_le_of_ne : ∀ {x y : Bool}, x ≤ y → x ≠ y → x < y := by decide - -protected theorem le_of_lt_or_eq : ∀ {x y : Bool}, x < y ∨ x = y → x ≤ y := by decide - -protected theorem eq_true_of_true_le : ∀ {x : Bool}, true ≤ x → x = true := by decide - -protected theorem eq_false_of_le_false : ∀ {x : Bool}, x ≤ false → x = false := by decide - -/-! ### min/max -/ - -@[simp] protected theorem max_eq_or : max = or := rfl - -@[simp] protected theorem min_eq_and : min = and := rfl - /-! ### injectivity lemmas -/ -theorem not_inj : ∀ {x y : Bool}, (!x) = (!y) → x = y := by decide - -theorem not_inj_iff : ∀ {x y : Bool}, (!x) = (!y) ↔ x = y := by decide @[deprecated] alias not_inj' := not_inj_iff -theorem and_or_inj_right : ∀ {m x y : Bool}, (x && m) = (y && m) → (x || m) = (y || m) → x = y := by - decide - -theorem and_or_inj_right_iff : - ∀ {m x y : Bool}, (x && m) = (y && m) ∧ (x || m) = (y || m) ↔ x = y := by decide @[deprecated] alias and_or_inj_right' := and_or_inj_right_iff -theorem and_or_inj_left : ∀ {m x y : Bool}, (m && x) = (m && y) → (m || x) = (m || y) → x = y := by - decide - -theorem and_or_inj_left_iff : - ∀ {m x y : Bool}, (m && x) = (m && y) ∧ (m || x) = (m || y) ↔ x = y := by decide @[deprecated] alias and_or_inj_left' := and_or_inj_left_iff -/-! ## toNat -/ - -/-- convert a `Bool` to a `Nat`, `false -> 0`, `true -> 1` -/ -def toNat (b:Bool) : Nat := cond b 1 0 - -@[simp] theorem toNat_false : false.toNat = 0 := rfl - -@[simp] theorem toNat_true : true.toNat = 1 := rfl - -theorem toNat_le_one (c:Bool) : c.toNat ≤ 1 := by - cases c <;> trivial - end Bool - -/-! ### cond -/ - -theorem cond_eq_if : (bif b then x else y) = (if b then x else y) := by - cases b <;> simp - -/-! ### decide -/ - -@[simp] theorem false_eq_decide_iff {p : Prop} [h : Decidable p] : false = decide p ↔ ¬p := by - cases h with | _ q => simp [q] - -@[simp] theorem true_eq_decide_iff {p : Prop} [h : Decidable p] : true = decide p ↔ p := by - cases h with | _ q => simp [q] diff --git a/Std/Data/Fin.lean b/Std/Data/Fin.lean index 0b79375e25..b3a51cf303 100644 --- a/Std/Data/Fin.lean +++ b/Std/Data/Fin.lean @@ -1,3 +1,2 @@ import Std.Data.Fin.Basic -import Std.Data.Fin.Iterate import Std.Data.Fin.Lemmas diff --git a/Std/Data/Fin/Basic.lean b/Std/Data/Fin/Basic.lean index b3f65ed516..9512f4019c 100644 --- a/Std/Data/Fin/Basic.lean +++ b/Std/Data/Fin/Basic.lean @@ -6,45 +6,6 @@ Authors: Robert Y. Lewis, Keeley Hoek, Mario Carneiro namespace Fin -protected theorem pos (i : Fin n) : 0 < n := - Nat.lt_of_le_of_lt (Nat.zero_le _) i.2 - -/-- The greatest value of `Fin (n+1)`. -/ -@[inline] def last (n : Nat) : Fin (n + 1) := ⟨n, n.lt_succ_self⟩ - -/-- `castLT i h` embeds `i` into a `Fin` where `h` proves it belongs into. -/ -@[inline] def castLT (i : Fin m) (h : i.1 < n) : Fin n := ⟨i.1, h⟩ - -/-- `castLE h i` embeds `i` into a larger `Fin` type. -/ -@[inline] def castLE (h : n ≤ m) (i : Fin n) : Fin m := ⟨i, Nat.lt_of_lt_of_le i.2 h⟩ - -/-- `cast eq i` embeds `i` into an equal `Fin` type. -/ -@[inline] def cast (eq : n = m) (i : Fin n) : Fin m := ⟨i, eq ▸ i.2⟩ - -/-- `castAdd m i` embeds `i : Fin n` in `Fin (n+m)`. See also `Fin.natAdd` and `Fin.addNat`. -/ -@[inline] def castAdd (m) : Fin n → Fin (n + m) := - castLE <| Nat.le_add_right n m - -/-- `castSucc i` embeds `i : Fin n` in `Fin (n+1)`. -/ -@[inline] def castSucc : Fin n → Fin (n + 1) := castAdd 1 - -/-- `addNat m i` adds `m` to `i`, generalizes `Fin.succ`. -/ -def addNat (i : Fin n) (m) : Fin (n + m) := ⟨i + m, Nat.add_lt_add_right i.2 _⟩ - -/-- `natAdd n i` adds `n` to `i` "on the left". -/ -def natAdd (n) (i : Fin m) : Fin (n + m) := ⟨n + i, Nat.add_lt_add_left i.2 _⟩ - -/-- Maps `0` to `n-1`, `1` to `n-2`, ..., `n-1` to `0`. -/ -@[inline] def rev (i : Fin n) : Fin n := ⟨n - (i + 1), Nat.sub_lt i.pos (Nat.succ_pos _)⟩ - -/-- `subNat i h` subtracts `m` from `i`, generalizes `Fin.pred`. -/ -@[inline] def subNat (m) (i : Fin (n + m)) (h : m ≤ i) : Fin n := - ⟨i - m, Nat.sub_lt_right_of_lt_add h i.2⟩ - -/-- Predecessor of a nonzero element of `Fin (n+1)`. -/ -@[inline] def pred {n : Nat} (i : Fin (n + 1)) (h : i ≠ 0) : Fin n := - subNat 1 i <| Nat.pos_of_ne_zero <| mt (Fin.eq_of_val_eq (j := 0)) h - /-- `min n m` as an element of `Fin (m + 1)` -/ def clamp (n m : Nat) : Fin (m + 1) := ⟨min n m, Nat.lt_succ_of_le (Nat.min_le_right ..)⟩ diff --git a/Std/Data/Fin/Iterate.lean b/Std/Data/Fin/Iterate.lean deleted file mode 100644 index 73a03a7998..0000000000 --- a/Std/Data/Fin/Iterate.lean +++ /dev/null @@ -1,93 +0,0 @@ -/- -Copyright (c) 2023 by the authors listed in the file AUTHORS and their -institutional affiliations. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix --/ - -namespace Fin - -/-- -`hIterateFrom f i bnd a` applies `f` over indices `[i:n]` to compute `P n` -from `P i`. - -See `hIterate` below for more details. --/ -def hIterateFrom (P : Nat → Sort _) {n} (f : ∀(i : Fin n), P i.val → P (i.val+1)) - (i : Nat) (ubnd : i ≤ n) (a : P i) : P n := - if g : i < n then - hIterateFrom P f (i+1) g (f ⟨i, g⟩ a) - else - have p : i = n := (or_iff_left g).mp (Nat.eq_or_lt_of_le ubnd) - cast (congrArg P p) a - termination_by n - i - -/-- -`hIterate` is a heterogenous iterative operation that applies a -index-dependent function `f` to a value `init : P start` a total of -`stop - start` times to produce a value of type `P stop`. - -Concretely, `hIterate start stop f init` is equal to -```lean - init |> f start _ |> f (start+1) _ ... |> f (end-1) _ -``` - -Because it is heterogenous and must return a value of type `P stop`, -`hIterate` requires proof that `start ≤ stop`. - -One can prove properties of `hIterate` using the general theorem -`hIterate_elim` or other more specialized theorems. - -/ -def hIterate (P : Nat → Sort _) {n : Nat} (init : P 0) (f : ∀(i : Fin n), P i.val → P (i.val+1)) : - P n := - hIterateFrom P f 0 (Nat.zero_le n) init - -private theorem hIterateFrom_elim {P : Nat → Sort _}(Q : ∀(i : Nat), P i → Prop) - {n : Nat} - (f : ∀(i : Fin n), P i.val → P (i.val+1)) - {i : Nat} (ubnd : i ≤ n) - (s : P i) - (init : Q i s) - (step : ∀(k : Fin n) (s : P k.val), Q k.val s → Q (k.val+1) (f k s)) : - Q n (hIterateFrom P f i ubnd s) := by - let ⟨j, p⟩ := Nat.le.dest ubnd - induction j generalizing i ubnd init with - | zero => - unfold hIterateFrom - have g : ¬ (i < n) := by simp at p; simp [p] - have r : Q n (cast (congrArg P p) s) := - @Eq.rec Nat i (fun k eq => Q k (cast (congrArg P eq) s)) init n p - simp only [g, r, dite_false] - | succ j inv => - unfold hIterateFrom - have d : Nat.succ i + j = n := by simp [Nat.succ_add]; exact p - have g : i < n := Nat.le.intro d - simp only [g] - exact inv _ _ (step ⟨i,g⟩ s init) d - -/- -`hIterate_elim` provides a mechanism for showing that the result of -`hIterate` satisifies a property `Q stop` by showing that the states -at the intermediate indices `i : start ≤ i < stop` satisfy `Q i`. --/ -theorem hIterate_elim {P : Nat → Sort _} (Q : ∀(i : Nat), P i → Prop) - {n : Nat} (f : ∀(i : Fin n), P i.val → P (i.val+1)) (s : P 0) (init : Q 0 s) - (step : ∀(k : Fin n) (s : P k.val), Q k.val s → Q (k.val+1) (f k s)) : - Q n (hIterate P s f) := by - exact hIterateFrom_elim _ _ _ _ init step - -/- -`hIterate_eq`provides a mechanism for replacing `hIterate P s f` with a -function `state` showing that matches the steps performed by `hIterate`. - -This allows rewriting incremental code using `hIterate` with a -non-incremental state function. --/ -theorem hIterate_eq {P : Nat → Sort _} (state : ∀(i : Nat), P i) - {n : Nat} (f : ∀(i : Fin n), P i.val → P (i.val+1)) (s : P 0) - (init : s = state 0) - (step : ∀(i : Fin n), f i (state i) = state (i+1)) : - hIterate P s f = state n := by - apply hIterate_elim (fun i s => s = state i) f s init - intro i s s_eq - simp only [s_eq, step] diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 6e9876b85a..0d44305b49 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -7,7 +7,6 @@ import Std.Data.Fin.Basic import Std.Data.Nat.Lemmas import Std.Tactic.Simpa import Std.Tactic.NormCast.Lemmas -import Std.Tactic.Omega import Std.Tactic.SimpTrace namespace Fin diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 8b3461e5d2..9d70d5b605 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -3,7 +3,6 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ -import Std.Tactic.Omega import Std.Data.Nat.Lemmas /-! diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index b717201f83..02f62b8ed4 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -258,29 +258,6 @@ protected def Subset (l₁ l₂ : List α) := ∀ ⦃a : α⦄, a ∈ l₁ → a instance : HasSubset (List α) := ⟨List.Subset⟩ -instance decidableBEx (p : α → Prop) [DecidablePred p] : - ∀ l : List α, Decidable (∃ x ∈ l, p x) - | [] => isFalse nofun - | x :: xs => - if h₁ : p x then isTrue ⟨x, .head .., h₁⟩ else - match decidableBEx p xs with - | isTrue h₂ => isTrue <| let ⟨y, hm, hp⟩ := h₂; ⟨y, .tail _ hm, hp⟩ - | isFalse h₂ => isFalse fun - | ⟨y, .tail _ h, hp⟩ => h₂ ⟨y, h, hp⟩ - | ⟨_, .head .., hp⟩ => h₁ hp - -instance decidableBAll (p : α → Prop) [DecidablePred p] : - ∀ l : List α, Decidable (∀ x ∈ l, p x) - | [] => isTrue nofun - | x :: xs => - if h₁ : p x then - match decidableBAll p xs with - | isTrue h₂ => isTrue fun - | y, .tail _ h => h₂ y h - | _, .head .. => h₁ - | isFalse h₂ => isFalse fun H => h₂ fun y hm => H y (.tail _ hm) - else isFalse fun H => h₁ <| H x (.head ..) - instance [DecidableEq α] : DecidableRel (Subset : List α → List α → Prop) := fun _ _ => decidableBAll _ _ @@ -408,10 +385,6 @@ def indexOf [BEq α] (a : α) : List α → Nat := findIdx (· == a) · rw [go _ xs]; simp exact (go #[] _).symm -/-- Inserts an element into a list without duplication. -/ -@[inline] protected def insert [BEq α] (a : α) (l : List α) : List α := - if l.elem a then l else a :: l - /-- Constructs the union of two lists, by inserting the elements of `l₁` in reverse order to `l₂`. As a result, `l₂` will always be a suffix, but only the last occurrence of each element in `l₁` diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean index dc6324c2df..60f2ead06b 100644 --- a/Std/Data/Nat/Bitwise.lean +++ b/Std/Data/Nat/Bitwise.lean @@ -12,7 +12,7 @@ It is primarily intended to support the bitvector library. -/ import Std.Data.Bool import Std.Data.Nat.Lemmas -import Std.Tactic.Omega +import Std.Tactic.Simpa namespace Nat diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index cfeec9c78d..a0c16adb9d 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -137,46 +137,6 @@ theorem recDiagOn_succ_succ {motive : Nat → Nat → Sort _} (zero_zero : motiv (succ_succ : ∀ m n, motive (m+1) (n+1)) (m n) : Nat.casesDiagOn (m+1) (n+1) zero_zero zero_succ succ_zero succ_succ = succ_succ m n := rfl -/-! ### le/lt -/ - -protected theorem lt_asymm {a b : Nat} (h : a < b) : ¬ b < a := Nat.not_lt.2 (Nat.le_of_lt h) -protected alias not_lt_of_gt := Nat.lt_asymm -protected alias not_lt_of_lt := Nat.lt_asymm - -protected theorem lt_iff_le_not_le {m n : Nat} : m < n ↔ m ≤ n ∧ ¬ n ≤ m := - ⟨fun h => ⟨Nat.le_of_lt h, Nat.not_le_of_gt h⟩, fun ⟨_, h⟩ => Nat.lt_of_not_ge h⟩ -protected alias lt_iff_le_and_not_ge := Nat.lt_iff_le_not_le - -protected theorem lt_iff_le_and_ne {m n : Nat} : m < n ↔ m ≤ n ∧ m ≠ n := - ⟨fun h => ⟨Nat.le_of_lt h, Nat.ne_of_lt h⟩, fun h => Nat.lt_of_le_of_ne h.1 h.2⟩ - -protected theorem ne_iff_lt_or_gt {a b : Nat} : a ≠ b ↔ a < b ∨ b < a := - ⟨Nat.lt_or_gt_of_ne, fun | .inl h => Nat.ne_of_lt h | .inr h => Nat.ne_of_gt h⟩ -protected alias lt_or_gt := Nat.ne_iff_lt_or_gt - -protected alias le_or_ge := Nat.le_total -protected alias le_or_le := Nat.le_total - -protected theorem eq_or_lt_of_not_lt {a b : Nat} (hnlt : ¬ a < b) : a = b ∨ b < a := - (Nat.lt_trichotomy ..).resolve_left hnlt - -protected theorem lt_or_eq_of_le {n m : Nat} (h : n ≤ m) : n < m ∨ n = m := - (Nat.lt_or_ge ..).imp_right (Nat.le_antisymm h) - -protected theorem le_iff_lt_or_eq {n m : Nat} : n ≤ m ↔ n < m ∨ n = m := - ⟨Nat.lt_or_eq_of_le, fun | .inl h => Nat.le_of_lt h | .inr rfl => Nat.le_refl _⟩ - -protected theorem lt_succ_iff : m < succ n ↔ m ≤ n := ⟨le_of_lt_succ, lt_succ_of_le⟩ - -protected theorem lt_succ_iff_lt_or_eq : m < succ n ↔ m < n ∨ m = n := - Nat.lt_succ_iff.trans Nat.le_iff_lt_or_eq - -protected theorem eq_of_lt_succ_of_not_lt (hmn : m < n + 1) (h : ¬ m < n) : m = n := - (Nat.lt_succ_iff_lt_or_eq.1 hmn).resolve_left h - -protected theorem eq_of_le_of_lt_succ (h₁ : n ≤ m) (h₂ : m < n + 1) : m = n := - Nat.le_antisymm (le_of_succ_le_succ h₂) h₁ - /-! ## compare -/ theorem compare_def_lt (a b : Nat) : @@ -230,419 +190,18 @@ protected def sum_trichotomy (a b : Nat) : a < b ⊕' a = b ⊕' b < a := | .eq => .inr (.inl (Nat.compare_eq_eq.1 h)) | .gt => .inr (.inr (Nat.compare_eq_gt.1 h)) -/-! ## zero/one/two -/ - -theorem le_zero : i ≤ 0 ↔ i = 0 := ⟨Nat.eq_zero_of_le_zero, fun | rfl => Nat.le_refl _⟩ - -protected alias one_pos := Nat.zero_lt_one - -protected theorem two_pos : 0 < 2 := Nat.zero_lt_succ _ - -theorem add_one_ne_zero (n) : n + 1 ≠ 0 := succ_ne_zero _ - -protected theorem ne_zero_iff_zero_lt : n ≠ 0 ↔ 0 < n := Nat.pos_iff_ne_zero.symm - -protected theorem zero_lt_two : 0 < 2 := Nat.zero_lt_succ _ - -protected theorem one_lt_two : 1 < 2 := Nat.succ_lt_succ Nat.zero_lt_one - -protected theorem eq_zero_of_not_pos (h : ¬0 < n) : n = 0 := - Nat.eq_zero_of_le_zero (Nat.not_lt.1 h) - -/-! ## succ/pred -/ - -attribute [simp] succ_ne_zero zero_lt_succ lt_succ_self Nat.pred_zero Nat.pred_succ Nat.pred_le - -theorem succ_ne_self (n) : succ n ≠ n := Nat.ne_of_gt (lt_succ_self n) - -theorem succ_le : succ n ≤ m ↔ n < m := .rfl - -theorem lt_succ : m < succ n ↔ m ≤ n := ⟨le_of_lt_succ, lt_succ_of_le⟩ - -theorem lt_succ_of_lt (h : a < b) : a < succ b := le_succ_of_le h - -theorem succ_pred_eq_of_ne_zero : ∀ {n}, n ≠ 0 → succ (pred n) = n - | _+1, _ => rfl - -theorem eq_zero_or_eq_succ_pred : ∀ n, n = 0 ∨ n = succ (pred n) - | 0 => .inl rfl - | _+1 => .inr rfl - -theorem succ_inj' : succ a = succ b ↔ a = b := ⟨succ.inj, congrArg _⟩ - -theorem succ_le_succ_iff : succ a ≤ succ b ↔ a ≤ b := ⟨le_of_succ_le_succ, succ_le_succ⟩ - -theorem succ_lt_succ_iff : succ a < succ b ↔ a < b := ⟨lt_of_succ_lt_succ, succ_lt_succ⟩ - -theorem pred_inj : ∀ {a b}, 0 < a → 0 < b → pred a = pred b → a = b - | _+1, _+1, _, _ => congrArg _ - -theorem pred_ne_self : ∀ {a}, a ≠ 0 → pred a ≠ a - | _+1, _ => (succ_ne_self _).symm - -theorem pred_lt_self : ∀ {a}, 0 < a → pred a < a - | _+1, _ => lt_succ_self _ - -theorem pred_lt_pred : ∀ {n m}, n ≠ 0 → n < m → pred n < pred m - | _+1, _+1, _, h => lt_of_succ_lt_succ h - -theorem pred_le_iff_le_succ : ∀ {n m}, pred n ≤ m ↔ n ≤ succ m - | 0, _ => ⟨fun _ => Nat.zero_le _, fun _ => Nat.zero_le _⟩ - | _+1, _ => Nat.succ_le_succ_iff.symm - -theorem le_succ_of_pred_le : pred n ≤ m → n ≤ succ m := pred_le_iff_le_succ.1 - -theorem pred_le_of_le_succ : n ≤ succ m → pred n ≤ m := pred_le_iff_le_succ.2 - -theorem lt_pred_iff_succ_lt : ∀ {n m}, n < pred m ↔ succ n < m - | _, 0 => ⟨nofun, nofun⟩ - | _, _+1 => Nat.succ_lt_succ_iff.symm - -theorem succ_lt_of_lt_pred : n < pred m → succ n < m := lt_pred_iff_succ_lt.1 - -theorem lt_pred_of_succ_lt : succ n < m → n < pred m := lt_pred_iff_succ_lt.2 - -theorem le_pred_iff_lt : ∀ {n m}, 0 < m → (n ≤ pred m ↔ n < m) - | 0, _+1, _ => ⟨fun _ => Nat.zero_lt_succ _, fun _ => Nat.zero_le _⟩ - | _+1, _+1, _ => Nat.lt_pred_iff_succ_lt - -theorem lt_of_le_pred (h : 0 < m) : n ≤ pred m → n < m := (le_pred_iff_lt h).1 - -theorem le_pred_of_lt (h : n < m) : n ≤ pred m := (le_pred_iff_lt (Nat.zero_lt_of_lt h)).2 h - -theorem exists_eq_succ_of_ne_zero : ∀ {n}, n ≠ 0 → ∃ k, n = succ k - | _+1, _ => ⟨_, rfl⟩ - /-! ## add -/ -protected theorem add_add_add_comm (a b c d : Nat) : (a + b) + (c + d) = (a + c) + (b + d) := by - rw [Nat.add_assoc, Nat.add_assoc, Nat.add_left_comm b] - -theorem one_add (n) : 1 + n = succ n := Nat.add_comm .. - -theorem succ_eq_one_add (n) : succ n = 1 + n := (one_add _).symm - -theorem succ_add_eq_add_succ (a b) : succ a + b = a + succ b := Nat.succ_add .. @[deprecated] alias succ_add_eq_succ_add := Nat.succ_add_eq_add_succ -protected theorem eq_zero_of_add_eq_zero_right (h : n + m = 0) : n = 0 := - (Nat.eq_zero_of_add_eq_zero h).1 - -protected theorem add_eq_zero_iff : n + m = 0 ↔ n = 0 ∧ m = 0 := - ⟨Nat.eq_zero_of_add_eq_zero, fun ⟨h₁, h₂⟩ => h₂.symm ▸ h₁⟩ - -protected theorem add_left_cancel_iff {n : Nat} : n + m = n + k ↔ m = k := - ⟨Nat.add_left_cancel, fun | rfl => rfl⟩ - -protected theorem add_right_cancel_iff {n : Nat} : m + n = k + n ↔ m = k := - ⟨Nat.add_right_cancel, fun | rfl => rfl⟩ - -protected theorem add_le_add_iff_left {n : Nat} : n + m ≤ n + k ↔ m ≤ k := - ⟨Nat.le_of_add_le_add_left, fun h => Nat.add_le_add_left h _⟩ - -protected theorem lt_of_add_lt_add_right : ∀ {n : Nat}, k + n < m + n → k < m - | 0, h => h - | _+1, h => Nat.lt_of_add_lt_add_right (Nat.lt_of_succ_lt_succ h) - -protected theorem lt_of_add_lt_add_left {n : Nat} : n + k < n + m → k < m := by - rw [Nat.add_comm n, Nat.add_comm n]; exact Nat.lt_of_add_lt_add_right - -protected theorem add_lt_add_iff_left {k n m : Nat} : k + n < k + m ↔ n < m := - ⟨Nat.lt_of_add_lt_add_left, fun h => Nat.add_lt_add_left h _⟩ - -protected theorem add_lt_add_iff_right {k n m : Nat} : n + k < m + k ↔ n < m := - ⟨Nat.lt_of_add_lt_add_right, fun h => Nat.add_lt_add_right h _⟩ - -protected theorem add_lt_add_of_le_of_lt {a b c d : Nat} (hle : a ≤ b) (hlt : c < d) : - a + c < b + d := - Nat.lt_of_le_of_lt (Nat.add_le_add_right hle _) (Nat.add_lt_add_left hlt _) - -protected theorem add_lt_add_of_lt_of_le {a b c d : Nat} (hlt : a < b) (hle : c ≤ d) : - a + c < b + d := - Nat.lt_of_le_of_lt (Nat.add_le_add_left hle _) (Nat.add_lt_add_right hlt _) - -protected theorem lt_add_left (c : Nat) (h : a < b) : a < c + b := - Nat.lt_of_lt_of_le h (Nat.le_add_left ..) - -protected theorem lt_add_right (c : Nat) (h : a < b) : a < b + c := - Nat.lt_of_lt_of_le h (Nat.le_add_right ..) - -protected theorem lt_add_of_pos_right (h : 0 < k) : n < n + k := - Nat.add_lt_add_left h n - -protected theorem lt_add_of_pos_left : 0 < k → n < k + n := by - rw [Nat.add_comm]; exact Nat.lt_add_of_pos_right - -protected theorem pos_of_lt_add_right (h : n < n + k) : 0 < k := - Nat.lt_of_add_lt_add_left h - -protected theorem pos_of_lt_add_left : n < k + n → 0 < k := by - rw [Nat.add_comm]; exact Nat.pos_of_lt_add_right - -protected theorem lt_add_right_iff_pos : n < n + k ↔ 0 < k := - ⟨Nat.pos_of_lt_add_right, Nat.lt_add_of_pos_right⟩ - -protected theorem lt_add_left_iff_pos : n < k + n ↔ 0 < k := - ⟨Nat.pos_of_lt_add_left, Nat.lt_add_of_pos_left⟩ - -protected theorem add_pos_left (h : 0 < m) (n) : 0 < m + n := - Nat.lt_of_lt_of_le h (Nat.le_add_right ..) - -protected theorem add_pos_right (m) (h : 0 < n) : 0 < m + n := - Nat.lt_of_lt_of_le h (Nat.le_add_left ..) - -protected theorem add_self_ne_one : ∀ n, n + n ≠ 1 - | n+1, h => by rw [Nat.succ_add, Nat.succ_inj'] at h; contradiction - /-! ## sub -/ -protected theorem sub_one (n) : n - 1 = pred n := rfl - -protected theorem one_sub : ∀ n, 1 - n = if n = 0 then 1 else 0 - | 0 => rfl - | _+1 => by rw [if_neg (Nat.succ_ne_zero _), Nat.succ_sub_succ, Nat.zero_sub] - -theorem succ_sub_sub_succ (n m k) : succ n - m - succ k = n - m - k := by - rw [Nat.sub_sub, Nat.sub_sub, add_succ, succ_sub_succ] - -protected theorem sub_right_comm (m n k : Nat) : m - n - k = m - k - n := by - rw [Nat.sub_sub, Nat.sub_sub, Nat.add_comm] - -protected theorem add_sub_cancel_right (n m : Nat) : (n + m) - m = n := Nat.add_sub_cancel .. - -@[simp] protected theorem add_sub_cancel' {n m : Nat} (h : m ≤ n) : m + (n - m) = n := by - rw [Nat.add_comm, Nat.sub_add_cancel h] - -theorem succ_sub_one (n) : succ n - 1 = n := rfl - -protected theorem add_one_sub_one (n : Nat) : (n + 1) - 1 = n := rfl - -protected theorem one_add_sub_one (n : Nat) : (1 + n) - 1 = n := Nat.add_sub_cancel_left 1 _ - -protected theorem sub_sub_self {n m : Nat} (h : m ≤ n) : n - (n - m) = m := - (Nat.sub_eq_iff_eq_add (Nat.sub_le ..)).2 (Nat.add_sub_of_le h).symm - -protected theorem sub_add_comm {n m k : Nat} (h : k ≤ n) : n + m - k = n - k + m := by - rw [Nat.sub_eq_iff_eq_add (Nat.le_trans h (Nat.le_add_right ..))] - rwa [Nat.add_right_comm, Nat.sub_add_cancel] - -protected theorem sub_eq_zero_iff_le : n - m = 0 ↔ n ≤ m := - ⟨Nat.le_of_sub_eq_zero, Nat.sub_eq_zero_of_le⟩ - -protected theorem sub_pos_iff_lt : 0 < n - m ↔ m < n := - ⟨Nat.lt_of_sub_pos, Nat.sub_pos_of_lt⟩ - -protected theorem sub_le_iff_le_add {a b c : Nat} : a - b ≤ c ↔ a ≤ c + b := - ⟨Nat.le_add_of_sub_le, sub_le_of_le_add⟩ - -protected theorem sub_le_iff_le_add' {a b c : Nat} : a - b ≤ c ↔ a ≤ b + c := by - rw [Nat.add_comm, Nat.sub_le_iff_le_add] - -protected theorem le_sub_iff_add_le {n : Nat} (h : k ≤ m) : n ≤ m - k ↔ n + k ≤ m := - ⟨Nat.add_le_of_le_sub h, Nat.le_sub_of_add_le⟩ - -@[deprecated Nat.le_sub_iff_add_le] -protected theorem add_le_to_le_sub (n : Nat) (h : m ≤ k) : n + m ≤ k ↔ n ≤ k - m := - (Nat.le_sub_iff_add_le h).symm - -protected theorem add_le_of_le_sub' {n k m : Nat} (h : m ≤ k) : n ≤ k - m → m + n ≤ k := - Nat.add_comm .. ▸ Nat.add_le_of_le_sub h - -@[deprecated Nat.add_le_of_le_sub'] -protected theorem add_le_of_le_sub_left {n k m : Nat} (h : m ≤ k) : n ≤ k - m → m + n ≤ k := - Nat.add_le_of_le_sub' h - -protected theorem le_sub_of_add_le' {n k m : Nat} : m + n ≤ k → n ≤ k - m := - Nat.add_comm .. ▸ Nat.le_sub_of_add_le - -protected theorem le_sub_iff_add_le' {n : Nat} (h : k ≤ m) : n ≤ m - k ↔ k + n ≤ m := - ⟨Nat.add_le_of_le_sub' h, Nat.le_sub_of_add_le'⟩ - @[deprecated] protected alias le_of_le_of_sub_le_sub_right := Nat.le_of_sub_le_sub_right -protected theorem le_of_sub_le_sub_left : ∀ {n k m : Nat}, n ≤ k → k - m ≤ k - n → n ≤ m - | 0, _, _, _, _ => Nat.zero_le .. - | _+1, _, 0, h₀, h₁ => - absurd (Nat.sub_lt (Nat.zero_lt_of_lt h₀) (Nat.zero_lt_succ _)) (Nat.not_lt.2 h₁) - | _+1, _+1, _+1, h₀, h₁ => by - simp only [Nat.succ_sub_succ] at h₁ - exact succ_le_succ <| Nat.le_of_sub_le_sub_left (Nat.le_of_succ_le_succ h₀) h₁ @[deprecated] protected alias le_of_le_of_sub_le_sub_left := Nat.le_of_sub_le_sub_left -protected theorem sub_le_sub_iff_left {n m k : Nat} (h : n ≤ k) : k - m ≤ k - n ↔ n ≤ m := - ⟨Nat.le_of_sub_le_sub_left h, fun h => Nat.sub_le_sub_left h _⟩ - -protected theorem sub_lt_of_pos_le (h₀ : 0 < a) (h₁ : a ≤ b) : b - a < b := - Nat.sub_lt (Nat.lt_of_lt_of_le h₀ h₁) h₀ -protected alias sub_lt_self := Nat.sub_lt_of_pos_le - -theorem add_lt_of_lt_sub' {a b c : Nat} : b < c - a → a + b < c := by - rw [Nat.add_comm]; exact Nat.add_lt_of_lt_sub - -protected theorem sub_add_lt_sub (h₁ : m + k ≤ n) (h₂ : 0 < k) : n - (m + k) < n - m := by - rw [← Nat.sub_sub]; exact Nat.sub_lt_of_pos_le h₂ (Nat.le_sub_of_add_le' h₁) - -theorem le_sub_one_of_lt : a < b → a ≤ b - 1 := Nat.le_pred_of_lt - -theorem sub_one_lt_of_le (h₀ : 0 < a) (h₁ : a ≤ b) : a - 1 < b := - Nat.lt_of_lt_of_le (Nat.pred_lt' h₀) h₁ - -theorem sub_lt_succ (a b) : a - b < succ a := lt_succ_of_le (sub_le a b) - -theorem sub_one_sub_lt (h : i < n) : n - 1 - i < n := by - rw [Nat.sub_right_comm]; exact Nat.sub_one_lt_of_le (Nat.sub_pos_of_lt h) (Nat.sub_le ..) - -protected theorem exists_eq_add_of_le (h : m ≤ n) : ∃ k : Nat, n = m + k := - ⟨n - m, (add_sub_of_le h).symm⟩ - -protected theorem exists_eq_add_of_le' (h : m ≤ n) : ∃ k : Nat, n = k + m := - ⟨n - m, (Nat.sub_add_cancel h).symm⟩ - -protected theorem exists_eq_add_of_lt (h : m < n) : ∃ k : Nat, n = m + k + 1 := - ⟨n - (m + 1), by rw [Nat.add_right_comm, add_sub_of_le h]⟩ - /-! ### min/max -/ -theorem succ_min_succ (x y) : min (succ x) (succ y) = succ (min x y) := by - cases Nat.le_total x y with - | inl h => rw [Nat.min_eq_left h, Nat.min_eq_left (Nat.succ_le_succ h)] - | inr h => rw [Nat.min_eq_right h, Nat.min_eq_right (Nat.succ_le_succ h)] - -@[simp] protected theorem min_self (a : Nat) : min a a = a := Nat.min_eq_left (Nat.le_refl _) - -@[simp] protected theorem zero_min (a) : min 0 a = 0 := Nat.min_eq_left (Nat.zero_le _) - -@[simp] protected theorem min_zero (a) : min a 0 = 0 := Nat.min_eq_right (Nat.zero_le _) - -protected theorem min_assoc : ∀ (a b c : Nat), min (min a b) c = min a (min b c) - | 0, _, _ => by rw [Nat.zero_min, Nat.zero_min, Nat.zero_min] - | _, 0, _ => by rw [Nat.zero_min, Nat.min_zero, Nat.zero_min] - | _, _, 0 => by rw [Nat.min_zero, Nat.min_zero, Nat.min_zero] - | _+1, _+1, _+1 => by simp only [Nat.succ_min_succ]; exact congrArg succ <| Nat.min_assoc .. - -protected theorem sub_sub_eq_min : ∀ (a b : Nat), a - (a - b) = min a b - | 0, _ => by rw [Nat.zero_sub, Nat.zero_min] - | _, 0 => by rw [Nat.sub_zero, Nat.sub_self, Nat.min_zero] - | _+1, _+1 => by - rw [Nat.succ_sub_succ, Nat.succ_min_succ, Nat.succ_sub (Nat.sub_le ..)] - exact congrArg succ <| Nat.sub_sub_eq_min .. - -protected theorem sub_eq_sub_min (n m : Nat) : n - m = n - min n m := by - cases Nat.le_total n m with - | inl h => rw [Nat.min_eq_left h, Nat.sub_eq_zero_of_le h, Nat.sub_self] - | inr h => rw [Nat.min_eq_right h] - -@[simp] protected theorem sub_add_min_cancel (n m : Nat) : n - m + min n m = n := by - rw [Nat.sub_eq_sub_min, Nat.sub_add_cancel (Nat.min_le_left ..)] - -protected theorem max_eq_right {a b : Nat} (h : a ≤ b) : max a b = b := if_pos h - -protected theorem max_eq_left {a b : Nat} (h : b ≤ a) : max a b = a := by - rw [Nat.max_comm]; exact Nat.max_eq_right h - -protected theorem succ_max_succ (x y) : max (succ x) (succ y) = succ (max x y) := by - cases Nat.le_total x y with - | inl h => rw [Nat.max_eq_right h, Nat.max_eq_right (Nat.succ_le_succ h)] - | inr h => rw [Nat.max_eq_left h, Nat.max_eq_left (Nat.succ_le_succ h)] - -protected theorem max_le_of_le_of_le {a b c : Nat} : a ≤ c → b ≤ c → max a b ≤ c := by - intros; cases Nat.le_total a b with - | inl h => rw [Nat.max_eq_right h]; assumption - | inr h => rw [Nat.max_eq_left h]; assumption - -protected theorem max_le {a b c : Nat} : max a b ≤ c ↔ a ≤ c ∧ b ≤ c := - ⟨fun h => ⟨Nat.le_trans (Nat.le_max_left ..) h, Nat.le_trans (Nat.le_max_right ..) h⟩, - fun ⟨h₁, h₂⟩ => Nat.max_le_of_le_of_le h₁ h₂⟩ - -protected theorem max_lt {a b c : Nat} : max a b < c ↔ a < c ∧ b < c := by - rw [← Nat.succ_le, ← Nat.succ_max_succ a b]; exact Nat.max_le - -@[simp] protected theorem max_self (a : Nat) : max a a = a := Nat.max_eq_right (Nat.le_refl _) - -@[simp] protected theorem zero_max (a) : max 0 a = a := Nat.max_eq_right (Nat.zero_le _) - -@[simp] protected theorem max_zero (a) : max a 0 = a := Nat.max_eq_left (Nat.zero_le _) - -protected theorem max_assoc : ∀ (a b c : Nat), max (max a b) c = max a (max b c) - | 0, _, _ => by rw [Nat.zero_max, Nat.zero_max] - | _, 0, _ => by rw [Nat.zero_max, Nat.max_zero] - | _, _, 0 => by rw [Nat.max_zero, Nat.max_zero] - | _+1, _+1, _+1 => by simp only [Nat.succ_max_succ]; exact congrArg succ <| Nat.max_assoc .. - -protected theorem sub_add_eq_max (a b : Nat) : a - b + b = max a b := by - match Nat.le_total a b with - | .inl hl => rw [Nat.max_eq_right hl, Nat.sub_eq_zero_iff_le.mpr hl, Nat.zero_add] - | .inr hr => rw [Nat.max_eq_left hr, Nat.sub_add_cancel hr] - -protected theorem sub_eq_max_sub (n m : Nat) : n - m = max n m - m := by - cases Nat.le_total m n with - | inl h => rw [Nat.max_eq_left h] - | inr h => rw [Nat.max_eq_right h, Nat.sub_eq_zero_of_le h, Nat.sub_self] - -protected theorem max_min_distrib_left : ∀ (a b c : Nat), max a (min b c) = min (max a b) (max a c) - | 0, _, _ => by simp only [Nat.zero_max] - | _, 0, _ => by - rw [Nat.zero_min, Nat.max_zero] - exact Nat.min_eq_left (Nat.le_max_left ..) |>.symm - | _, _, 0 => by - rw [Nat.min_zero, Nat.max_zero] - exact Nat.min_eq_right (Nat.le_max_left ..) |>.symm - | _+1, _+1, _+1 => by - simp only [Nat.succ_max_succ, Nat.succ_min_succ] - exact congrArg succ <| Nat.max_min_distrib_left .. - -protected theorem min_max_distrib_left : ∀ (a b c : Nat), min a (max b c) = max (min a b) (min a c) - | 0, _, _ => by simp only [Nat.zero_min, Nat.max_self] - | _, 0, _ => by simp only [Nat.min_zero, Nat.zero_max] - | _, _, 0 => by simp only [Nat.min_zero, Nat.max_zero] - | _+1, _+1, _+1 => by - simp only [Nat.succ_max_succ, Nat.succ_min_succ] - exact congrArg succ <| Nat.min_max_distrib_left .. - -protected theorem max_min_distrib_right (a b c : Nat) : - max (min a b) c = min (max a c) (max b c) := by - repeat rw [Nat.max_comm _ c] - exact Nat.max_min_distrib_left .. - -protected theorem min_max_distrib_right (a b c : Nat) : - min (max a b) c = max (min a c) (min b c) := by - repeat rw [Nat.min_comm _ c] - exact Nat.min_max_distrib_left .. - -protected theorem add_max_add_right : ∀ (a b c : Nat), max (a + c) (b + c) = max a b + c - | _, _, 0 => rfl - | _, _, _+1 => Eq.trans (Nat.succ_max_succ ..) <| congrArg _ (Nat.add_max_add_right ..) - -protected theorem add_min_add_right : ∀ (a b c : Nat), min (a + c) (b + c) = min a b + c - | _, _, 0 => rfl - | _, _, _+1 => Eq.trans (Nat.succ_min_succ ..) <| congrArg _ (Nat.add_min_add_right ..) - -protected theorem add_max_add_left (a b c : Nat) : max (a + b) (a + c) = a + max b c := by - repeat rw [Nat.add_comm a] - exact Nat.add_max_add_right .. - -protected theorem add_min_add_left (a b c : Nat) : min (a + b) (a + c) = a + min b c := by - repeat rw [Nat.add_comm a] - exact Nat.add_min_add_right .. - -protected theorem pred_min_pred : ∀ (x y), min (pred x) (pred y) = pred (min x y) - | 0, _ => by simp only [Nat.pred_zero, Nat.zero_min] - | _, 0 => by simp only [Nat.pred_zero, Nat.min_zero] - | _+1, _+1 => by simp only [Nat.pred_succ, Nat.succ_min_succ] - -protected theorem pred_max_pred : ∀ (x y), max (pred x) (pred y) = pred (max x y) - | 0, _ => by simp only [Nat.pred_zero, Nat.zero_max] - | _, 0 => by simp only [Nat.pred_zero, Nat.max_zero] - | _+1, _+1 => by simp only [Nat.pred_succ, Nat.succ_max_succ] - -protected theorem sub_min_sub_right : ∀ (a b c : Nat), min (a - c) (b - c) = min a b - c - | _, _, 0 => rfl - | _, _, _+1 => Eq.trans (Nat.pred_min_pred ..) <| congrArg _ (Nat.sub_min_sub_right ..) - -protected theorem sub_max_sub_right : ∀ (a b c : Nat), max (a - c) (b - c) = max a b - c - | _, _, 0 => rfl - | _, _, _+1 => Eq.trans (Nat.pred_max_pred ..) <| congrArg _ (Nat.sub_max_sub_right ..) - protected theorem sub_min_sub_left (a b c : Nat) : min (a - b) (a - c) = a - max b c := by induction b, c using Nat.recDiagAux with | zero_left => rw [Nat.sub_zero, Nat.zero_max]; exact Nat.min_eq_right (Nat.sub_le ..) @@ -677,477 +236,18 @@ protected theorem mul_min_mul_left (a b c : Nat) : min (a * b) (a * c) = a * min /-! ### mul -/ -@[deprecated Nat.mul_le_mul_left] -protected theorem mul_le_mul_of_nonneg_left {a b c : Nat} : a ≤ b → c * a ≤ c * b := - Nat.mul_le_mul_left c - -@[deprecated Nat.mul_le_mul_right] -protected theorem mul_le_mul_of_nonneg_right {a b c : Nat} : a ≤ b → a * c ≤ b * c := - Nat.mul_le_mul_right c - -protected theorem mul_right_comm (n m k : Nat) : n * m * k = n * k * m := by - rw [Nat.mul_assoc, Nat.mul_comm m, ← Nat.mul_assoc] - -protected theorem mul_mul_mul_comm (a b c d : Nat) : (a * b) * (c * d) = (a * c) * (b * d) := by - rw [Nat.mul_assoc, Nat.mul_assoc, Nat.mul_left_comm b] - -protected theorem mul_two (n) : n * 2 = n + n := by rw [Nat.mul_succ, Nat.mul_one] - -protected theorem two_mul (n) : 2 * n = n + n := by rw [Nat.succ_mul, Nat.one_mul] - -theorem mul_eq_zero : ∀ {m n}, n * m = 0 ↔ n = 0 ∨ m = 0 - | 0, _ => ⟨fun _ => .inr rfl, fun _ => rfl⟩ - | _, 0 => ⟨fun _ => .inl rfl, fun _ => Nat.zero_mul ..⟩ - | _+1, _+1 => ⟨nofun, nofun⟩ - -protected theorem mul_ne_zero_iff : n * m ≠ 0 ↔ n ≠ 0 ∧ m ≠ 0 := by rw [ne_eq, mul_eq_zero, not_or] - -protected theorem mul_ne_zero : n ≠ 0 → m ≠ 0 → n * m ≠ 0 := (Nat.mul_ne_zero_iff.2 ⟨·,·⟩) - -protected theorem ne_zero_of_mul_ne_zero_left (h : n * m ≠ 0) : n ≠ 0 := - (Nat.mul_ne_zero_iff.1 h).1 - -protected theorem mul_left_cancel {n m k : Nat} (np : 0 < n) (h : n * m = n * k) : m = k := by - match Nat.lt_trichotomy m k with - | Or.inl p => - have r : n * m < n * k := Nat.mul_lt_mul_of_pos_left p np - simp [h] at r - | Or.inr (Or.inl p) => exact p - | Or.inr (Or.inr p) => - have r : n * k < n * m := Nat.mul_lt_mul_of_pos_left p np - simp [h] at r - -protected theorem mul_right_cancel {n m k : Nat} (mp : 0 < m) (h : n * m = k * m) : n = k := by - simp [Nat.mul_comm _ m] at h - apply Nat.mul_left_cancel mp h - -protected theorem mul_left_cancel_iff {n: Nat} (p : 0 < n) (m k : Nat) : n * m = n * k ↔ m = k := - ⟨Nat.mul_left_cancel p, fun | rfl => rfl⟩ - -protected theorem mul_right_cancel_iff {m : Nat} (p : 0 < m) (n k : Nat) : n * m = k * m ↔ n = k := - ⟨Nat.mul_right_cancel p, fun | rfl => rfl⟩ - -protected theorem ne_zero_of_mul_ne_zero_right (h : n * m ≠ 0) : m ≠ 0 := - (Nat.mul_ne_zero_iff.1 h).2 - -protected theorem le_mul_of_pos_left (m) (h : 0 < n) : m ≤ n * m := - Nat.le_trans (Nat.le_of_eq (Nat.one_mul _).symm) (Nat.mul_le_mul_right _ h) - -protected theorem le_mul_of_pos_right (n) (h : 0 < m) : n ≤ n * m := - Nat.le_trans (Nat.le_of_eq (Nat.mul_one _).symm) (Nat.mul_le_mul_left _ h) - -protected theorem mul_lt_mul_of_lt_of_le (hac : a < c) (hbd : b ≤ d) (hd : 0 < d) : - a * b < c * d := - Nat.lt_of_le_of_lt (Nat.mul_le_mul_left _ hbd) (Nat.mul_lt_mul_of_pos_right hac hd) - -protected theorem mul_lt_mul_of_lt_of_le' (hac : a < c) (hbd : b ≤ d) (hb : 0 < b) : - a * b < c * d := - Nat.mul_lt_mul_of_lt_of_le hac hbd (Nat.lt_of_lt_of_le hb hbd) - @[deprecated] protected alias mul_lt_mul := Nat.mul_lt_mul_of_lt_of_le' -protected theorem mul_lt_mul_of_le_of_lt (hac : a ≤ c) (hbd : b < d) (hc : 0 < c) : - a * b < c * d := - Nat.lt_of_le_of_lt (Nat.mul_le_mul_right _ hac) (Nat.mul_lt_mul_of_pos_left hbd hc) - -protected theorem mul_lt_mul_of_le_of_lt' (hac : a ≤ c) (hbd : b < d) (ha : 0 < a) : - a * b < c * d := - Nat.mul_lt_mul_of_le_of_lt hac hbd (Nat.lt_of_lt_of_le ha hac) - @[deprecated] protected alias mul_lt_mul' := Nat.mul_lt_mul_of_le_of_lt -protected theorem mul_lt_mul_of_lt_of_lt {a b c d : Nat} (hac : a < c) (hbd : b < d) : - a * b < c * d := - Nat.mul_lt_mul_of_le_of_lt (Nat.le_of_lt hac) hbd (Nat.zero_lt_of_lt hac) - -theorem succ_mul_succ (a b) : succ a * succ b = a * b + a + b + 1 := by - rw [succ_mul, mul_succ]; rfl -theorem mul_le_add_right (m k n : Nat) : k * m ≤ m + n ↔ (k-1) * m ≤ n := by - match k with - | 0 => - simp - | succ k => - simp [succ_mul, Nat.add_comm _ m, Nat.add_le_add_iff_left] - -theorem succ_mul_succ_eq (a b : Nat) : succ a * succ b = a * b + a + b + 1 := by - rw [mul_succ, succ_mul, Nat.add_right_comm _ a]; rfl - -protected theorem mul_self_sub_mul_self_eq (a b : Nat) : a * a - b * b = (a + b) * (a - b) := by - rw [Nat.mul_sub_left_distrib, Nat.right_distrib, Nat.right_distrib, Nat.mul_comm b a, - Nat.sub_add_eq, Nat.add_sub_cancel] - -protected theorem pos_of_mul_pos_left {a b : Nat} (h : 0 < a * b) : 0 < b := by - by_contra w; simp_all - -protected theorem pos_of_mul_pos_right {a b : Nat} (h : 0 < a * b) : 0 < a := by - by_contra w; simp_all - -@[simp] protected theorem mul_pos_iff_of_pos_left {a b : Nat} (h : 0 < a) : - 0 < a * b ↔ 0 < b := - ⟨Nat.pos_of_mul_pos_left, Nat.mul_pos h⟩ - -@[simp] protected theorem mul_pos_iff_of_pos_right {a b : Nat} (h : 0 < b) : - 0 < a * b ↔ 0 < a := - ⟨Nat.pos_of_mul_pos_right, fun w => Nat.mul_pos w h⟩ - /-! ### div/mod -/ -- TODO mod_core_congr, mod_def -- TODO div_core_congr, div_def -protected theorem div_le_of_le_mul {m n : Nat} : ∀ {k}, m ≤ k * n → m / k ≤ n - | 0, _ => by simp [Nat.div_zero, n.zero_le] - | succ k, h => by - suffices succ k * (m / succ k) ≤ succ k * n from - Nat.le_of_mul_le_mul_left this (zero_lt_succ _) - have h1 : succ k * (m / succ k) ≤ m % succ k + succ k * (m / succ k) := Nat.le_add_left _ _ - have h2 : m % succ k + succ k * (m / succ k) = m := by rw [mod_add_div] - have h3 : m ≤ succ k * n := h - rw [← h2] at h3 - exact Nat.le_trans h1 h3 - -@[simp] theorem mul_div_right (n : Nat) {m : Nat} (H : 0 < m) : m * n / m = n := by - induction n <;> simp_all [mul_succ] - -@[simp] theorem mul_div_left (m : Nat) {n : Nat} (H : 0 < n) : m * n / n = m := by - rw [Nat.mul_comm, mul_div_right _ H] - -protected theorem div_self (H : 0 < n) : n / n = 1 := by - let t := add_div_right 0 H - rwa [Nat.zero_add, Nat.zero_div] at t - -protected theorem mul_div_cancel (m : Nat) {n : Nat} (H : 0 < n) : m * n / n = m := by - let t := add_mul_div_right 0 m H - rwa [Nat.zero_add, Nat.zero_div, Nat.zero_add] at t - -protected theorem mul_div_cancel_left (m : Nat) {n : Nat} (H : 0 < n) : n * m / n = m := -by rw [Nat.mul_comm, Nat.mul_div_cancel _ H] - -protected theorem div_eq_of_eq_mul_left (H1 : 0 < n) (H2 : m = k * n) : m / n = k := -by rw [H2, Nat.mul_div_cancel _ H1] - -protected theorem div_eq_of_eq_mul_right (H1 : 0 < n) (H2 : m = n * k) : m / n = k := -by rw [H2, Nat.mul_div_cancel_left _ H1] - -protected theorem div_div_eq_div_mul (m n k : Nat) : m / n / k = m / (n * k) := by - cases eq_zero_or_pos k with - | inl k0 => rw [k0, Nat.mul_zero, Nat.div_zero, Nat.div_zero] | inr kpos => ?_ - cases eq_zero_or_pos n with - | inl n0 => rw [n0, Nat.zero_mul, Nat.div_zero, Nat.zero_div] | inr npos => ?_ - apply Nat.le_antisymm - · apply (le_div_iff_mul_le (Nat.mul_pos npos kpos)).2 - rw [Nat.mul_comm n k, ← Nat.mul_assoc] - apply (le_div_iff_mul_le npos).1 - apply (le_div_iff_mul_le kpos).1 - (apply Nat.le_refl) - · apply (le_div_iff_mul_le kpos).2 - apply (le_div_iff_mul_le npos).2 - rw [Nat.mul_assoc, Nat.mul_comm n k] - apply (le_div_iff_mul_le (Nat.mul_pos kpos npos)).1 - apply Nat.le_refl - -protected theorem mul_div_mul_left {m : Nat} (n k : Nat) (H : 0 < m) : - m * n / (m * k) = n / k := by rw [← Nat.div_div_eq_div_mul, Nat.mul_div_cancel_left _ H] - -protected theorem mul_div_mul_right {m : Nat} (n k : Nat) (H : 0 < m) : - n * m / (k * m) = n / k := by rw [Nat.mul_comm, Nat.mul_comm k, Nat.mul_div_mul_left _ _ H] - -theorem mul_div_le (m n : Nat) : n * (m / n) ≤ m := by - match n, Nat.eq_zero_or_pos n with - | _, Or.inl rfl => rw [Nat.zero_mul]; exact m.zero_le - | n, Or.inr h => rw [Nat.mul_comm, ← Nat.le_div_iff_mul_le h]; exact Nat.le_refl _ - -theorem mod_two_eq_zero_or_one (n : Nat) : n % 2 = 0 ∨ n % 2 = 1 := - match n % 2, @Nat.mod_lt n 2 (by decide) with - | 0, _ => .inl rfl - | 1, _ => .inr rfl - -theorem le_of_mod_lt {a b : Nat} (h : a % b < a) : b ≤ a := - Nat.not_lt.1 fun hf => (ne_of_lt h).elim (Nat.mod_eq_of_lt hf) - -theorem mul_mod_mul_right (z x y : Nat) : (x * z) % (y * z) = (x % y) * z := by - rw [Nat.mul_comm x z, Nat.mul_comm y z, Nat.mul_comm (x % y) z]; apply mul_mod_mul_left - -@[simp] theorem mod_mod_of_dvd (a : Nat) (h : c ∣ b) : a % b % c = a % c := by - conv => - rhs - rw [← mod_add_div a b] - obtain ⟨x, rfl⟩ := h - rw [Nat.mul_assoc, add_mul_mod_self_left] - -- TODO cont_to_bool_mod_two -theorem sub_mul_mod {x k n : Nat} (h₁ : n*k ≤ x) : (x - n*k) % n = x % n := by - match k with - | 0 => rw [Nat.mul_zero, Nat.sub_zero] - | succ k => - have h₂ : n * k ≤ x := Nat.le_trans (le_add_right _ n) h₁ - have h₄ : x - n * k ≥ n := by - apply Nat.le_of_add_le_add_right (b := n * k) - rw [Nat.sub_add_cancel h₂] - simp [mul_succ, Nat.add_comm] at h₁; simp [h₁] - rw [mul_succ, ← Nat.sub_sub, ← mod_eq_sub_mod h₄, sub_mul_mod h₂] - -@[simp] theorem mod_mod (a n : Nat) : (a % n) % n = a % n := - match eq_zero_or_pos n with - | .inl n0 => by simp [n0, mod_zero] - | .inr npos => Nat.mod_eq_of_lt (mod_lt _ npos) - -theorem mul_mod (a b n : Nat) : a * b % n = (a % n) * (b % n) % n := by - conv => lhs; rw [ - ← mod_add_div a n, ← mod_add_div b n, Nat.add_mul, Nat.mul_add, Nat.mul_add, - Nat.mul_assoc, Nat.mul_assoc, ← Nat.mul_add n, add_mul_mod_self_left, - Nat.mul_comm _ (n * (b / n)), Nat.mul_assoc, add_mul_mod_self_left] - -@[simp] theorem mod_add_mod (m n k : Nat) : (m % n + k) % n = (m + k) % n := by - have := (add_mul_mod_self_left (m % n + k) n (m / n)).symm - rwa [Nat.add_right_comm, mod_add_div] at this - -@[simp] theorem add_mod_mod (m n k : Nat) : (m + n % k) % k = (m + n) % k := by - rw [Nat.add_comm, mod_add_mod, Nat.add_comm] - -theorem add_mod (a b n : Nat) : (a + b) % n = ((a % n) + (b % n)) % n := by - rw [add_mod_mod, mod_add_mod] - -/-! ### pow -/ - -theorem pow_succ' {m n : Nat} : m ^ n.succ = m * m ^ n := by - rw [Nat.pow_succ, Nat.mul_comm] - -@[simp] theorem pow_eq {m n : Nat} : m.pow n = m ^ n := rfl - -theorem shiftLeft_eq (a b : Nat) : a <<< b = a * 2 ^ b := - match b with - | 0 => (Nat.mul_one _).symm - | b+1 => (shiftLeft_eq _ b).trans <| by - simp [pow_succ, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm] - -theorem one_shiftLeft (n : Nat) : 1 <<< n = 2 ^ n := by rw [shiftLeft_eq, Nat.one_mul] - -attribute [simp] Nat.pow_zero - -protected theorem zero_pow {n : Nat} (H : 0 < n) : 0 ^ n = 0 := by - match n with - | 0 => contradiction - | n+1 => rw [Nat.pow_succ, Nat.mul_zero] - -@[simp] protected theorem one_pow (n : Nat) : 1 ^ n = 1 := by - induction n with - | zero => rfl - | succ _ ih => rw [Nat.pow_succ, Nat.mul_one, ih] - -@[simp] protected theorem pow_one (a : Nat) : a ^ 1 = a := by - rw [Nat.pow_succ, Nat.pow_zero, Nat.one_mul] - -protected theorem pow_two (a : Nat) : a ^ 2 = a * a := by rw [Nat.pow_succ, Nat.pow_one] - -protected theorem pow_add (a m n : Nat) : a ^ (m + n) = a ^ m * a ^ n := by - induction n with - | zero => rw [Nat.add_zero, Nat.pow_zero, Nat.mul_one] - | succ _ ih => rw [Nat.add_succ, Nat.pow_succ, Nat.pow_succ, ih, Nat.mul_assoc] - -protected theorem pow_add' (a m n : Nat) : a ^ (m + n) = a ^ n * a ^ m := by - rw [← Nat.pow_add, Nat.add_comm] - -protected theorem pow_mul (a m n : Nat) : a ^ (m * n) = (a ^ m) ^ n := by - induction n with - | zero => rw [Nat.mul_zero, Nat.pow_zero, Nat.pow_zero] - | succ _ ih => rw [Nat.mul_succ, Nat.pow_add, Nat.pow_succ, ih] - -protected theorem pow_mul' (a m n : Nat) : a ^ (m * n) = (a ^ n) ^ m := by - rw [← Nat.pow_mul, Nat.mul_comm] - -protected theorem pow_right_comm (a m n : Nat) : (a ^ m) ^ n = (a ^ n) ^ m := by - rw [← Nat.pow_mul, Nat.pow_mul'] - -protected theorem mul_pow (a b n : Nat) : (a * b) ^ n = a ^ n * b ^ n := by - induction n with - | zero => rw [Nat.pow_zero, Nat.pow_zero, Nat.pow_zero, Nat.mul_one] - | succ _ ih => rw [Nat.pow_succ, Nat.pow_succ, Nat.pow_succ, Nat.mul_mul_mul_comm, ih] - -protected alias pow_le_pow_left := pow_le_pow_of_le_left -protected alias pow_le_pow_right := pow_le_pow_of_le_right - -protected theorem one_lt_two_pow (h : n ≠ 0) : 1 < 2 ^ n := - match n, h with - | n+1, _ => by - rw [Nat.pow_succ', ← Nat.one_mul 1] - exact Nat.mul_lt_mul_of_lt_of_le' (by decide) (Nat.two_pow_pos n) (by decide) - -@[simp] protected theorem one_lt_two_pow_iff : 1 < 2 ^ n ↔ n ≠ 0 := - ⟨(by intro h p; subst p; simp at h), Nat.one_lt_two_pow⟩ - -protected theorem one_le_two_pow : 1 ≤ 2 ^ n := by - if h : n = 0 then - subst h; simp - else - exact Nat.le_of_lt (Nat.one_lt_two_pow h) - -protected theorem pow_pos (h : 0 < a) : 0 < a^n := - match n with - | 0 => Nat.zero_lt_one - | _ + 1 => Nat.mul_pos (Nat.pow_pos h) h - -protected theorem pow_lt_pow_succ (h : 1 < a) : a ^ n < a ^ (n + 1) := by - rw [Nat.pow_succ] - conv => lhs; rw [← Nat.mul_one (a^n)] - exact Nat.mul_lt_mul_of_le_of_lt (Nat.le_refl _) h (Nat.pow_pos (Nat.lt_trans Nat.zero_lt_one h)) - -protected theorem pow_lt_pow_of_lt {a n m : Nat} (h : 1 < a) (w : n < m) : a ^ n < a ^ m := by - have := Nat.exists_eq_add_of_lt w - cases this - case intro k p => - rw [Nat.add_right_comm] at p - subst p - rw [Nat.pow_add] - conv => lhs; rw [← Nat.mul_one (a^n)] - have t : 0 < a ^ k := Nat.pow_pos (Nat.lt_trans Nat.zero_lt_one h) - exact Nat.mul_lt_mul_of_lt_of_le (Nat.pow_lt_pow_succ h) t t - -protected theorem pow_le_pow_of_le {a n m : Nat} (h : 1 < a) (w : n ≤ m) : a ^ n ≤ a ^ m := by - cases Nat.lt_or_eq_of_le w - case inl lt => - exact Nat.le_of_lt (Nat.pow_lt_pow_of_lt h lt) - case inr eq => - subst eq - exact Nat.le_refl _ - -protected theorem pow_le_pow_iff_right {a n m : Nat} (h : 1 < a) : - a ^ n ≤ a ^ m ↔ n ≤ m := by - constructor - · by_contra w - simp [Decidable.not_imp_iff_and_not] at w - apply Nat.lt_irrefl (a ^ n) - exact Nat.lt_of_le_of_lt w.1 (Nat.pow_lt_pow_of_lt h w.2) - · intro w - cases Nat.eq_or_lt_of_le w - case inl eq => subst eq; apply Nat.le_refl - case inr lt => exact Nat.le_of_lt (Nat.pow_lt_pow_of_lt h lt) - -protected theorem pow_lt_pow_iff_right {a n m : Nat} (h : 1 < a) : - a ^ n < a ^ m ↔ n < m := by - constructor - · by_contra w - simp at w - apply Nat.lt_irrefl (a ^ n) - exact Nat.lt_of_lt_of_le w.1 (Nat.pow_le_pow_of_le h w.2) - · intro w - exact Nat.pow_lt_pow_of_lt h w - -/-! ### log2 -/ - -theorem le_log2 (h : n ≠ 0) : k ≤ n.log2 ↔ 2 ^ k ≤ n := by - match k with - | 0 => simp [show 1 ≤ n from Nat.pos_of_ne_zero h] - | k+1 => - rw [log2]; split - · have n0 : 0 < n / 2 := (Nat.le_div_iff_mul_le (by decide)).2 ‹_› - simp only [Nat.add_le_add_iff_right, le_log2 (Nat.ne_of_gt n0), le_div_iff_mul_le, - Nat.pow_succ] - exact Nat.le_div_iff_mul_le (by decide) - · simp only [le_zero_eq, succ_ne_zero, false_iff] - refine mt (Nat.le_trans ?_) ‹_› - exact Nat.pow_le_pow_of_le_right Nat.zero_lt_two (Nat.le_add_left 1 k) - -theorem log2_lt (h : n ≠ 0) : n.log2 < k ↔ n < 2 ^ k := by - rw [← Nat.not_le, ← Nat.not_le, le_log2 h] - -theorem log2_self_le (h : n ≠ 0) : 2 ^ n.log2 ≤ n := (le_log2 h).1 (Nat.le_refl _) - -theorem lt_log2_self : n < 2 ^ (n.log2 + 1) := - match n with - | 0 => Nat.zero_lt_two - | n+1 => (log2_lt n.succ_ne_zero).1 (Nat.le_refl _) - -/-! ### dvd -/ - -theorem dvd_sub {k m n : Nat} (H : n ≤ m) (h₁ : k ∣ m) (h₂ : k ∣ n) : k ∣ m - n := - (Nat.dvd_add_iff_left h₂).2 <| by rwa [Nat.sub_add_cancel H] - -protected theorem mul_dvd_mul {a b c d : Nat} : a ∣ b → c ∣ d → a * c ∣ b * d - | ⟨e, he⟩, ⟨f, hf⟩ => - ⟨e * f, by simp [he, hf, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm]⟩ - -protected theorem mul_dvd_mul_left (a : Nat) (h : b ∣ c) : a * b ∣ a * c := - Nat.mul_dvd_mul (Nat.dvd_refl a) h - -protected theorem mul_dvd_mul_right (h: a ∣ b) (c : Nat) : a * c ∣ b * c := - Nat.mul_dvd_mul h (Nat.dvd_refl c) - -@[simp] theorem dvd_one {n : Nat} : n ∣ 1 ↔ n = 1 := - ⟨eq_one_of_dvd_one, fun h => h.symm ▸ Nat.dvd_refl _⟩ - -protected theorem mul_div_assoc (m : Nat) (H : k ∣ n) : m * n / k = m * (n / k) := by - match Nat.eq_zero_or_pos k with - | .inl h0 => rw [h0, Nat.div_zero, Nat.div_zero, Nat.mul_zero] - | .inr hpos => - have h1 : m * n / k = m * (n / k * k) / k := by rw [Nat.div_mul_cancel H] - rw [h1, ← Nat.mul_assoc, Nat.mul_div_cancel _ hpos] - -protected theorem dvd_of_mul_dvd_mul_left - (kpos : 0 < k) (H : k * m ∣ k * n) : m ∣ n := by - let ⟨l, H⟩ := H - rw [Nat.mul_assoc] at H - exact ⟨_, Nat.eq_of_mul_eq_mul_left kpos H⟩ - -protected theorem dvd_of_mul_dvd_mul_right (kpos : 0 < k) (H : m * k ∣ n * k) : m ∣ n := by - rw [Nat.mul_comm m k, Nat.mul_comm n k] at H; exact Nat.dvd_of_mul_dvd_mul_left kpos H - -theorem pow_dvd_pow_iff_pow_le_pow {k l : Nat} : - ∀ {x : Nat}, 0 < x → (x ^ k ∣ x ^ l ↔ x ^ k ≤ x ^ l) - | x + 1, w => by - constructor - · intro a - exact le_of_dvd (Nat.pow_pos (succ_pos x)) a - · intro a - cases x - case zero => simp - case succ x => - have le := - (Nat.pow_le_pow_iff_right (Nat.succ_le_succ (Nat.succ_le_succ (Nat.zero_le _)))).mp a - refine ⟨(x + 2) ^ (l - k), ?_⟩ - rw [← Nat.pow_add, Nat.add_comm k, Nat.sub_add_cancel le] - -/-- If `1 < x`, then `x^k` divides `x^l` if and only if `k` is at most `l`. -/ -theorem pow_dvd_pow_iff_le_right {x k l : Nat} (w : 1 < x) : x ^ k ∣ x ^ l ↔ k ≤ l := by - rw [pow_dvd_pow_iff_pow_le_pow (lt_of_succ_lt w), Nat.pow_le_pow_iff_right w] - -theorem pow_dvd_pow_iff_le_right' {b k l : Nat} : (b + 2) ^ k ∣ (b + 2) ^ l ↔ k ≤ l := - pow_dvd_pow_iff_le_right (Nat.lt_of_sub_eq_succ rfl) - -protected theorem eq_mul_of_div_eq_right {a b c : Nat} (H1 : b ∣ a) (H2 : a / b = c) : - a = b * c := by - rw [← H2, Nat.mul_div_cancel' H1] - -protected theorem div_eq_iff_eq_mul_right {a b c : Nat} (H : 0 < b) (H' : b ∣ a) : - a / b = c ↔ a = b * c := - ⟨Nat.eq_mul_of_div_eq_right H', Nat.div_eq_of_eq_mul_right H⟩ - -protected theorem div_eq_iff_eq_mul_left {a b c : Nat} (H : 0 < b) (H' : b ∣ a) : - a / b = c ↔ a = c * b := by - rw [Nat.mul_comm]; exact Nat.div_eq_iff_eq_mul_right H H' - -protected theorem pow_dvd_pow {m n : Nat} (a : Nat) (h : m ≤ n) : a ^ m ∣ a ^ n := by - cases Nat.exists_eq_add_of_le h - case intro k p => - subst p - rw [Nat.pow_add] - apply Nat.dvd_mul_right - -protected theorem pow_sub_mul_pow (a : Nat) {m n : Nat} (h : m ≤ n) : - a ^ (n - m) * a ^ m = a ^ n := by - rw [← Nat.pow_add, Nat.sub_add_cancel h] - -theorem pow_dvd_of_le_of_pow_dvd {p m n k : Nat} (hmn : m ≤ n) (hdiv : p ^ n ∣ k) : p ^ m ∣ k := - Nat.dvd_trans (Nat.pow_dvd_pow _ hmn) hdiv - -theorem dvd_of_pow_dvd {p k m : Nat} (hk : 1 ≤ k) (hpk : p ^ k ∣ m) : p ∣ m := by - rw [← Nat.pow_one p]; exact pow_dvd_of_le_of_pow_dvd hk hpk - -protected theorem pow_div {x m n : Nat} (h : n ≤ m) (hx : 0 < x) : x ^ m / x ^ n = x ^ (m - n) := by - rw [Nat.div_eq_iff_eq_mul_left (Nat.pow_pos hx) (Nat.pow_dvd_pow _ h), Nat.pow_sub_mul_pow _ h] - /-! ### sum -/ @[simp] theorem sum_nil : Nat.sum [] = 0 := rfl @@ -1157,104 +257,5 @@ protected theorem pow_div {x m n : Nat} (h : n ≤ m) (hx : 0 < x) : x ^ m / x ^ @[simp] theorem sum_append : Nat.sum (l₁ ++ l₂) = Nat.sum l₁ + Nat.sum l₂ := by induction l₁ <;> simp [*, Nat.add_assoc] -/-! ### shiftLeft and shiftRight -/ - -@[simp] theorem shiftLeft_zero : n <<< 0 = n := rfl - -/-- Shiftleft on successor with multiple moved inside. -/ -theorem shiftLeft_succ_inside (m n : Nat) : m <<< (n+1) = (2*m) <<< n := rfl - -/-- Shiftleft on successor with multiple moved to outside. -/ -theorem shiftLeft_succ : ∀(m n), m <<< (n + 1) = 2 * (m <<< n) -| m, 0 => rfl -| m, k + 1 => by - rw [shiftLeft_succ_inside _ (k+1)] - rw [shiftLeft_succ _ k, shiftLeft_succ_inside] - -@[simp] theorem shiftRight_zero : n >>> 0 = n := rfl - -theorem shiftRight_succ (m n) : m >>> (n + 1) = (m >>> n) / 2 := rfl - -/-- Shiftright on successor with division moved inside. -/ -theorem shiftRight_succ_inside : ∀m n, m >>> (n+1) = (m/2) >>> n -| m, 0 => rfl -| m, k + 1 => by - rw [shiftRight_succ _ (k+1)] - rw [shiftRight_succ_inside _ k, shiftRight_succ] - -@[simp] theorem zero_shiftLeft : ∀ n, 0 <<< n = 0 - | 0 => by simp [shiftLeft] - | n + 1 => by simp [shiftLeft, zero_shiftLeft, shiftLeft_succ] - -@[simp] theorem zero_shiftRight : ∀ n, 0 >>> n = 0 - | 0 => by simp [shiftRight] - | n + 1 => by simp [shiftRight, zero_shiftRight, shiftRight_succ] - -theorem shiftRight_add (m n : Nat) : ∀ k, m >>> (n + k) = (m >>> n) >>> k - | 0 => rfl - | k + 1 => by simp [add_succ, shiftRight_add, shiftRight_succ] - -theorem shiftLeft_shiftLeft (m n : Nat) : ∀ k, (m <<< n) <<< k = m <<< (n + k) - | 0 => rfl - | k + 1 => by simp [add_succ, shiftLeft_shiftLeft _ _ k, shiftLeft_succ] - -theorem shiftRight_eq_div_pow (m : Nat) : ∀ n, m >>> n = m / 2 ^ n - | 0 => (Nat.div_one _).symm - | k + 1 => by - rw [shiftRight_add, shiftRight_eq_div_pow m k] - simp [Nat.div_div_eq_div_mul, ← Nat.pow_succ, shiftRight_succ] - -theorem mul_add_div {m : Nat} (m_pos : m > 0) (x y : Nat) : (m * x + y) / m = x + y / m := by - match x with - | 0 => simp - | x + 1 => - simp [Nat.mul_succ, Nat.add_assoc _ m, - mul_add_div m_pos x (m+y), - div_eq (m+y) m, - m_pos, - Nat.le_add_right m, Nat.add_succ, Nat.succ_add] - -theorem mul_add_mod (m x y : Nat) : (m * x + y) % m = y % m := by - match x with - | 0 => simp - | x + 1 => - simp [Nat.mul_succ, Nat.add_assoc _ m, mul_add_mod _ x] - -@[simp] theorem mod_div_self (m n : Nat) : m % n / n = 0 := by - cases n - · exact (m % 0).div_zero - · case succ n => exact Nat.div_eq_of_lt (m.mod_lt n.succ_pos) - -/-! ### Decidability of predicates -/ - -instance decidableBallLT : - ∀ (n : Nat) (P : ∀ k, k < n → Prop) [∀ n h, Decidable (P n h)], Decidable (∀ n h, P n h) -| 0, _, _ => isTrue fun _ => (by cases ·) -| n + 1, P, H => - match decidableBallLT n (P · <| lt_succ_of_lt ·) with - | isFalse h => isFalse (h fun _ _ => · _ _) - | isTrue h => - match H n Nat.le.refl with - | isFalse p => isFalse (p <| · _ _) - | isTrue p => isTrue fun _ h' => (Nat.lt_succ_iff_lt_or_eq.1 h').elim (h _) fun hn => hn ▸ p - -instance decidableForallFin (P : Fin n → Prop) [DecidablePred P] : Decidable (∀ i, P i) := - decidable_of_iff (∀ k h, P ⟨k, h⟩) ⟨fun m ⟨k, h⟩ => m k h, fun m k h => m ⟨k, h⟩⟩ - -instance decidableBallLE (n : Nat) (P : ∀ k, k ≤ n → Prop) [∀ n h, Decidable (P n h)] : - Decidable (∀ n h, P n h) := - decidable_of_iff (∀ (k) (h : k < succ n), P k (le_of_lt_succ h)) - ⟨fun m k h => m k (lt_succ_of_le h), fun m k _ => m k _⟩ - -instance decidableExistsLT [h : DecidablePred p] : DecidablePred fun n => ∃ m : Nat, m < n ∧ p m - | 0 => isFalse (by simp only [not_lt_zero, false_and, exists_const, not_false_eq_true]) - | n + 1 => - @decidable_of_decidable_of_iff _ _ (@instDecidableOr _ _ (decidableExistsLT (p := p) n) (h n)) - (by simp only [Nat.lt_succ_iff_lt_or_eq, or_and_right, exists_or, exists_eq_left]) - -instance decidableExistsLE [DecidablePred p] : DecidablePred fun n => ∃ m : Nat, m ≤ n ∧ p m := - fun n => decidable_of_iff (∃ m, m < n + 1 ∧ p m) - (exists_congr fun _ => and_congr_left' Nat.lt_succ_iff) - @[deprecated] protected alias lt_connex := Nat.lt_or_gt_of_ne @[deprecated] alias pow_two_pos := Nat.two_pow_pos -- deprecated 2024-02-09 diff --git a/Std/Lean/Elab/Tactic.lean b/Std/Lean/Elab/Tactic.lean deleted file mode 100644 index 2c0a40b899..0000000000 --- a/Std/Lean/Elab/Tactic.lean +++ /dev/null @@ -1,18 +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 --/ -import Lean.Elab.Tactic.Basic - -/-! -# Tactic combinators in `TacticM`. --/ - -namespace Lean.Elab.Tactic - -/-- Analogue of `liftMetaTactic` for tactics that do not return any goals. -/ -def liftMetaFinishingTactic (tac : MVarId → MetaM Unit) : TacticM Unit := - liftMetaTactic fun g => do tac g; pure [] - -end Lean.Elab.Tactic diff --git a/Std/Tactic/Omega.lean b/Std/Tactic/Omega.lean deleted file mode 100644 index aa637bf4dd..0000000000 --- a/Std/Tactic/Omega.lean +++ /dev/null @@ -1,192 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.Frontend - -/-! -# `omega` - -This is an implementation of the `omega` algorithm, currently without "dark" and "grey" shadows, -although the framework should be compatible with adding that part of the algorithm later. - -The implementation closely follows William Pugh's -"The omega test: a fast and practical integer programming algorithm for dependence analysis" -https://doi.org/10.1145/125826.125848. - -The `MetaM` level `omega` tactic takes a `List Expr` of facts, -and tries to discharge the goal by proving `False`. - -The user-facing `omega` tactic first calls `false_or_by_contra`, and then invokes the `omega` tactic -on all hypotheses. - -### Pre-processing - -In the `false_or_by_contra` step, we: -* if the goal is `False`, do nothing, -* if the goal is `¬ P`, introduce `P`, -* if the goal is `x ≠ y`, introduce `x = y`, -* otherwise, for a goal `P`, replace it with `¬ ¬ P` and introduce `¬ P`. - -The `omega` tactic pre-processes the hypotheses in the following ways: -* Replace `x > y` for `x y : Nat` or `x y : Int` with `x ≥ y + 1`. -* Given `x ≥ y` for `x : Nat`, replace it with `(x : Int) ≥ (y : Int)`. -* Push `Nat`-to-`Int` coercions inwards across `+`, `*`, `/`, `%`. -* Replace `k ∣ x` for a literal `k : Nat` with `x % k = 0`, - and replace `¬ k ∣ x` with `x % k > 0`. -* If `x / m` appears, for some `x : Int` and literal `m : Nat`, - replace `x / m` with a new variable `α` and add the constraints - `0 ≤ - m * α + x ≤ m - 1`. -* If `x % m` appears, similarly, introduce the same new contraints - but replace `x % m` with `- m * α + x`. -* Split conjunctions, existentials, and subtypes. -* Record, for each appearance of `(a - b : Int)` with `a b : Nat`, the disjunction - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0`. - We don't immediately split this; see the discussion below for how disjunctions are handled. - -After this preprocessing stage, we have a collection of linear inequalities -(all using `≤` rather than `<`) and equalities in some set of atoms. - -TODO: We should identify atoms up to associativity and commutativity, -so that `omega` can handle problems such as `a * b < 0 && b * a > 0 → False`. -This should be a relatively easy modification of the `lookup` function in `OmegaM`. -After doing so, we could allow the preprocessor to distribute multiplication over addition. - -### Normalization - -Throughout the remainder of the algorithm, we apply the following normalization steps to -all linear constraints: -* Make the leading coefficient positive (thus giving us both upper and lower bounds). -* Divide through by the GCD of the coefficients, rounding the constant terms appropriately. -* Whenever we have both an upper and lower bound for the same coefficients, - check they are compatible. If they are tight, mark the pair of constraints as an equality. - If they are inconsistent, stop further processing. - -### Solving equalities - -The next step is to solve all equalities. - -We first solve any equalities that have a `±1` coefficient; -these allow us to eliminate that variable. - -After this, there may be equalities remaining with all coefficients having absolute value greater -than one. We select an equality `c₀ + ∑ cᵢ * xᵢ = 0` with smallest minimal absolute value -of the `cᵢ`, breaking ties by preferring equalities with smallest maximal absolute value. -We let `m = ∣cⱼ| + 1` where `cⱼ` is the coefficient with smallest absolute value.. -We then add the new equality `(bmod c₀ m) + ∑ (bmod cᵢ m) xᵢ = m α` with `α` being a new variable. -Here `bmod` is "balanced mod", taking values in `[- m/2, (m - 1)/2]`. -This equality holds (for some value of `α`) because the left hand side differs from the left hand -side of the original equality by a multiple of `m`. -Moreover, in this equality the coefficient of `xⱼ` is `±1`, so we can solve and eliminate `xⱼ`. - -So far this isn't progress: we've introduced a new variable and eliminated a variable. -However, this process terminates, as the pair `(c, C)` lexicographically decreases, -where `c` is the smallest minimal absolute value and `C` is the smallest maximal absolute value -amongst those equalities with minimal absolute value `c`. -(Happily because we're running this in metaprogramming code, we don't actually need to prove this -termination! If we later want to upgrade to a decision procedure, or to produce counterexamples -we would need to do this. It's certainly possible, and existed in an earlier prototype version.) - -### Solving inequalities - -After solving all equalities, we turn to the inequalities. - -We need to select a variable to eliminate; this choice is discussed below. - -#### Shadows - -The omega algorithm indicates we should consider three subproblems, -called the "real", "dark", and "grey" shadows. -(In fact the "grey" shadow is a disjunction of potentially many problems.) -Our problem is satisfiable if and only if the real shadow is satisfiable -and either the dark or grey shadow is satisfiable. - -Currently we do not implement either the dark or grey shadows, and thus if the real shadow is -satisfiable we must fail, and report that we couldn't find a contradiction, even though the -problem may be unsatisfiable. - -In practical problems, it appears to be relatively rare that we fail because of not handling the -dark and grey shadows. - -Fortunately, in many cases it is possible to choose a variable to eliminate such that -the real and dark shadows coincide, and the grey shadows are empty. In this situation -we don't lose anything by ignoring the dark and grey shadows. -We call this situation an exact elimination. -A sufficient condition for exactness is that either all upper bounds on `xᵢ` have unit coefficient, -or all lower bounds on `xᵢ` have unit coefficient. -We always prefer to select the value of `i` so that this condition holds, if possible. -We break ties by preferring to select a value of `i` that minimizes the number of new constraints -introduced in the real shadow. - -#### The real shadow: Fourier-Motzkin elimination - -The real shadow for a variable `i` is just the Fourier-Motzkin elimination. - -We begin by discarding all inequalities involving the variable `i`. - -Then, for each pair of constraints `f ≤ c * xᵢ` and `c' * xᵢ ≤ f'` -with both `c` and `c'` positive (i.e. for each pair of an lower and upper bound on `xᵢ`) -we introduce the new constraint `c * f' - c' * f ≥ 0`. - -(Note that if there are only upper bounds on `xᵢ`, or only lower bounds on `xᵢ` this step -simply discards inequalities.) - -#### The dark and grey shadows - -For each such new constraint `c' * f - c * f' ≤ 0`, we either have the strengthening -`c * f' - c' * f ≥ c * c' - c - c' + 1` -or we do not, i.e. -`c * f' - c' * f ≤ c * c' - c - c'`. -In the latter case, combining this inequality with `f' ≥ c' * xᵢ` we obtain -`c' * (c * xᵢ - f) ≤ c * c' - c - c'` -and as we already have `c * xᵢ - f ≥ 0`, -we conclude that `c * xᵢ - f = j` for some `j = 0, 1, ..., (c * c' - c - c')/c'` -(with, as usual the division rounded down). - -Note that the largest possible value of `j` occurs with `c'` is as large as possible. - -Thus the "dark" shadow is the variant of the real shadow where we replace each new inequality -with its strengthening. -The "grey" shadows are the union of the problems obtained by taking -a lower bound `f ≤ c * xᵢ` for `xᵢ` and some `j = 0, 1, ..., (c * m - c - m)/m`, where `m` -is the largest coefficient `c'` appearing in an upper bound `c' * xᵢ ≤ f'` for `xᵢ`, -and adding to the original problem (i.e. without doing any Fourier-Motzkin elimination) the single -new equation `c * xᵢ - f = j`, and the inequalities -`c * xᵢ - f > (c * m - c - m)/m` for each previously considered lower bound. - -As stated above, the satisfiability of the original problem is in fact equivalent to -the satisfiability of the real shadow, *and* the satisfiability of *either* the dark shadow, -or at least one of the grey shadows. - -TODO: implement the dark and grey shadows! - -### Disjunctions - -The omega algorithm as described above accumulates various disjunctions, -either coming from natural subtraction, or from the dark and grey shadows. - -When we encounter such a disjunction, we store it in a list of disjunctions, -but do not immediately split it. - -Instead we first try to find a contradiction (i.e. by eliminating equalities and inequalities) -without the disjunctive hypothesis. -If this fails, we then retrieve the first disjunction from the list, split it, -and try to find a contradiction in both branches. - -(Note that we make no attempt to optimize the order in which we split disjunctions: -it's currently on a first in first out basis.) - -The work done eliminating equalities can be reused when splitting disjunctions, -but we need to redo all the work eliminating inequalities in each branch. - -## Future work -* Implementation of dark and grey shadows. -* Identification of atoms up to associativity and commutativity of monomials. -* Further optimization. - * Some data is recomputed unnecessarily, e.g. the GCDs of coefficients. -* Sparse representation of coefficients. - * I have a branch in which this is implemented, modulo some proofs about algebraic operations - on sparse arrays. -* Case splitting on `Int.abs`? --/ diff --git a/Std/Tactic/Omega/Coeffs/IntList.lean b/Std/Tactic/Omega/Coeffs/IntList.lean deleted file mode 100644 index 94be9e134c..0000000000 --- a/Std/Tactic/Omega/Coeffs/IntList.lean +++ /dev/null @@ -1,108 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.IntList -import Std.Data.List.Basic - -/-! -# `Coeffs` as a wrapper for `IntList` - -Currently `omega` uses a dense representation for coefficients. -However, we can swap this out for a sparse representation. - -This file sets up `Coeffs` as a type synonym for `IntList`, -and abbreviations for the functions in the `IntList` namespace which we need to use in the -`omega` algorithm. - -There is an equivalent file setting up `Coeffs` as a type synonym for `AssocList Nat Int`, -currently in a private branch. -Not all the theorems about the algebraic operations on that representation have been proved yet. -When they are ready, we can replace the implementation in `omega` simply by importing -`Std.Tactic.Omega.Coeffs.IntDict` instead of `Std.Tactic.Omega.Coeffs.IntList`. - -For small problems, the sparse representation is actually slightly slower, -so it is not urgent to make this replacement. --/ - -namespace Std.Tactic.Omega - -/-- Type synonym for `IntList := List Int`. -/ -abbrev Coeffs := IntList - -namespace Coeffs - -/-- Identity, turning `Coeffs` into `List Int`. -/ -abbrev toList (xs : Coeffs) : List Int := xs -/-- Identity, turning `List Int` into `Coeffs`. -/ -abbrev ofList (xs : List Int) : Coeffs := xs -/-- Are the coefficients all zero? -/ -abbrev isZero (xs : Coeffs) : Prop := ∀ x, x ∈ xs → x = 0 -/-- Shim for `IntList.set`. -/ -abbrev set (xs : Coeffs) (i : Nat) (y : Int) : Coeffs := IntList.set xs i y -/-- Shim for `IntList.get`. -/ -abbrev get (xs : Coeffs) (i : Nat) : Int := IntList.get xs i -/-- Shim for `IntList.gcd`. -/ -abbrev gcd (xs : Coeffs) : Nat := IntList.gcd xs -/-- Shim for `IntList.smul`. -/ -abbrev smul (xs : Coeffs) (g : Int) : Coeffs := IntList.smul xs g -/-- Shim for `IntList.sdiv`. -/ -abbrev sdiv (xs : Coeffs) (g : Int) : Coeffs := IntList.sdiv xs g -/-- Shim for `IntList.dot`. -/ -abbrev dot (xs ys : Coeffs) : Int := IntList.dot xs ys -/-- Shim for `IntList.add`. -/ -abbrev add (xs ys : Coeffs) : Coeffs := IntList.add xs ys -/-- Shim for `IntList.sub`. -/ -abbrev sub (xs ys : Coeffs) : Coeffs := IntList.sub xs ys -/-- Shim for `IntList.neg`. -/ -abbrev neg (xs : Coeffs) : Coeffs := IntList.neg xs -/-- Shim for `IntList.combo`. -/ -abbrev combo (a : Int) (xs : Coeffs) (b : Int) (ys : Coeffs) : Coeffs := IntList.combo a xs b ys -/-- Shim for `List.length`. -/ -abbrev length (xs : Coeffs) := List.length xs -/-- Shim for `IntList.leading`. -/ -abbrev leading (xs : Coeffs) : Int := IntList.leading xs -/-- Shim for `List.map`. -/ -abbrev map (f : Int → Int) (xs : Coeffs) : Coeffs := List.map f xs -/-- Shim for `.enum.find?`. -/ -abbrev findIdx? (f : Int → Bool) (xs : Coeffs) : Option Nat := - List.findIdx? f xs - -- We could avoid `Std.Data.List.Basic` by using the less efficient: - -- xs.enum.find? (f ·.2) |>.map (·.1) -/-- Shim for `IntList.bmod`. -/ -abbrev bmod (x : Coeffs) (m : Nat) : Coeffs := IntList.bmod x m -/-- Shim for `IntList.bmod_dot_sub_dot_bmod`. -/ -abbrev bmod_dot_sub_dot_bmod (m : Nat) (a b : Coeffs) : Int := - IntList.bmod_dot_sub_dot_bmod m a b -theorem bmod_length (x : Coeffs) (m : Nat) : (bmod x m).length ≤ x.length := - IntList.bmod_length x m -theorem dvd_bmod_dot_sub_dot_bmod (m : Nat) (xs ys : Coeffs) : - (m : Int) ∣ bmod_dot_sub_dot_bmod m xs ys := IntList.dvd_bmod_dot_sub_dot_bmod m xs ys - -theorem get_of_length_le {i : Nat} {xs : Coeffs} (h : length xs ≤ i) : get xs i = 0 := - IntList.get_of_length_le h -theorem dot_set_left (xs ys : Coeffs) (i : Nat) (z : Int) : - dot (set xs i z) ys = dot xs ys + (z - get xs i) * get ys i := - IntList.dot_set_left xs ys i z -theorem dot_sdiv_left (xs ys : Coeffs) {d : Int} (h : d ∣ xs.gcd) : - dot (xs.sdiv d) ys = (dot xs ys) / d := - IntList.dot_sdiv_left xs ys h -theorem dot_smul_left (xs ys : Coeffs) (i : Int) : dot (i * xs) ys = i * dot xs ys := - IntList.dot_smul_left xs ys i -theorem dot_distrib_left (xs ys zs : Coeffs) : (xs + ys).dot zs = xs.dot zs + ys.dot zs := - IntList.dot_distrib_left xs ys zs -theorem sub_eq_add_neg (xs ys : Coeffs) : xs - ys = xs + -ys := - IntList.sub_eq_add_neg xs ys -theorem combo_eq_smul_add_smul (a : Int) (xs : Coeffs) (b : Int) (ys : Coeffs) : - combo a xs b ys = (a * xs) + (b * ys) := - IntList.combo_eq_smul_add_smul a xs b ys -theorem gcd_dvd_dot_left (xs ys : Coeffs) : (gcd xs : Int) ∣ dot xs ys := - IntList.gcd_dvd_dot_left xs ys -theorem map_length {xs : Coeffs} : (xs.map f).length ≤ xs.length := - Nat.le_of_eq (List.length_map xs f) - -theorem dot_nil_right {xs : Coeffs} : dot xs .nil = 0 := IntList.dot_nil_right -theorem get_nil : get .nil i = 0 := IntList.get_nil -theorem dot_neg_left (xs ys : IntList) : dot (-xs) ys = -dot xs ys := - IntList.dot_neg_left xs ys diff --git a/Std/Tactic/Omega/Config.lean b/Std/Tactic/Omega/Config.lean deleted file mode 100644 index eda2b57b7c..0000000000 --- a/Std/Tactic/Omega/Config.lean +++ /dev/null @@ -1,44 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Lean.Elab.Tactic.Config - -namespace Std.Tactic.Omega - -/-- Configures the behaviour of the `omega` tactic. -/ -structure OmegaConfig where - /-- - Split disjunctions in the context. - - Note that with `splitDisjunctions := false` omega will not be able to solve `x = y` goals - as these are usually handled by introducing `¬ x = y` as a hypothesis, then replacing this with - `x < y ∨ x > y`. - - On the other hand, `omega` does not currently detect disjunctions which, when split, - introduce no new useful information, so the presence of irrelevant disjunctions in the context - can significantly increase run time. - -/ - splitDisjunctions : Bool := true - /-- - Whenever `((a - b : Nat) : Int)` is found, register the disjunction - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0` - for later splitting. - -/ - splitNatSub : Bool := true - /-- - Whenever `Int.natAbs a` is found, register the disjunction - `0 ≤ a ∧ Int.natAbs a = a ∨ a < 0 ∧ Int.natAbs a = - a` for later splitting. - -/ - splitNatAbs : Bool := true - /-- - Whenever `min a b` or `max a b` is found, rewrite in terms of the definition - `if a ≤ b ...`, for later case splitting. - -/ - splitMinMax : Bool := true - -/-- -Allow elaboration of `OmegaConfig` arguments to tactics. --/ -declare_config_elab elabOmegaConfig OmegaConfig diff --git a/Std/Tactic/Omega/Constraint.lean b/Std/Tactic/Omega/Constraint.lean deleted file mode 100644 index 1bdcb00fd6..0000000000 --- a/Std/Tactic/Omega/Constraint.lean +++ /dev/null @@ -1,253 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Classes.Order -import Std.Data.Option.Lemmas -import Std.Tactic.Omega.Coeffs.IntList -/-! -A `Constraint` consists of an optional lower and upper bound (inclusive), -constraining a value to a set of the form `∅`, `{x}`, `[x, y]`, `[x, ∞)`, `(-∞, y]`, or `(-∞, ∞)`. --/ - -namespace Std.Tactic.Omega - -/-- An optional lower bound on a integer. -/ -abbrev LowerBound : Type := Option Int -/-- An optional upper bound on a integer. -/ -abbrev UpperBound : Type := Option Int - -/-- A lower bound at `x` is satisfied at `t` if `x ≤ t`. -/ -abbrev LowerBound.sat (b : LowerBound) (t : Int) := b.all fun x => x ≤ t -/-- A upper bound at `y` is satisfied at `t` if `t ≤ y`. -/ -abbrev UpperBound.sat (b : UpperBound) (t : Int) := b.all fun y => t ≤ y - -/-- -A `Constraint` consists of an optional lower and upper bound (inclusive), -constraining a value to a set of the form `∅`, `{x}`, `[x, y]`, `[x, ∞)`, `(-∞, y]`, or `(-∞, ∞)`. --/ -structure Constraint where - /-- A lower bound. -/ - lowerBound : LowerBound - /-- An upper bound. -/ - upperBound : UpperBound -deriving BEq, DecidableEq, Repr - -namespace Constraint - -open Lean in -instance : ToExpr Constraint where - toExpr s := - (Expr.const ``Constraint.mk []).app (toExpr s.lowerBound) |>.app (toExpr s.upperBound) - toTypeExpr := .const ``Constraint [] - -instance : ToString Constraint where - toString := fun - | ⟨none, none⟩ => "(-∞, ∞)" - | ⟨none, some y⟩ => s!"(-∞, {y}]" - | ⟨some x, none⟩ => s!"[{x}, ∞)" - | ⟨some x, some y⟩ => - if y < x then "∅" else if x = y then s!"\{{x}}" else s!"[{x}, {y}]" - -/-- A constraint is satisfied at `t` is both the lower bound and upper bound are satisfied. -/ -def sat (c : Constraint) (t : Int) : Bool := c.lowerBound.sat t ∧ c.upperBound.sat t - -/-- Apply a function to both the lower bound and upper bound. -/ -def map (c : Constraint) (f : Int → Int) : Constraint where - lowerBound := c.lowerBound.map f - upperBound := c.upperBound.map f - -/-- Translate a constraint. -/ -def translate (c : Constraint) (t : Int) : Constraint := c.map (· + t) - -theorem translate_sat : {c : Constraint} → {v : Int} → sat c v → sat (c.translate t) (v + t) := by - rintro ⟨_ | l, _ | u⟩ v w <;> simp_all [sat, translate, map] - · exact Int.add_le_add_right w t - · exact Int.add_le_add_right w t - · rcases w with ⟨w₁, w₂⟩; constructor - · exact Int.add_le_add_right w₁ t - · exact Int.add_le_add_right w₂ t - -/-- -Flip a constraint. -This operation is not useful by itself, but is used to implement `neg` and `scale`. --/ -def flip (c : Constraint) : Constraint where - lowerBound := c.upperBound - upperBound := c.lowerBound - -/-- -Negate a constraint. `[x, y]` becomes `[-y, -x]`. --/ -def neg (c : Constraint) : Constraint := c.flip.map (- ·) - -theorem neg_sat : {c : Constraint} → {v : Int} → sat c v → sat (c.neg) (-v) := by - rintro ⟨_ | l, _ | u⟩ v w <;> simp_all [sat, neg, flip, map] - · exact Int.neg_le_neg w - · exact Int.neg_le_neg w - · rcases w with ⟨w₁, w₂⟩; constructor - · exact Int.neg_le_neg w₂ - · exact Int.neg_le_neg w₁ - -/-- The trivial constraint, satisfied everywhere. -/ -def trivial : Constraint := ⟨none, none⟩ -/-- The impossible constraint, unsatisfiable. -/ -def impossible : Constraint := ⟨some 1, some 0⟩ -/-- An exact constraint. -/ -def exact (r : Int) : Constraint := ⟨some r, some r⟩ - -@[simp] theorem trivial_say : trivial.sat t := by - simp [sat, trivial] - -@[simp] theorem exact_sat (r : Int) (t : Int) : (exact r).sat t = decide (r = t) := by - simp only [sat, exact, Option.all_some, decide_eq_true_eq, decide_eq_decide] - exact Int.eq_iff_le_and_ge.symm - -/-- Check if a constraint is unsatisfiable. -/ -def isImpossible : Constraint → Bool - | ⟨some x, some y⟩ => y < x - | _ => false - -/-- Check if a constraint requires an exact value. -/ -def isExact : Constraint → Bool - | ⟨some x, some y⟩ => x = y - | _ => false - -theorem not_sat_of_isImpossible (h : isImpossible c) {t} : ¬ c.sat t := by - rcases c with ⟨_ | l, _ | u⟩ <;> simp [isImpossible, sat] at h ⊢ - intro w - rw [Int.not_le] - exact Int.lt_of_lt_of_le h w - -/-- -Scale a constraint by multiplying by an integer. -* If `k = 0` this is either impossible, if the original constraint was impossible, - or the `= 0` exact constraint. -* If `k` is positive this takes `[x, y]` to `[k * x, k * y]` -* If `k` is negative this takes `[x, y]` to `[k * y, k * x]`. --/ -def scale (k : Int) (c : Constraint) : Constraint := - if k = 0 then - if c.isImpossible then c else ⟨some 0, some 0⟩ - else if 0 < k then - c.map (k * ·) - else - c.flip.map (k * ·) - -theorem scale_sat {c : Constraint} (k) (w : c.sat t) : (scale k c).sat (k * t) := by - simp [scale] - split - · split - · simp_all [not_sat_of_isImpossible] - · simp_all [sat] - · rcases c with ⟨_ | l, _ | u⟩ <;> split <;> rename_i h <;> simp_all [sat, flip, map] - · replace h := Int.le_of_lt h - exact Int.mul_le_mul_of_nonneg_left w h - · rw [Int.not_lt] at h - exact Int.mul_le_mul_of_nonpos_left h w - · replace h := Int.le_of_lt h - exact Int.mul_le_mul_of_nonneg_left w h - · rw [Int.not_lt] at h - exact Int.mul_le_mul_of_nonpos_left h w - · constructor - · exact Int.mul_le_mul_of_nonneg_left w.1 (Int.le_of_lt h) - · exact Int.mul_le_mul_of_nonneg_left w.2 (Int.le_of_lt h) - · replace h := Int.not_lt.mp h - constructor - · exact Int.mul_le_mul_of_nonpos_left h w.2 - · exact Int.mul_le_mul_of_nonpos_left h w.1 - -/-- The sum of two constraints. `[a, b] + [c, d] = [a + c, b + d]`. -/ -def add (x y : Constraint) : Constraint where - lowerBound := x.lowerBound.bind fun a => y.lowerBound.map fun b => a + b - upperBound := x.upperBound.bind fun a => y.upperBound.map fun b => a + b - -theorem add_sat (w₁ : c₁.sat x₁) (w₂ : c₂.sat x₂) : (add c₁ c₂).sat (x₁ + x₂) := by - rcases c₁ with ⟨_ | l₁, _ | u₁⟩ <;> rcases c₂ with ⟨_ | l₂, _ | u₂⟩ - <;> simp [sat, LowerBound.sat, UpperBound.sat, add] at * - · exact Int.add_le_add w₁ w₂ - · exact Int.add_le_add w₁ w₂.2 - · exact Int.add_le_add w₁ w₂ - · exact Int.add_le_add w₁ w₂.1 - · exact Int.add_le_add w₁.2 w₂ - · exact Int.add_le_add w₁.1 w₂ - · constructor - · exact Int.add_le_add w₁.1 w₂.1 - · exact Int.add_le_add w₁.2 w₂.2 - -/-- A linear combination of two constraints. -/ -def combo (a : Int) (x : Constraint) (b : Int) (y : Constraint) : Constraint := - add (scale a x) (scale b y) - -theorem combo_sat (a) (w₁ : c₁.sat x₁) (b) (w₂ : c₂.sat x₂) : - (combo a c₁ b c₂).sat (a * x₁ + b * x₂) := - add_sat (scale_sat a w₁) (scale_sat b w₂) - -/-- The conjunction of two constraints. -/ -def combine (x y : Constraint) : Constraint where - lowerBound := max x.lowerBound y.lowerBound - upperBound := min x.upperBound y.upperBound - -theorem combine_sat : (c : Constraint) → (c' : Constraint) → (t : Int) → - (c.combine c').sat t = (c.sat t ∧ c'.sat t) := by - rintro ⟨_ | l₁, _ | u₁⟩ <;> rintro ⟨_ | l₂, _ | u₂⟩ t - <;> simp [sat, LowerBound.sat, UpperBound.sat, combine, Int.le_min, Int.max_le] at * - · rw [And.comm] - · rw [← and_assoc, And.comm (a := l₂ ≤ t), and_assoc] - · rw [and_assoc] - · rw [and_assoc] - · rw [and_assoc, and_assoc, And.comm (a := l₂ ≤ t)] - · rw [and_assoc, ← and_assoc (a := l₂ ≤ t), And.comm (a := l₂ ≤ t), and_assoc, and_assoc] - -/-- -Dividing a constraint by a natural number, and tightened to integer bounds. -Thus the lower bound is rounded up, and the upper bound is rounded down. --/ -def div (c : Constraint) (k : Nat) : Constraint where - lowerBound := c.lowerBound.map fun x => (- ((- x) / k)) - upperBound := c.upperBound.map fun y => y / k - -theorem div_sat (c : Constraint) (t : Int) (k : Nat) (n : k ≠ 0) (h : (k : Int) ∣ t) (w : c.sat t) : - (c.div k).sat (t / k) := by - replace n : (k : Int) > 0 := Int.ofNat_lt.mpr (Nat.pos_of_ne_zero n) - rcases c with ⟨_ | l, _ | u⟩ - · simp_all [sat, div] - · simp [sat, div] at w ⊢ - apply Int.le_of_sub_nonneg - rw [← Int.sub_ediv_of_dvd _ h, ← ge_iff_le, Int.div_nonneg_iff_of_pos n] - exact Int.sub_nonneg_of_le w - · simp [sat, div] at w ⊢ - apply Int.le_of_sub_nonneg - rw [Int.sub_neg, ← Int.add_ediv_of_dvd_left h, ← ge_iff_le, - Int.div_nonneg_iff_of_pos n] - exact Int.sub_nonneg_of_le w - · simp [sat, div] at w ⊢ - constructor - · apply Int.le_of_sub_nonneg - rw [Int.sub_neg, ← Int.add_ediv_of_dvd_left h, ← ge_iff_le, - Int.div_nonneg_iff_of_pos n] - exact Int.sub_nonneg_of_le w.1 - · apply Int.le_of_sub_nonneg - rw [← Int.sub_ediv_of_dvd _ h, ← ge_iff_le, Int.div_nonneg_iff_of_pos n] - exact Int.sub_nonneg_of_le w.2 - -/-- -It is convenient below to say that a constraint is satisfied at the dot product of two vectors, -so we make an abbreviation `sat'` for this. --/ -abbrev sat' (c : Constraint) (x y : Coeffs) := c.sat (Coeffs.dot x y) - -theorem combine_sat' {s t : Constraint} {x y} (ws : s.sat' x y) (wt : t.sat' x y) : - (s.combine t).sat' x y := (combine_sat _ _ _).mpr ⟨ws, wt⟩ - -theorem div_sat' {c : Constraint} {x y} (h : Coeffs.gcd x ≠ 0) (w : c.sat (Coeffs.dot x y)) : - (c.div (Coeffs.gcd x)).sat' (Coeffs.sdiv x (Coeffs.gcd x)) y := by - dsimp [sat'] - rw [Coeffs.dot_sdiv_left _ _ (Int.dvd_refl _)] - exact div_sat c _ (Coeffs.gcd x) h (Coeffs.gcd_dvd_dot_left x y) w - -theorem not_sat'_of_isImpossible (h : isImpossible c) {x y} : ¬ c.sat' x y := - not_sat_of_isImpossible h - -end Constraint diff --git a/Std/Tactic/Omega/Core.lean b/Std/Tactic/Omega/Core.lean deleted file mode 100644 index fd5738f601..0000000000 --- a/Std/Tactic/Omega/Core.lean +++ /dev/null @@ -1,691 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.OmegaM -import Std.Tactic.Omega.Constraint -import Std.Tactic.Omega.MinNatAbs - -open Lean (HashMap HashSet) - -namespace Std.Tactic.Omega - -open Lean (Expr) -open Lean.Meta - -/-- -A delayed proof that a constraint is satisfied at the atoms. --/ -abbrev Proof : Type := OmegaM Expr - -/-- -Normalize a constraint, by dividing through by the GCD. - -Return `none` if there is nothing to do, to avoid adding unnecessary steps to the proof term. --/ -def normalize? : Constraint × Coeffs → Option (Constraint × Coeffs) - | ⟨s, x⟩ => - let gcd := Coeffs.gcd x -- TODO should we be caching this? - if gcd = 0 then - if s.sat 0 then - some (.trivial, x) - else - some (.impossible, x) - else if gcd = 1 then - none - else - some (s.div gcd, Coeffs.sdiv x gcd) - -/-- Normalize a constraint, by dividing through by the GCD. -/ -def normalize (p : Constraint × Coeffs) : Constraint × Coeffs := - normalize? p |>.getD p - -/-- Shorthand for the first component of `normalize`. -/ --- This `noncomputable` (and others below) is a safeguard that we only use this in proofs. -noncomputable abbrev normalizeConstraint (s : Constraint) (x : Coeffs) : Constraint := - (normalize (s, x)).1 -/-- Shorthand for the second component of `normalize`. -/ -noncomputable abbrev normalizeCoeffs (s : Constraint) (x : Coeffs) : Coeffs := - (normalize (s, x)).2 - -theorem normalize?_eq_some (w : normalize? (s, x) = some (s', x')) : - normalizeConstraint s x = s' ∧ normalizeCoeffs s x = x' := by - simp_all [normalizeConstraint, normalizeCoeffs, normalize] - -theorem normalize_sat {s x v} (w : s.sat' x v) : - (normalizeConstraint s x).sat' (normalizeCoeffs s x) v := by - dsimp [normalizeConstraint, normalizeCoeffs, normalize, normalize?] - split <;> rename_i h - · split - · simp - · dsimp [Constraint.sat'] at w - simp_all - · split - · exact w - · exact Constraint.div_sat' h w - -/-- Multiply by `-1` if the leading coefficient is negative, otherwise return `none`. -/ -def positivize? : Constraint × Coeffs → Option (Constraint × Coeffs) - | ⟨s, x⟩ => - if 0 ≤ x.leading then - none - else - (s.neg, Coeffs.smul x (-1)) - -/-- Multiply by `-1` if the leading coefficient is negative, otherwise do nothing. -/ -noncomputable def positivize (p : Constraint × Coeffs) : Constraint × Coeffs := - positivize? p |>.getD p - -/-- Shorthand for the first component of `positivize`. -/ -noncomputable abbrev positivizeConstraint (s : Constraint) (x : Coeffs) : Constraint := - (positivize (s, x)).1 -/-- Shorthand for the second component of `positivize`. -/ -noncomputable abbrev positivizeCoeffs (s : Constraint) (x : Coeffs) : Coeffs := - (positivize (s, x)).2 - -theorem positivize?_eq_some (w : positivize? (s, x) = some (s', x')) : - positivizeConstraint s x = s' ∧ positivizeCoeffs s x = x' := by - simp_all [positivizeConstraint, positivizeCoeffs, positivize] - -theorem positivize_sat {s x v} (w : s.sat' x v) : - (positivizeConstraint s x).sat' (positivizeCoeffs s x) v := by - dsimp [positivizeConstraint, positivizeCoeffs, positivize, positivize?] - split - · exact w - · simp [Constraint.sat'] - erw [Coeffs.dot_smul_left, ← Int.neg_eq_neg_one_mul] - exact Constraint.neg_sat w - -/-- `positivize` and `normalize`, returning `none` if neither does anything. -/ -def tidy? : Constraint × Coeffs → Option (Constraint × Coeffs) - | ⟨s, x⟩ => - match positivize? (s, x) with - | none => match normalize? (s, x) with - | none => none - | some (s', x') => some (s', x') - | some (s', x') => normalize (s', x') - -/-- `positivize` and `normalize` -/ -def tidy (p : Constraint × Coeffs) : Constraint × Coeffs := - tidy? p |>.getD p - -/-- Shorthand for the first component of `tidy`. -/ -abbrev tidyConstraint (s : Constraint) (x : Coeffs) : Constraint := (tidy (s, x)).1 -/-- Shorthand for the second component of `tidy`. -/ -abbrev tidyCoeffs (s : Constraint) (x : Coeffs) : Coeffs := (tidy (s, x)).2 - -theorem tidy_sat {s x v} (w : s.sat' x v) : (tidyConstraint s x).sat' (tidyCoeffs s x) v := by - dsimp [tidyConstraint, tidyCoeffs, tidy, tidy?] - split <;> rename_i hp - · split <;> rename_i hn - · simp_all - · rcases normalize?_eq_some hn with ⟨rfl, rfl⟩ - exact normalize_sat w - · rcases positivize?_eq_some hp with ⟨rfl, rfl⟩ - exact normalize_sat (positivize_sat w) - -theorem combo_sat' (s t : Constraint) - (a : Int) (x : Coeffs) (b : Int) (y : Coeffs) (v : Coeffs) - (wx : s.sat' x v) (wy : t.sat' y v) : - (Constraint.combo a s b t).sat' (Coeffs.combo a x b y) v := by - rw [Constraint.sat', Coeffs.combo_eq_smul_add_smul, Coeffs.dot_distrib_left, - Coeffs.dot_smul_left, Coeffs.dot_smul_left] - exact Constraint.combo_sat a wx b wy - -/-- The value of the new variable introduced when solving a hard equality. -/ -abbrev bmod_div_term (m : Nat) (a b : Coeffs) : Int := Coeffs.bmod_dot_sub_dot_bmod m a b / m - -/-- The coefficients of the new equation generated when solving a hard equality. -/ -def bmod_coeffs (m : Nat) (i : Nat) (x : Coeffs) : Coeffs := - Coeffs.set (Coeffs.bmod x m) i m - -theorem bmod_sat (m : Nat) (r : Int) (i : Nat) (x v : Coeffs) - (h : x.length ≤ i) -- during proof reconstruction this will be by `decide` - (p : Coeffs.get v i = bmod_div_term m x v) -- and this will be by `rfl` - (w : (Constraint.exact r).sat' x v) : - (Constraint.exact (Int.bmod r m)).sat' (bmod_coeffs m i x) v := by - simp at w - simp only [p, bmod_coeffs, Constraint.exact_sat, Coeffs.dot_set_left, decide_eq_true_eq] - replace h := Nat.le_trans (Coeffs.bmod_length x m) h - rw [Coeffs.get_of_length_le h, Int.sub_zero, - Int.mul_ediv_cancel' (Coeffs.dvd_bmod_dot_sub_dot_bmod _ _ _), w, - ← Int.add_sub_assoc, Int.add_comm, Int.add_sub_assoc, Int.sub_self, Int.add_zero] - -/-- -Our internal representation of argument "justifying" that a constraint holds on some coefficients. -We'll use this to construct the proof term once a contradiction is found. --/ -inductive Justification : Constraint → Coeffs → Type - /-- - `Problem.assumptions[i]` generates a proof that `s.sat' coeffs atoms` - -/ - | assumption (s : Constraint) (x : Coeffs) (i : Nat) : Justification s x - /-- The result of `tidy` on another `Justification`. -/ - | tidy (j : Justification s c) : Justification (tidyConstraint s c) (tidyCoeffs s c) - /-- The result of `combine` on two `Justifications`. -/ - | combine {s t c} (j : Justification s c) (k : Justification t c) : Justification (s.combine t) c - /-- A linear `combo` of two `Justifications`. -/ - | combo {s t x y} (a : Int) (j : Justification s x) (b : Int) (k : Justification t y) : - Justification (Constraint.combo a s b t) (Coeffs.combo a x b y) - /-- - The justification for the constraing constructed using "balanced mod" while - eliminating an equality. - -/ - | bmod (m : Nat) (r : Int) (i : Nat) {x} (j : Justification (.exact r) x) : - Justification (.exact (Int.bmod r m)) (bmod_coeffs m i x) - -/-- Wrapping for `Justification.tidy` when `tidy?` is nonempty. -/ -nonrec def Justification.tidy? (j : Justification s c) : Option (Σ s' c', Justification s' c') := - match tidy? (s, c) with - | some _ => some ⟨_, _, tidy j⟩ - | none => none - -namespace Justification - -private def bullet (s : String) := "• " ++ s.replace "\n" "\n " - -/-- Print a `Justification` as an indented tree structure. -/ -def toString : Justification s x → String - | assumption _ _ i => s!"{x} ∈ {s}: assumption {i}" - | @tidy s' x' j => - if s == s' && x == x' then j.toString else s!"{x} ∈ {s}: tidying up:\n" ++ bullet j.toString - | combine j k => - s!"{x} ∈ {s}: combination of:\n" ++ bullet j.toString ++ "\n" ++ bullet k.toString - | combo a j b k => - s!"{x} ∈ {s}: {a} * x + {b} * y combo of:\n" ++ bullet j.toString ++ "\n" ++ bullet k.toString - | bmod m _ i j => - s!"{x} ∈ {s}: bmod with m={m} and i={i} of:\n" ++ bullet j.toString - -instance : ToString (Justification s x) where toString := toString - -open Lean - -/-- Construct the proof term associated to a `tidy` step. -/ -def tidyProof (s : Constraint) (x : Coeffs) (v : Expr) (prf : Expr) : Expr := - mkApp4 (.const ``tidy_sat []) (toExpr s) (toExpr x) v prf - -/-- Construct the proof term associated to a `combine` step. -/ -def combineProof (s t : Constraint) (x : Coeffs) (v : Expr) (ps pt : Expr) : Expr := - mkApp6 (.const ``Constraint.combine_sat' []) (toExpr s) (toExpr t) (toExpr x) v ps pt - -/-- Construct the proof term associated to a `combo` step. -/ -def comboProof (s t : Constraint) (a : Int) (x : Coeffs) (b : Int) (y : Coeffs) - (v : Expr) (px py : Expr) : Expr := - mkApp9 (.const ``combo_sat' []) (toExpr s) (toExpr t) (toExpr a) (toExpr x) (toExpr b) (toExpr y) - v px py - -/-- Construct the proof term associated to a `bmod` step. -/ -def bmodProof (m : Nat) (r : Int) (i : Nat) (x : Coeffs) (v : Expr) (w : Expr) : MetaM Expr := do - let m := toExpr m - let r := toExpr r - let i := toExpr i - let x := toExpr x - let h ← mkDecideProof (mkApp4 (.const ``LE.le [.zero]) (.const ``Nat []) (.const ``instLENat []) - (.app (.const ``Coeffs.length []) x) i) - let lhs := mkApp2 (.const ``Coeffs.get []) v i - let rhs := mkApp3 (.const ``bmod_div_term []) m x v - let p ← mkEqReflWithExpectedType lhs rhs - return mkApp8 (.const ``bmod_sat []) m r i x v h p w - --- TODO could we increase sharing in the proof term here? - -/-- Constructs a proof that `s.sat' c v = true` -/ -def proof (v : Expr) (assumptions : Array Proof) : Justification s c → Proof - | assumption s c i => assumptions[i]! - | @tidy s c j => return tidyProof s c v (← proof v assumptions j) - | @combine s t c j k => - return combineProof s t c v (← proof v assumptions j) (← proof v assumptions k) - | @combo s t x y a j b k => - return comboProof s t a x b y v (← proof v assumptions j) (← proof v assumptions k) - | @bmod m r i x j => do bmodProof m r i x v (← proof v assumptions j) - -end Justification - -/-- A `Justification` bundled together with its parameters. -/ -structure Fact where - /-- The coefficients of a constraint. -/ - coeffs : Coeffs - /-- The constraint. -/ - constraint : Constraint - /-- The justification of a derived fact. -/ - justification : Justification constraint coeffs - -namespace Fact - -instance : ToString Fact where - toString f := toString f.justification - -/-- `tidy`, implemented on `Fact`. -/ -def tidy (f : Fact) : Fact := - match f.justification.tidy? with - | some ⟨_, _, justification⟩ => { justification } - | none => f - -/-- `combo`, implemented on `Fact`. -/ -def combo (a : Int) (f : Fact) (b : Int) (g : Fact) : Fact := - { justification := .combo a f.justification b g.justification } - -end Fact - -/-- -A `omega` problem. - -This is a hybrid structure: -it contains both `Expr` objects giving proofs of the "ground" assumptions -(or rather continuations which will produce the proofs when needed) -and internal representations of the linear constraints that we manipulate in the algorithm. - -While the algorithm is running we do not synthesize any new `Expr` proofs: proof extraction happens -only once we've found a contradiction. --/ -structure Problem where - /-- The ground assumptions that the algorithm starts from. -/ - assumptions : Array Proof := ∅ - /-- The number of variables in the problem. -/ - numVars : Nat := 0 - /-- The current constraints, indexed by their coefficients. -/ - constraints : HashMap Coeffs Fact := ∅ - /-- - The coefficients for which `constraints` contains an exact constraint (i.e. an equality). - -/ - equalities : HashSet Coeffs := ∅ - /-- - Equations that have already been used to eliminate variables, - along with the variable which was removed, and its coefficient (either `1` or `-1`). - The earlier elements are more recent, - so if these are being reapplied it is essential to use `List.foldr`. - -/ - eliminations : List (Fact × Nat × Int) := [] - /-- Whether the problem is possible. -/ - possible : Bool := true - /-- If the problem is impossible, then `proveFalse?` will contain a proof of `False`. -/ - proveFalse? : Option Proof := none - /-- Invariant between `possible` and `proveFalse?`. -/ - proveFalse?_spec : possible || proveFalse?.isSome := by rfl - /-- - If we have found a contradiction, - `explanation?` will contain a human readable account of the deriviation. - -/ - explanation? : Thunk String := "" - -namespace Problem - -/-- Check if a problem has no constraints. -/ -def isEmpty (p : Problem) : Bool := p.constraints.isEmpty - -instance : ToString Problem where - toString p := - if p.possible then - if p.isEmpty then - "trivial" - else - "\n".intercalate <| - (p.constraints.toList.map fun ⟨coeffs, ⟨_, cst, _⟩⟩ => s!"{coeffs} ∈ {cst}") - else - "impossible" - -open Lean in -/-- -Takes a proof that `s.sat' x v` for some `s` such that `s.isImpossible`, -and constructs a proof of `False`. --/ -def proveFalse {s x} (j : Justification s x) (assumptions : Array Proof) : Proof := do - let v := ← atomsCoeffs - let prf ← j.proof v assumptions - let x := toExpr x - let s := toExpr s - let impossible ← - mkDecideProof (← mkEq (mkApp (.const ``Constraint.isImpossible []) s) (.const ``true [])) - return mkApp5 (.const ``Constraint.not_sat'_of_isImpossible []) s impossible x v prf - -/-- -Insert a constraint into the problem, -without checking if there is already a constraint for these coefficients. --/ -def insertConstraint (p : Problem) : Fact → Problem - | f@⟨x, s, j⟩ => - if s.isImpossible then - { p with - possible := false - proveFalse? := some (proveFalse j p.assumptions) - explanation? := Thunk.mk fun _ => j.toString - proveFalse?_spec := rfl } - else - { p with - numVars := max p.numVars x.length - constraints := p.constraints.insert x f - proveFalse?_spec := p.proveFalse?_spec - equalities := - if f.constraint.isExact then - p.equalities.insert x - else - p.equalities } - -/-- -Add a constraint into the problem, -combining it with any existing constraints for the same coefficients. --/ -def addConstraint (p : Problem) : Fact → Problem - | f@⟨x, s, j⟩ => - if p.possible then - match p.constraints.find? x with - | none => - match s with - | .trivial => p - | _ => p.insertConstraint f - | some ⟨x', t, k⟩ => - if h : x = x' then - let r := s.combine t - if r = t then - -- No need to overwrite the existing fact - -- with the same fact with a more complicated justification - p - else - if r = s then - -- The new constraint is strictly stronger, no need to combine with the old one: - p.insertConstraint ⟨x, s, j⟩ - else - p.insertConstraint ⟨x, s.combine t, j.combine (h ▸ k)⟩ - else - p -- unreachable - else - p - -/-- -Walk through the equalities, finding either the first equality with minimal coefficient `±1`, -or otherwise the equality with minimal `(r.minNatAbs, r.maxNatAbs)` (ordered lexicographically). - -Returns the coefficients of the equality, along with the value of `minNatAbs`. - -Although we don't need to run a termination proof here, it's nevertheless important that we use this -ordering so the algorithm terminates in practice! --/ -def selectEquality (p : Problem) : Option (Coeffs × Nat) := - p.equalities.fold (init := none) fun - | none, c => (c, c.minNatAbs) - | some (r, m), c => - if 2 ≤ m then - let m' := c.minNatAbs - if (m' < m || m' = m && c.maxNatAbs < r.maxNatAbs) then - (c, m') - else - (r, m) - else - (r, m) - -/-- -If we have already solved some equalities, apply those to some new `Fact`. --/ -def replayEliminations (p : Problem) (f : Fact) : Fact := - p.eliminations.foldr (init := f) fun (f, i, s) g => - match Coeffs.get g.coeffs i with - | 0 => g - | y => Fact.combo (-1 * s * y) f 1 g - -/-- -Solve an "easy" equality, i.e. one with a coefficient that is `±1`. - -After solving, the variable will have been eliminated from all constraints. --/ -def solveEasyEquality (p : Problem) (c : Coeffs) : Problem := - let i := c.findIdx? (·.natAbs = 1) |>.getD 0 -- findIdx? is always some - let sign := c.get i |> Int.sign - match p.constraints.find? c with - | some f => - let init := - { assumptions := p.assumptions - eliminations := (f, i, sign) :: p.eliminations } - p.constraints.fold (init := init) fun p' coeffs g => - match Coeffs.get coeffs i with - | 0 => - p'.addConstraint g - | ci => - let k := -1 * sign * ci - p'.addConstraint (Fact.combo k f 1 g).tidy - | _ => p -- unreachable - -open Lean in -/-- -We deal with a hard equality by introducing a new easy equality. - -After solving the easy equality, -the minimum lexicographic value of `(c.minNatAbs, c.maxNatAbs)` will have been reduced. --/ -def dealWithHardEquality (p : Problem) (c : Coeffs) : OmegaM Problem := - match p.constraints.find? c with - | some ⟨_, ⟨some r, some r'⟩, j⟩ => do - let m := c.minNatAbs + 1 - -- We have to store the valid value of the newly introduced variable in the atoms. - let x := mkApp3 (.const ``bmod_div_term []) (toExpr m) (toExpr c) (← atomsCoeffs) - let (i, facts?) ← lookup x - if hr : r' = r then - match facts? with - | none => throwError "When solving hard equality, new atom had been seen before!" - | some facts => if ! facts.isEmpty then - throwError "When solving hard equality, there were unexpected new facts!" - return p.addConstraint { coeffs := _, constraint := _, justification := (hr ▸ j).bmod m r i } - else - throwError "Invalid constraint, expected an equation." -- unreachable - | _ => - return p -- unreachable - -/-- -Solve an equality, by deciding whether it is easy (has a `±1` coefficient) or hard, -and delegating to the appropriate function. --/ -def solveEquality (p : Problem) (c : Coeffs) (m : Nat) : OmegaM Problem := - if m = 1 then - return p.solveEasyEquality c - else - p.dealWithHardEquality c - -/-- Recursively solve all equalities. -/ -partial def solveEqualities (p : Problem) : OmegaM Problem := - if p.possible then - match p.selectEquality with - | some (c, m) => do (← p.solveEquality c m).solveEqualities - | none => return p - else return p - -theorem addInequality_sat (w : c + Coeffs.dot x y ≥ 0) : - Constraint.sat' { lowerBound := some (-c), upperBound := none } x y := by - simp [Constraint.sat', Constraint.sat] - rw [← Int.zero_sub c] - exact Int.sub_left_le_of_le_add w - -open Lean in -/-- Constructing the proof term for `addInequality`. -/ -def addInequality_proof (c : Int) (x : Coeffs) (p : Proof) : Proof := do - return mkApp4 (.const ``addInequality_sat []) (toExpr c) (toExpr x) (← atomsCoeffs) (← p) - -theorem addEquality_sat (w : c + Coeffs.dot x y = 0) : - Constraint.sat' { lowerBound := some (-c), upperBound := some (-c) } x y := by - simp [Constraint.sat', Constraint.sat] - rw [Int.eq_iff_le_and_ge] at w - rwa [Int.add_le_zero_iff_le_neg', Int.add_nonnneg_iff_neg_le', and_comm] at w - -open Lean in -/-- Constructing the proof term for `addEquality`. -/ -def addEquality_proof (c : Int) (x : Coeffs) (p : Proof) : Proof := do - return mkApp4 (.const ``addEquality_sat []) (toExpr c) (toExpr x) (← atomsCoeffs) (← p) - -/-- -Helper function for adding an inequality of the form `const + Coeffs.dot coeffs atoms ≥ 0` -to a `Problem`. - -(This is only used while initializing a `Problem`. During elimination we use `addConstraint`.) --/ --- We are given `prf? : const + Coeffs.dot coeffs atoms ≥ 0`, --- and need to transform this to `Coeffs.dot coeffs atoms ≥ -const`. -def addInequality (p : Problem) (const : Int) (coeffs : Coeffs) (prf? : Option Proof) : Problem := - let prf := prf?.getD (do mkSorry (← mkFreshExprMVar none) false) - let i := p.assumptions.size - let p' := { p with assumptions := p.assumptions.push (addInequality_proof const coeffs prf) } - let f : Fact := - { coeffs - constraint := { lowerBound := some (-const), upperBound := none } - justification := .assumption _ _ i } - let f := p.replayEliminations f - let f := f.tidy - p'.addConstraint f - -/-- -Helper function for adding an equality of the form `const + Coeffs.dot coeffs atoms = 0` -to a `Problem`. - -(This is only used while initializing a `Problem`. During elimination we use `addConstraint`.) --/ -def addEquality (p : Problem) (const : Int) (coeffs : Coeffs) (prf? : Option Proof) : Problem := - let prf := prf?.getD (do mkSorry (← mkFreshExprMVar none) false) - let i := p.assumptions.size - let p' := { p with assumptions := p.assumptions.push (addEquality_proof const coeffs prf) } - let f : Fact := - { coeffs - constraint := { lowerBound := some (-const), upperBound := some (-const) } - justification := .assumption _ _ i } - let f := p.replayEliminations f - let f := f.tidy - p'.addConstraint f - -/-- Folding `addInequality` over a list. -/ -def addInequalities (p : Problem) (ineqs : List (Int × Coeffs × Option Proof)) : Problem := - ineqs.foldl (init := p) fun p ⟨const, coeffs, prf?⟩ => p.addInequality const coeffs prf? - -/-- Folding `addEquality` over a list. -/ -def addEqualities (p : Problem) (eqs : List (Int × Coeffs × Option Proof)) : Problem := - eqs.foldl (init := p) fun p ⟨const, coeffs, prf?⟩ => p.addEquality const coeffs prf? - -/-- Representation of the data required to run Fourier-Motzkin elimination on a variable. -/ -structure FourierMotzkinData where - /-- Which variable is being eliminated. -/ - var : Nat - /-- The "irrelevant" facts which do not involve the target variable. -/ - irrelevant : List Fact := [] - /-- - The facts which give a lower bound on the target variable, - and the coefficient of the target variable in each. - -/ - lowerBounds : List (Fact × Int) := [] - /-- - The facts which give an upper bound on the target variable, - and the coefficient of the target variable in each. - -/ - upperBounds : List (Fact × Int) := [] - /-- - Whether the elimination would be exact, because all of the lower bound coefficients are `±1`. - -/ - lowerExact : Bool := true - /-- - Whether the elimination would be exact, because all of the upper bound coefficients are `±1`. - -/ - upperExact : Bool := true -deriving Inhabited - -instance : ToString FourierMotzkinData where - toString d := - let irrelevant := d.irrelevant.map fun ⟨x, s, _⟩ => s!"{x} ∈ {s}" - let lowerBounds := d.lowerBounds.map fun ⟨⟨x, s, _⟩, _⟩ => s!"{x} ∈ {s}" - let upperBounds := d.upperBounds.map fun ⟨⟨x, s, _⟩, _⟩ => s!"{x} ∈ {s}" - s!"Fourier-Motzkin elimination data for variable {d.var}\n" - ++ s!"• irrelevant: {irrelevant}\n" - ++ s!"• lowerBounds: {lowerBounds}\n" - ++ s!"• upperBounds: {upperBounds}" - -/-- Is a Fourier-Motzkin elimination empty (i.e. there are no relevant constraints). -/ -def FourierMotzkinData.isEmpty (d : FourierMotzkinData) : Bool := - d.lowerBounds.isEmpty && d.upperBounds.isEmpty -/-- The number of new constraints that would be introduced by Fourier-Motzkin elimination. -/ -def FourierMotzkinData.size (d : FourierMotzkinData) : Nat := - d.lowerBounds.length * d.upperBounds.length -/-- Is the Fourier-Motzkin elimination known to be exact? -/ -def FourierMotzkinData.exact (d : FourierMotzkinData) : Bool := d.lowerExact || d.upperExact - -/-- Prepare the Fourier-Motzkin elimination data for each variable. -/ --- TODO we could short-circuit here, if we find one with `size = 0`. -def fourierMotzkinData (p : Problem) : Array FourierMotzkinData := Id.run do - let n := p.numVars - let mut data : Array FourierMotzkinData := - (List.range p.numVars).foldl (fun a i => a.push { var := i}) #[] - for (_, f@⟨xs, s, _⟩) in p.constraints.toList do -- We could make a forIn instance for HashMap - for i in [0:n] do - let x := Coeffs.get xs i - data := data.modify i fun d => - if x = 0 then - { d with irrelevant := f :: d.irrelevant } - else Id.run do - let s' := s.scale x - let mut d' := d - if s'.lowerBound.isSome then - d' := { d' with - lowerBounds := (f, x) :: d'.lowerBounds - lowerExact := d'.lowerExact && x.natAbs = 1 } - if s'.upperBound.isSome then - d' := { d' with - upperBounds := (f, x) :: d'.upperBounds - upperExact := d'.upperExact && x.natAbs = 1 } - return d' - return data - -/-- -Decides which variable to run Fourier-Motzkin elimination on, and returns the associated data. - -We prefer eliminations which introduce no new inequalities, or otherwise exact eliminations, -and break ties by the number of new inequalities introduced. --/ -def fourierMotzkinSelect (data : Array FourierMotzkinData) : FourierMotzkinData := Id.run do - let data := data.filter fun d => ¬ d.isEmpty - let mut bestIdx := 0 - let mut bestSize := data[0]!.size - let mut bestExact := data[0]!.exact - if bestSize = 0 then return data[0]! - for i in [1:data.size] do - let exact := data[i]!.exact - let size := data[i]!.size - if size = 0 || !bestExact && exact || size < bestSize then - if size = 0 then return data[i]! - bestIdx := i - bestExact := exact - bestSize := size - return data[bestIdx]! - -/-- -Run Fourier-Motzkin elimination on one variable. --/ -def fourierMotzkin (p : Problem) : Problem := Id.run do - let data := p.fourierMotzkinData - -- Now perform the elimination. - let ⟨_, irrelevant, lower, upper, _, _⟩ := fourierMotzkinSelect data - let mut r : Problem := { assumptions := p.assumptions, eliminations := p.eliminations } - for f in irrelevant do - r := r.insertConstraint f - for ⟨f, b⟩ in lower do - for ⟨g, a⟩ in upper do - r := r.addConstraint (Fact.combo a f (-b) g).tidy - return r - -mutual - -/-- -Run the `omega` algorithm (for now without dark and grey shadows!) on a problem. --/ -partial def runOmega (p : Problem) : OmegaM Problem := do - trace[omega] "Running omega on:\n{p}" - if p.possible then - let p' ← p.solveEqualities - elimination p' - else - return p - -/-- As for `runOmega`, but assuming the first round of solving equalities has already happened. -/ -partial def elimination (p : Problem) : OmegaM Problem := - if p.possible then - if p.isEmpty then - return p - else do - trace[omega] "Running Fourier-Motzkin elimination on:\n{p}" - runOmega p.fourierMotzkin - else - return p - -end diff --git a/Std/Tactic/Omega/Frontend.lean b/Std/Tactic/Omega/Frontend.lean deleted file mode 100644 index 8dcbc10652..0000000000 --- a/Std/Tactic/Omega/Frontend.lean +++ /dev/null @@ -1,572 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.Core -import Std.Tactic.Omega.LinearCombo -import Std.Tactic.Omega.Logic -import Std.Tactic.Omega.Int -import Std.Tactic.FalseOrByContra -import Std.Lean.Meta.Basic -import Std.Lean.Elab.Tactic -import Std.Lean.HashSet -import Lean.Meta.Tactic.Cases - -/-! -# Frontend to the `omega` tactic. - -See `Std.Tactic.Omega` for an overview of the tactic. --/ - -open Lean Meta - -namespace Std.Tactic.Omega - -/-- -A partially processed `omega` context. - -We have: -* a `Problem` representing the integer linear constraints extracted so far, and their proofs -* the unprocessed `facts : List Expr` taken from the local context, -* the unprocessed `disjunctions : List Expr`, - which will only be split one at a time if we can't otherwise find a contradiction. - -We begin with `facts := ← getLocalHyps` and `problem := .trivial`, -and progressively process the facts. - -As we process the facts, we may generate additional facts -(e.g. about coercions and integer divisions). -To avoid duplicates, we maintain a `HashSet` of previously processed facts. --/ -structure MetaProblem where - /-- An integer linear arithmetic problem. -/ - problem : Problem := {} - /-- Pending facts which have not been processed yet. -/ - facts : List Expr := [] - /-- - Pending disjunctions, which we will case split one at a time if we can't get a contradiction. - -/ - disjunctions : List Expr := [] - /-- Facts which have already been processed; we keep these to avoid duplicates. -/ - processedFacts : HashSet Expr := ∅ - -/-- Construct the `rfl` proof that `lc.eval atoms = e`. -/ -def mkEvalRflProof (e : Expr) (lc : LinearCombo) : OmegaM Expr := do - mkEqReflWithExpectedType e (mkApp2 (.const ``LinearCombo.eval []) (toExpr lc) (← atomsCoeffs)) - -/-- If `e : Expr` is the `n`-th atom, construct the proof that -`e = (coordinate n).eval atoms`. -/ -def mkCoordinateEvalAtomsEq (e : Expr) (n : Nat) : OmegaM Expr := do - if n < 10 then - let atoms := (← getThe State).atoms - let tail ← mkListLit (.const ``Int []) atoms[n+1:].toArray.toList - let lem := .str ``LinearCombo s!"coordinate_eval_{n}" - mkEqSymm (mkAppN (.const lem []) (atoms[:n+1].toArray.push tail)) - else - let atoms ← atomsCoeffs - let n := toExpr n - -- Construct the `rfl` proof that `e = (atoms.get? n).getD 0` - let eq ← mkEqReflWithExpectedType e (mkApp2 (.const ``Coeffs.get []) atoms n) - mkEqTrans eq (← mkEqSymm (mkApp2 (.const ``LinearCombo.coordinate_eval []) n atoms)) - -/-- Construct the linear combination (and its associated proof and new facts) for an atom. -/ -def mkAtomLinearCombo (e : Expr) : OmegaM (LinearCombo × OmegaM Expr × HashSet Expr) := do - let (n, facts) ← lookup e - return ⟨LinearCombo.coordinate n, mkCoordinateEvalAtomsEq e n, facts.getD ∅⟩ - --- This has been PR'd as --- https://github.com/leanprover/lean4/pull/2900 --- and can be removed when that is merged. -@[inherit_doc mkAppN] -local macro_rules - | `(mkAppN $f #[$xs,*]) => (xs.getElems.foldlM (fun x e => `(Expr.app $x $e)) f : MacroM Term) - -mutual - -/-- -Wrapper for `asLinearComboImpl`, -using a cache for previously visited expressions. - -Gives a small (10%) speedup in testing. -I tried using a pointer based cache, -but there was never enough subexpression sharing to make it effective. --/ -partial def asLinearCombo (e : Expr) : OmegaM (LinearCombo × OmegaM Expr × HashSet Expr) := do - let cache ← get - match cache.find? e with - | some (lc, prf) => - trace[omega] "Found in cache: {e}" - return (lc, prf, ∅) - | none => - let r ← asLinearComboImpl e - modifyThe Cache fun cache => (cache.insert e (r.1, r.2.1.run' cache)) - pure r - -/-- -Translates an expression into a `LinearCombo`. -Also returns: -* a proof that this linear combo evaluated at the atoms is equal to the original expression -* a list of new facts which should be recorded: - * for each new atom `a` of the form `((x : Nat) : Int)`, the fact that `0 ≤ a` - * for each new atom `a` of the form `x / k`, for `k` a positive numeral, the facts that - `k * a ≤ x < (k + 1) * a` - * for each new atom of the form `((a - b : Nat) : Int)`, the fact: - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0` - -We also transform the expression as we descend into it: -* pushing coercions: `↑(x + y)`, `↑(x * y)`, `↑(x / k)`, `↑(x % k)`, `↑k` -* unfolding `emod`: `x % k` → `x - x / k` --/ -partial def asLinearComboImpl (e : Expr) : OmegaM (LinearCombo × OmegaM Expr × HashSet Expr) := do - trace[omega] "processing {e}" - match e.int? with - | some i => - let lc := {const := i} - return ⟨lc, mkEvalRflProof e lc, ∅⟩ - | none => - if e.isFVar then - if let some v ← e.fvarId!.getValue? then - rewrite e (← mkEqReflWithExpectedType e v) - else - mkAtomLinearCombo e - else match e.getAppFnArgs with - | (``HAdd.hAdd, #[_, _, _, _, e₁, e₂]) => do - let (l₁, prf₁, facts₁) ← asLinearCombo e₁ - let (l₂, prf₂, facts₂) ← asLinearCombo e₂ - let prf : OmegaM Expr := do - let add_eval := - mkApp3 (.const ``LinearCombo.add_eval []) (toExpr l₁) (toExpr l₂) (← atomsCoeffs) - mkEqTrans - (← mkAppM ``Int.add_congr #[← prf₁, ← prf₂]) - (← mkEqSymm add_eval) - pure (l₁ + l₂, prf, facts₁.merge facts₂) - | (``HSub.hSub, #[_, _, _, _, e₁, e₂]) => do - let (l₁, prf₁, facts₁) ← asLinearCombo e₁ - let (l₂, prf₂, facts₂) ← asLinearCombo e₂ - let prf : OmegaM Expr := do - let sub_eval := - mkApp3 (.const ``LinearCombo.sub_eval []) (toExpr l₁) (toExpr l₂) (← atomsCoeffs) - mkEqTrans - (← mkAppM ``Int.sub_congr #[← prf₁, ← prf₂]) - (← mkEqSymm sub_eval) - pure (l₁ - l₂, prf, facts₁.merge facts₂) - | (``Neg.neg, #[_, _, e']) => do - let (l, prf, facts) ← asLinearCombo e' - let prf' : OmegaM Expr := do - let neg_eval := mkApp2 (.const ``LinearCombo.neg_eval []) (toExpr l) (← atomsCoeffs) - mkEqTrans - (← mkAppM ``Int.neg_congr #[← prf]) - (← mkEqSymm neg_eval) - pure (-l, prf', facts) - | (``HMul.hMul, #[_, _, _, _, x, y]) => - -- If we decide not to expand out the multiplication, - -- we have to revert the `OmegaM` state so that any new facts about the factors - -- can still be reported when they are visited elsewhere. - let r? ← commitWhen do - let (xl, xprf, xfacts) ← asLinearCombo x - let (yl, yprf, yfacts) ← asLinearCombo y - if xl.coeffs.isZero ∨ yl.coeffs.isZero then - let prf : OmegaM Expr := do - let h ← mkDecideProof (mkApp2 (.const ``Or []) - (.app (.const ``Coeffs.isZero []) (toExpr xl.coeffs)) - (.app (.const ``Coeffs.isZero []) (toExpr yl.coeffs))) - let mul_eval := - mkApp4 (.const ``LinearCombo.mul_eval []) (toExpr xl) (toExpr yl) (← atomsCoeffs) h - mkEqTrans - (← mkAppM ``Int.mul_congr #[← xprf, ← yprf]) - (← mkEqSymm mul_eval) - pure (some (LinearCombo.mul xl yl, prf, xfacts.merge yfacts), true) - else - pure (none, false) - match r? with - | some r => pure r - | none => mkAtomLinearCombo e - | (``HMod.hMod, #[_, _, _, _, n, k]) => - match natCast? k with - | some _ => rewrite e (mkApp2 (.const ``Int.emod_def []) n k) - | none => mkAtomLinearCombo e - | (``HDiv.hDiv, #[_, _, _, _, x, z]) => - match intCast? z with - | some 0 => rewrite e (mkApp (.const ``Int.ediv_zero []) x) - | some i => - if i < 0 then - rewrite e (mkApp2 (.const ``Int.ediv_neg []) x (toExpr (-i))) - else - mkAtomLinearCombo e - | _ => mkAtomLinearCombo e - | (``Min.min, #[_, _, a, b]) => - if (← cfg).splitMinMax then - rewrite e (mkApp2 (.const ``Int.min_def []) a b) - else - mkAtomLinearCombo e - | (``Max.max, #[_, _, a, b]) => - if (← cfg).splitMinMax then - rewrite e (mkApp2 (.const ``Int.max_def []) a b) - else - mkAtomLinearCombo e - | (``Nat.cast, #[.const ``Int [], i, n]) => - match n with - | .fvar h => - if let some v ← h.getValue? then - rewrite e (← mkEqReflWithExpectedType e - (mkApp3 (.const ``Nat.cast [0]) (.const ``Int []) i v)) - else - mkAtomLinearCombo e - | _ => match n.getAppFnArgs with - | (``Nat.succ, #[n]) => rewrite e (.app (.const ``Int.ofNat_succ []) n) - | (``HAdd.hAdd, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_add []) a b) - | (``HMul.hMul, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_mul []) a b) - | (``HDiv.hDiv, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_ediv []) a b) - | (``OfNat.ofNat, #[_, n, _]) => rewrite e (.app (.const ``Int.natCast_ofNat []) n) - | (``HMod.hMod, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_emod []) a b) - | (``HSub.hSub, #[_, _, _, _, mkAppN (.const ``HSub.hSub _) #[_, _, _, _, a, b], c]) => - rewrite e (mkApp3 (.const ``Int.ofNat_sub_sub []) a b c) - | (``Prod.fst, #[_, β, p]) => match p with - | .app (.app (.app (.app (.const ``Prod.mk [0, v]) _) _) x) y => - rewrite e (mkApp3 (.const ``Int.ofNat_fst_mk [v]) β x y) - | _ => mkAtomLinearCombo e - | (``Prod.snd, #[α, _, p]) => match p with - | .app (.app (.app (.app (.const ``Prod.mk [u, 0]) _) _) x) y => - rewrite e (mkApp3 (.const ``Int.ofNat_snd_mk [u]) α x y) - | _ => mkAtomLinearCombo e - | (``Min.min, #[_, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_min []) a b) - | (``Max.max, #[_, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_max []) a b) - | (``Int.natAbs, #[n]) => - if (← cfg).splitNatAbs then - rewrite e (mkApp (.const ``Int.ofNat_natAbs []) n) - else - mkAtomLinearCombo e - | _ => mkAtomLinearCombo e - | (``Prod.fst, #[α, β, p]) => match p with - | .app (.app (.app (.app (.const ``Prod.mk [u, v]) _) _) x) y => - rewrite e (mkApp4 (.const ``Prod.fst_mk [u, v]) α x β y) - | _ => mkAtomLinearCombo e - | (``Prod.snd, #[α, β, p]) => match p with - | .app (.app (.app (.app (.const ``Prod.mk [u, v]) _) _) x) y => - rewrite e (mkApp4 (.const ``Prod.snd_mk [u, v]) α x β y) - | _ => mkAtomLinearCombo e - | _ => mkAtomLinearCombo e -where - /-- - Apply a rewrite rule to an expression, and interpret the result as a `LinearCombo`. - (We're not rewriting any subexpressions here, just the top level, for efficiency.) - -/ - rewrite (lhs rw : Expr) : OmegaM (LinearCombo × OmegaM Expr × HashSet Expr) := do - trace[omega] "rewriting {lhs} via {rw} : {← inferType rw}" - match (← inferType rw).eq? with - | some (_, _lhs', rhs) => - let (lc, prf, facts) ← asLinearCombo rhs - let prf' : OmegaM Expr := do mkEqTrans rw (← prf) - pure (lc, prf', facts) - | none => panic! "Invalid rewrite rule in 'asLinearCombo'" - -end -namespace MetaProblem - -/-- The trivial `MetaProblem`, with no facts to processs and a trivial `Problem`. -/ -def trivial : MetaProblem where - problem := {} - -instance : Inhabited MetaProblem := ⟨trivial⟩ - -/-- -Add an integer equality to the `Problem`. - -We solve equalities as they are discovered, as this often results in an earlier contradiction. --/ -def addIntEquality (p : MetaProblem) (h x : Expr) : OmegaM MetaProblem := do - let (lc, prf, facts) ← asLinearCombo x - let newFacts : HashSet Expr := facts.fold (init := ∅) fun s e => - if p.processedFacts.contains e then s else s.insert e - trace[omega] "Adding proof of {lc} = 0" - pure <| - { p with - facts := newFacts.toList ++ p.facts - problem := ← (p.problem.addEquality lc.const lc.coeffs - (some do mkEqTrans (← mkEqSymm (← prf)) h)) |>.solveEqualities } - -/-- -Add an integer inequality to the `Problem`. - -We solve equalities as they are discovered, as this often results in an earlier contradiction. --/ -def addIntInequality (p : MetaProblem) (h y : Expr) : OmegaM MetaProblem := do - let (lc, prf, facts) ← asLinearCombo y - let newFacts : HashSet Expr := facts.fold (init := ∅) fun s e => - if p.processedFacts.contains e then s else s.insert e - trace[omega] "Adding proof of {lc} ≥ 0" - pure <| - { p with - facts := newFacts.toList ++ p.facts - problem := ← (p.problem.addInequality lc.const lc.coeffs - (some do mkAppM ``le_of_le_of_eq #[h, (← prf)])) |>.solveEqualities } - -/-- Given a fact `h` with type `¬ P`, return a more useful fact obtained by pushing the negation. -/ -def pushNot (h P : Expr) : MetaM (Option Expr) := do - let P ← whnfR P - match P with - | .forallE _ t b _ => - if (← isProp t) && (← isProp b) then - return some (mkApp4 (.const ``Decidable.and_not_of_not_imp []) t b - (.app (.const ``Classical.propDecidable []) t) h) - else - return none - | .app _ _ => - match P.getAppFnArgs with - | (``LT.lt, #[.const ``Int [], _, x, y]) => - return some (mkApp3 (.const ``Int.le_of_not_lt []) x y h) - | (``LE.le, #[.const ``Int [], _, x, y]) => - return some (mkApp3 (.const ``Int.lt_of_not_le []) x y h) - | (``LT.lt, #[.const ``Nat [], _, x, y]) => - return some (mkApp3 (.const ``Nat.le_of_not_lt []) x y h) - | (``LE.le, #[.const ``Nat [], _, x, y]) => - return some (mkApp3 (.const ``Nat.lt_of_not_le []) x y h) - | (``Eq, #[.const ``Nat [], x, y]) => - return some (mkApp3 (.const ``Nat.lt_or_gt_of_ne []) x y h) - | (``Eq, #[.const ``Int [], x, y]) => - return some (mkApp3 (.const ``Int.lt_or_gt_of_ne []) x y h) - | (``Prod.Lex, _) => return some (← mkAppM ``Prod.of_not_lex #[h]) - | (``Dvd.dvd, #[.const ``Nat [], _, k, x]) => - return some (mkApp3 (.const ``Nat.emod_pos_of_not_dvd []) k x h) - | (``Dvd.dvd, #[.const ``Int [], _, k, x]) => - -- This introduces a disjunction that could be avoided by checking `k ≠ 0`. - return some (mkApp3 (.const ``Int.emod_pos_of_not_dvd []) k x h) - | (``Or, #[P₁, P₂]) => return some (mkApp3 (.const ``and_not_not_of_not_or []) P₁ P₂ h) - | (``And, #[P₁, P₂]) => - return some (mkApp5 (.const ``Decidable.or_not_not_of_not_and []) P₁ P₂ - (.app (.const ``Classical.propDecidable []) P₁) - (.app (.const ``Classical.propDecidable []) P₂) h) - | (``Not, #[P']) => - return some (mkApp3 (.const ``Decidable.of_not_not []) P' - (.app (.const ``Classical.propDecidable []) P') h) - | (``Iff, #[P₁, P₂]) => - return some (mkApp5 (.const ``Decidable.and_not_or_not_and_of_not_iff []) P₁ P₂ - (.app (.const ``Classical.propDecidable []) P₁) - (.app (.const ``Classical.propDecidable []) P₂) h) - | _ => return none - | _ => return none - -/-- -Parse an `Expr` and extract facts, also returning the number of new facts found. --/ -partial def addFact (p : MetaProblem) (h : Expr) : OmegaM (MetaProblem × Nat) := do - if ! p.problem.possible then - return (p, 0) - else - let t ← instantiateMVars (← whnfR (← inferType h)) - trace[omega] "adding fact: {t}" - match t with - | .forallE _ x y _ => - if (← isProp x) && (← isProp y) then - p.addFact (mkApp4 (.const ``Decidable.not_or_of_imp []) x y - (.app (.const ``Classical.propDecidable []) x) h) - else - return (p, 0) - | .app _ _ => - match t.getAppFnArgs with - | (``Eq, #[.const ``Int [], x, y]) => - match y.int? with - | some 0 => pure (← p.addIntEquality h x, 1) - | _ => p.addFact (mkApp3 (.const ``Int.sub_eq_zero_of_eq []) x y h) - | (``LE.le, #[.const ``Int [], _, x, y]) => - match x.int? with - | some 0 => pure (← p.addIntInequality h y, 1) - | _ => p.addFact (mkApp3 (.const ``Int.sub_nonneg_of_le []) y x h) - | (``LT.lt, #[.const ``Int [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.add_one_le_of_lt []) x y h) - | (``GT.gt, #[.const ``Int [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.lt_of_gt []) x y h) - | (``GE.ge, #[.const ``Int [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.le_of_ge []) x y h) - | (``GT.gt, #[.const ``Nat [], _, x, y]) => - p.addFact (mkApp3 (.const ``Nat.lt_of_gt []) x y h) - | (``GE.ge, #[.const ``Nat [], _, x, y]) => - p.addFact (mkApp3 (.const ``Nat.le_of_ge []) x y h) - | (``Ne, #[.const ``Nat [], x, y]) => - p.addFact (mkApp3 (.const ``Nat.lt_or_gt_of_ne []) x y h) - | (``Not, #[P]) => match ← pushNot h P with - | none => return (p, 0) - | some h' => p.addFact h' - | (``Eq, #[.const ``Nat [], x, y]) => - p.addFact (mkApp3 (.const ``Int.ofNat_congr []) x y h) - | (``LT.lt, #[.const ``Nat [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.ofNat_lt_of_lt []) x y h) - | (``LE.le, #[.const ``Nat [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.ofNat_le_of_le []) x y h) - | (``Ne, #[.const ``Int [], x, y]) => - p.addFact (mkApp3 (.const ``Int.lt_or_gt_of_ne []) x y h) - | (``Prod.Lex, _) => p.addFact (← mkAppM ``Prod.of_lex #[h]) - | (``Dvd.dvd, #[.const ``Nat [], _, k, x]) => - p.addFact (mkApp3 (.const ``Nat.mod_eq_zero_of_dvd []) k x h) - | (``Dvd.dvd, #[.const ``Int [], _, k, x]) => - p.addFact (mkApp3 (.const ``Int.emod_eq_zero_of_dvd []) k x h) - | (``And, #[t₁, t₂]) => do - let (p₁, n₁) ← p.addFact (mkApp3 (.const ``And.left []) t₁ t₂ h) - let (p₂, n₂) ← p₁.addFact (mkApp3 (.const ``And.right []) t₁ t₂ h) - return (p₂, n₁ + n₂) - | (``Exists, #[α, P]) => - p.addFact (mkApp3 (.const ``Exists.choose_spec [← getLevel α]) α P h) - | (``Subtype, #[α, P]) => - p.addFact (mkApp3 (.const ``Subtype.property [← getLevel α]) α P h) - | (``Iff, #[P₁, P₂]) => - p.addFact (mkApp4 (.const ``Decidable.and_or_not_and_not_of_iff []) - P₁ P₂ (.app (.const ``Classical.propDecidable []) P₂) h) - | (``Or, #[_, _]) => - if (← cfg).splitDisjunctions then - return ({ p with disjunctions := p.disjunctions.insert h }, 1) - else - return (p, 0) - | _ => pure (p, 0) - | _ => pure (p, 0) - -/-- -Process all the facts in a `MetaProblem`, returning the new problem, and the number of new facts. - -This is partial because new facts may be generated along the way. --/ -partial def processFacts (p : MetaProblem) : OmegaM (MetaProblem × Nat) := do - match p.facts with - | [] => pure (p, 0) - | h :: t => - if p.processedFacts.contains h then - processFacts { p with facts := t } - else - let (p₁, n₁) ← MetaProblem.addFact { p with - facts := t - processedFacts := p.processedFacts.insert h } h - let (p₂, n₂) ← p₁.processFacts - return (p₂, n₁ + n₂) - -end MetaProblem - -/-- -Given `p : P ∨ Q` (or any inductive type with two one-argument constructors), -split the goal into two subgoals: -one containing the hypothesis `h : P` and another containing `h : Q`. --/ -def cases₂ (mvarId : MVarId) (p : Expr) (hName : Name := `h) : - MetaM ((MVarId × FVarId) × (MVarId × FVarId)) := do - let mvarId ← mvarId.assert `hByCases (← inferType p) p - let (fvarId, mvarId) ← mvarId.intro1 - let #[s₁, s₂] ← mvarId.cases fvarId #[{ varNames := [hName] }, { varNames := [hName] }] | - throwError "'cases' tactic failed, unexpected number of subgoals" - let #[Expr.fvar f₁ ..] ← pure s₁.fields - | throwError "'cases' tactic failed, unexpected new hypothesis" - let #[Expr.fvar f₂ ..] ← pure s₂.fields - | throwError "'cases' tactic failed, unexpected new hypothesis" - return ((s₁.mvarId, f₁), (s₂.mvarId, f₂)) - - -mutual - -/-- -Split a disjunction in a `MetaProblem`, and if we find a new usable fact -call `omegaImpl` in both branches. --/ -partial def splitDisjunction (m : MetaProblem) (g : MVarId) : OmegaM Unit := g.withContext do - match m.disjunctions with - | [] => throwError "omega did not find a contradiction:\n{m.problem}" - | h :: t => - trace[omega] "Case splitting on {← inferType h}" - let ctx ← getMCtx - let (⟨g₁, h₁⟩, ⟨g₂, h₂⟩) ← cases₂ g h - trace[omega] "Adding facts:\n{← g₁.withContext <| inferType (.fvar h₁)}" - let m₁ := { m with facts := [.fvar h₁], disjunctions := t } - let r ← withoutModifyingState do - let (m₁, n) ← g₁.withContext m₁.processFacts - if 0 < n then - omegaImpl m₁ g₁ - pure true - else - pure false - if r then - trace[omega] "Adding facts:\n{← g₂.withContext <| inferType (.fvar h₂)}" - let m₂ := { m with facts := [.fvar h₂], disjunctions := t } - omegaImpl m₂ g₂ - else - trace[omega] "No new facts found." - setMCtx ctx - splitDisjunction { m with disjunctions := t } g - -/-- Implementation of the `omega` algorithm, and handling disjunctions. -/ -partial def omegaImpl (m : MetaProblem) (g : MVarId) : OmegaM Unit := g.withContext do - let (m, _) ← m.processFacts - guard m.facts.isEmpty - let p := m.problem - trace[omega] "Extracted linear arithmetic problem:\nAtoms: {← atomsList}\n{p}" - let p' ← if p.possible then p.elimination else pure p - trace[omega] "After elimination:\nAtoms: {← atomsList}\n{p'}" - match p'.possible, p'.proveFalse?, p'.proveFalse?_spec with - | true, _, _ => - splitDisjunction m g - | false, .some prf, _ => - trace[omega] "Justification:\n{p'.explanation?.get}" - let prf ← instantiateMVars (← prf) - trace[omega] "omega found a contradiction, proving {← inferType prf}" - trace[omega] "{prf}" - g.assign prf - -end - -/-- -Given a collection of facts, try prove `False` using the omega algorithm, -and close the goal using that. --/ -def omega (facts : List Expr) (g : MVarId) (cfg : OmegaConfig := {}) : MetaM Unit := - OmegaM.run (omegaImpl { facts } g) cfg - -open Lean Elab Tactic Parser.Tactic - -/-- The `omega` tactic, for resolving integer and natural linear arithmetic problems. -/ -def omegaTactic (cfg : OmegaConfig) : TacticM Unit := do - liftMetaFinishingTactic fun g => do - let g ← falseOrByContra g - (useClassical := false) -- because all the hypotheses we can make use of are decidable - g.withContext do - let hyps := (← getLocalHyps).toList - trace[omega] "analyzing {hyps.length} hypotheses:\n{← hyps.mapM inferType}" - omega hyps g cfg - -/-- The `omega` tactic, for resolving integer and natural linear arithmetic problems. This -`TacticM Unit` frontend with default configuration can be used as an Aesop rule, for example via -the tactic call `aesop (add 50% tactic Std.Tactic.Omega.omegaDefault)`. -/ -def omegaDefault : TacticM Unit := omegaTactic {} - -/-- -The `omega` tactic, for resolving integer and natural linear arithmetic problems. - -It is not yet a full decision procedure (no "dark" or "grey" shadows), -but should be effective on many problems. - -We handle hypotheses of the form `x = y`, `x < y`, `x ≤ y`, and `k ∣ x` for `x y` in `Nat` or `Int` -(and `k` a literal), along with negations of these statements. - -We decompose the sides of the inequalities as linear combinations of atoms. - -If we encounter `x / k` or `x % k` for literal integers `k` we introduce new auxiliary variables -and the relevant inequalities. - -On the first pass, we do not perform case splits on natural subtraction. -If `omega` fails, we recursively perform a case split on -a natural subtraction appearing in a hypothesis, and try again. - -The options -``` -omega (config := - { splitDisjunctions := true, splitNatSub := true, splitNatAbs := true, splitMinMax := true }) -``` -can be used to: -* `splitDisjunctions`: split any disjunctions found in the context, - if the problem is not otherwise solvable. -* `splitNatSub`: for each appearance of `((a - b : Nat) : Int)`, split on `a ≤ b` if necessary. -* `splitNatAbs`: for each appearance of `Int.natAbs a`, split on `0 ≤ a` if necessary. -* `splitMinMax`: for each occurrence of `min a b`, split on `min a b = a ∨ min a b = b` -Currently, all of these are on by default. --/ -syntax (name := omegaSyntax) "omega" (config)? : tactic - -elab_rules : tactic | - `(tactic| omega $[$cfg]?) => do - let cfg ← elabOmegaConfig (mkOptionalNode cfg) - omegaTactic cfg diff --git a/Std/Tactic/Omega/Int.lean b/Std/Tactic/Omega/Int.lean deleted file mode 100644 index 50a3dd1277..0000000000 --- a/Std/Tactic/Omega/Int.lean +++ /dev/null @@ -1,157 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Classes.Order -import Std.Tactic.Alias - -/-! -# Lemmas about `Nat` and `Int` needed internally by `omega`. - -These statements are useful for constructing proof expressions, -but unlikely to be widely useful, so are inside the `Std.Tactic.Omega` namespace. - -If you do find a use for them, please move them into the appropriate file and namespace! --/ - -namespace Std.Tactic.Omega.Int - -theorem ofNat_pow (a b : Nat) : ((a ^ b : Nat) : Int) = (a : Int) ^ b := by - induction b with - | zero => rfl - | succ b ih => rw [Nat.pow_succ, Int.ofNat_mul, ih]; rfl - -theorem pos_pow_of_pos (a : Int) (b : Nat) (h : 0 < a) : 0 < a ^ b := by - rw [Int.eq_natAbs_of_zero_le (Int.le_of_lt h), ← Int.ofNat_zero, ← Int.ofNat_pow, Int.ofNat_lt] - exact Nat.pos_pow_of_pos _ (Int.natAbs_pos.mpr (Int.ne_of_gt h)) - -theorem ofNat_pos {a : Nat} : 0 < (a : Int) ↔ 0 < a := by - rw [← Int.ofNat_zero, Int.ofNat_lt] - -alias ⟨_, ofNat_pos_of_pos⟩ := Int.ofNat_pos - -theorem natCast_ofNat {x : Nat} : - @Nat.cast Int instNatCastInt (no_index (OfNat.ofNat x)) = OfNat.ofNat x := rfl - -alias ⟨_, ofNat_lt_of_lt⟩ := Int.ofNat_lt -alias ⟨_, ofNat_le_of_le⟩ := Int.ofNat_le -protected alias ⟨lt_of_not_ge, _⟩ := Int.not_le -protected alias ⟨lt_of_not_le, not_le_of_lt⟩ := Int.not_le -protected alias ⟨_, lt_le_asymm⟩ := Int.not_le - -protected alias ⟨le_of_not_gt, not_lt_of_ge⟩ := Int.not_lt -protected alias ⟨le_of_not_lt, not_lt_of_le⟩ := Int.not_lt -protected alias ⟨_, le_lt_asymm⟩ := Int.not_lt - -theorem add_congr {a b c d : Int} (h₁ : a = b) (h₂ : c = d) : a + c = b + d := by - subst h₁; subst h₂; rfl - -theorem mul_congr {a b c d : Int} (h₁ : a = b) (h₂ : c = d) : a * c = b * d := by - subst h₁; subst h₂; rfl - -theorem mul_congr_left {a b : Int} (h₁ : a = b) (c : Int) : a * c = b * c := by - subst h₁; rfl - -theorem sub_congr {a b c d : Int} (h₁ : a = b) (h₂ : c = d) : a - c = b - d := by - subst h₁; subst h₂; rfl - -theorem neg_congr {a b : Int} (h₁ : a = b) : -a = -b := by - subst h₁; rfl - -theorem lt_of_gt {x y : Int} (h : x > y) : y < x := gt_iff_lt.mp h -theorem le_of_ge {x y : Int} (h : x ≥ y) : y ≤ x := ge_iff_le.mp h - -theorem ofNat_sub_eq_zero {b a : Nat} (h : ¬ b ≤ a) : ((a - b : Nat) : Int) = 0 := - Int.ofNat_eq_zero.mpr (Nat.sub_eq_zero_of_le (Nat.le_of_lt (Nat.not_le.mp h))) - -theorem ofNat_sub_dichotomy {a b : Nat} : - b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0 := by - by_cases h : b ≤ a - · left - simpa [Int.ofNat_sub h] - · right - simpa [Int.ofNat_sub_eq_zero h] using (Nat.not_le.mp h) - -theorem ofNat_congr {a b : Nat} (h : a = b) : (a : Int) = (b : Int) := congrArg _ h - -theorem ofNat_sub_sub {a b c : Nat} : ((a - b - c : Nat) : Int) = ((a - (b + c) : Nat) : Int) := - congrArg _ (Nat.sub_sub _ _ _) - -theorem ofNat_min (a b : Nat) : ((min a b : Nat) : Int) = min (a : Int) (b : Int) := by - simp only [Nat.min_def, Int.min_def, Int.ofNat_le] - split <;> rfl - -theorem ofNat_max (a b : Nat) : ((max a b : Nat) : Int) = max (a : Int) (b : Int) := by - simp only [Nat.max_def, Int.max_def, Int.ofNat_le] - split <;> rfl - -theorem ofNat_natAbs (a : Int) : (a.natAbs : Int) = if 0 ≤ a then a else -a := by - rw [Int.natAbs] - split <;> rename_i n - · simp only [Int.ofNat_eq_coe] - rw [if_pos (Int.ofNat_nonneg n)] - · simp; rfl - -theorem natAbs_dichotomy {a : Int} : 0 ≤ a ∧ a.natAbs = a ∨ a < 0 ∧ a.natAbs = -a := by - by_cases h : 0 ≤ a - · left - simp_all [Int.natAbs_of_nonneg] - · right - rw [Int.not_le] at h - rw [Int.ofNat_natAbs_of_nonpos (Int.le_of_lt h)] - simp_all - -theorem neg_le_natAbs {a : Int} : -a ≤ a.natAbs := by - have t := Int.le_natAbs (a := -a) - simp at t - exact t - -theorem add_le_iff_le_sub (a b c : Int) : a + b ≤ c ↔ a ≤ c - b := by - conv => - lhs - rw [← Int.add_zero c, ← Int.sub_self (-b), Int.sub_eq_add_neg, ← Int.add_assoc, Int.neg_neg, - Int.add_le_add_iff_right] - -theorem le_add_iff_sub_le (a b c : Int) : a ≤ b + c ↔ a - c ≤ b := by - conv => - lhs - rw [← Int.neg_neg c, ← Int.sub_eq_add_neg, ← add_le_iff_le_sub] - -theorem add_le_zero_iff_le_neg (a b : Int) : a + b ≤ 0 ↔ a ≤ - b := by - rw [add_le_iff_le_sub, Int.zero_sub] -theorem add_le_zero_iff_le_neg' (a b : Int) : a + b ≤ 0 ↔ b ≤ -a := by - rw [Int.add_comm, add_le_zero_iff_le_neg] -theorem add_nonnneg_iff_neg_le (a b : Int) : 0 ≤ a + b ↔ -b ≤ a := by - rw [le_add_iff_sub_le, Int.zero_sub] -theorem add_nonnneg_iff_neg_le' (a b : Int) : 0 ≤ a + b ↔ -a ≤ b := by - rw [Int.add_comm, add_nonnneg_iff_neg_le] - -theorem ofNat_fst_mk {β} {x : Nat} {y : β} : (Prod.mk x y).fst = (x : Int) := rfl -theorem ofNat_snd_mk {α} {x : α} {y : Nat} : (Prod.mk x y).snd = (y : Int) := rfl - - -end Int - -namespace Nat - -theorem lt_of_gt {x y : Nat} (h : x > y) : y < x := gt_iff_lt.mp h -theorem le_of_ge {x y : Nat} (h : x ≥ y) : y ≤ x := ge_iff_le.mp h - -end Nat - -namespace Prod - -theorem of_lex (w : Prod.Lex r s p q) : r p.fst q.fst ∨ p.fst = q.fst ∧ s p.snd q.snd := - (Prod.lex_def r s).mp w - -theorem of_not_lex {α} {r : α → α → Prop} [DecidableEq α] {β} {s : β → β → Prop} - {p q : α × β} (w : ¬ Prod.Lex r s p q) : - ¬ r p.fst q.fst ∧ (p.fst ≠ q.fst ∨ ¬ s p.snd q.snd) := by - rw [Prod.lex_def, not_or, Decidable.not_and_iff_or_not_not] at w - exact w - -theorem fst_mk : (Prod.mk x y).fst = x := rfl -theorem snd_mk : (Prod.mk x y).snd = y := rfl - -end Prod diff --git a/Std/Tactic/Omega/IntList.lean b/Std/Tactic/Omega/IntList.lean deleted file mode 100644 index 9e55be203c..0000000000 --- a/Std/Tactic/Omega/IntList.lean +++ /dev/null @@ -1,405 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Simpa - -/-- -A type synonym for `List Int`, used by `omega` for dense representation of coefficients. - -We define algebraic operations, -interpreting `List Int` as a finitely supported function `Nat → Int`. --/ -abbrev IntList := List Int - -namespace IntList - -/-- Get the `i`-th element (interpreted as `0` if the list is not long enough). -/ -def get (xs : IntList) (i : Nat) : Int := (xs.get? i).getD 0 - -@[simp] theorem get_nil : get ([] : IntList) i = 0 := rfl -@[simp] theorem get_cons_zero : get (x :: xs) 0 = x := rfl -@[simp] theorem get_cons_succ : get (x :: xs) (i+1) = get xs i := rfl - -theorem get_map {xs : IntList} (h : f 0 = 0) : get (xs.map f) i = f (xs.get i) := by - simp only [get, List.get?_map] - cases xs.get? i <;> simp_all - -theorem get_of_length_le {xs : IntList} (h : xs.length ≤ i) : xs.get i = 0 := by - rw [get, List.get?_eq_none.mpr h] - rfl - --- theorem lt_length_of_get_nonzero {xs : IntList} (h : xs.get i ≠ 0) : i < xs.length := by --- revert h --- simpa using mt get_of_length_le - -/-- Like `List.set`, but right-pad with zeroes as necessary first. -/ -def set (xs : IntList) (i : Nat) (y : Int) : IntList := - match xs, i with - | [], 0 => [y] - | [], (i+1) => 0 :: set [] i y - | _ :: xs, 0 => y :: xs - | x :: xs, (i+1) => x :: set xs i y - -@[simp] theorem set_nil_zero : set [] 0 y = [y] := rfl -@[simp] theorem set_nil_succ : set [] (i+1) y = 0 :: set [] i y := rfl -@[simp] theorem set_cons_zero : set (x :: xs) 0 y = y :: xs := rfl -@[simp] theorem set_cons_succ : set (x :: xs) (i+1) y = x :: set xs i y := rfl - -/-- Returns the leading coefficient, i.e. the first non-zero entry. -/ -def leading (xs : IntList) : Int := xs.find? (! · == 0) |>.getD 0 - -/-- Implementation of `+` on `IntList`. -/ -def add (xs ys : IntList) : IntList := - List.zipWithAll (fun x y => x.getD 0 + y.getD 0) xs ys - -instance : Add IntList := ⟨add⟩ - -theorem add_def (xs ys : IntList) : - xs + ys = List.zipWithAll (fun x y => x.getD 0 + y.getD 0) xs ys := - rfl - -@[simp] theorem add_get (xs ys : IntList) (i : Nat) : (xs + ys).get i = xs.get i + ys.get i := by - simp only [add_def, get, List.zipWithAll_get?, List.get?_eq_none] - cases xs.get? i <;> cases ys.get? i <;> simp - -@[simp] theorem add_nil (xs : IntList) : xs + [] = xs := by simp [add_def] -@[simp] theorem nil_add (xs : IntList) : [] + xs = xs := by simp [add_def] -@[simp] theorem cons_add_cons (x) (xs : IntList) (y) (ys : IntList) : - (x :: xs) + (y :: ys) = (x + y) :: (xs + ys) := by simp [add_def] - -/-- Implementation of `*` on `IntList`. -/ -def mul (xs ys : IntList) : IntList := List.zipWith (· * ·) xs ys - -instance : Mul IntList := ⟨mul⟩ - -theorem mul_def (xs ys : IntList) : xs * ys = List.zipWith (· * ·) xs ys := - rfl - -@[simp] theorem mul_get (xs ys : IntList) (i : Nat) : (xs * ys).get i = xs.get i * ys.get i := by - simp only [mul_def, get, List.zipWith_get?] - cases xs.get? i <;> cases ys.get? i <;> simp - -@[simp] theorem mul_nil_left : ([] : IntList) * ys = [] := rfl -@[simp] theorem mul_nil_right : xs * ([] : IntList) = [] := List.zipWith_nil_right -@[simp] theorem mul_cons₂ : (x::xs : IntList) * (y::ys) = (x * y) :: (xs * ys) := rfl - -/-- Implementation of negation on `IntList`. -/ -def neg (xs : IntList) : IntList := xs.map fun x => -x - -instance : Neg IntList := ⟨neg⟩ - -theorem neg_def (xs : IntList) : - xs = xs.map fun x => -x := rfl - -@[simp] theorem neg_get (xs : IntList) (i : Nat) : (- xs).get i = - xs.get i := by - simp only [neg_def, get, List.get?_map] - cases xs.get? i <;> simp - -@[simp] theorem neg_nil : (- ([] : IntList)) = [] := rfl -@[simp] theorem neg_cons : (- (x::xs : IntList)) = -x :: -xs := rfl - -/-- Implementation of subtraction on `IntList`. -/ -def sub (xs ys : IntList) : IntList := - List.zipWithAll (fun x y => x.getD 0 - y.getD 0) xs ys - -instance : Sub IntList := ⟨sub⟩ - -theorem sub_def (xs ys : IntList) : - xs - ys = List.zipWithAll (fun x y => x.getD 0 - y.getD 0) xs ys := - rfl - -/-- Implementation of scalar multiplication by an integer on `IntList`. -/ -def smul (xs : IntList) (i : Int) : IntList := - xs.map fun x => i * x - -instance : HMul Int IntList IntList where - hMul i xs := xs.smul i - -theorem smul_def (xs : IntList) (i : Int) : i * xs = xs.map fun x => i * x := rfl - -@[simp] theorem smul_get (xs : IntList) (a : Int) (i : Nat) : (a * xs).get i = a * xs.get i := by - simp only [smul_def, get, List.get?_map] - cases xs.get? i <;> simp - -@[simp] theorem smul_nil {i : Int} : i * ([] : IntList) = [] := rfl -@[simp] theorem smul_cons {i : Int} : i * (x::xs : IntList) = i * x :: i * xs := rfl - -/-- A linear combination of two `IntList`s. -/ -def combo (a : Int) (xs : IntList) (b : Int) (ys : IntList) : IntList := - List.zipWithAll (fun x y => a * x.getD 0 + b * y.getD 0) xs ys - -theorem combo_eq_smul_add_smul (a : Int) (xs : IntList) (b : Int) (ys : IntList) : - combo a xs b ys = a * xs + b * ys := by - dsimp [combo] - induction xs generalizing ys with - | nil => simp; rfl - | cons x xs ih => - cases ys with - | nil => simp; rfl - | cons y ys => simp_all - -attribute [local simp] add_def mul_def in -theorem mul_distrib_left (xs ys zs : IntList) : (xs + ys) * zs = xs * zs + ys * zs := by - induction xs generalizing ys zs with - | nil => - cases ys with - | nil => simp - | cons _ _ => - cases zs with - | nil => simp - | cons _ _ => simp_all [Int.add_mul] - | cons x xs ih₁ => - cases ys with - | nil => simp_all - | cons _ _ => - cases zs with - | nil => simp - | cons _ _ => simp_all [Int.add_mul] - -theorem mul_neg_left (xs ys : IntList) : (-xs) * ys = -(xs * ys) := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.neg_mul] - -attribute [local simp] add_def neg_def sub_def in -theorem sub_eq_add_neg (xs ys : IntList) : xs - ys = xs + (-ys) := by - induction xs generalizing ys with - | nil => simp; rfl - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.sub_eq_add_neg] - -@[simp] theorem mul_smul_left {i : Int} {xs ys : IntList} : (i * xs) * ys = i * (xs * ys) := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.mul_assoc] - -/-- The sum of the entries of an `IntList`. -/ -def sum (xs : IntList) : Int := xs.foldr (· + ·) 0 - -@[simp] theorem sum_nil : sum ([] : IntList) = 0 := rfl -@[simp] theorem sum_cons : sum (x::xs : IntList) = x + sum xs := rfl - -attribute [local simp] sum add_def in -theorem sum_add (xs ys : IntList) : (xs + ys).sum = xs.sum + ys.sum := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.add_assoc, Int.add_left_comm] - -@[simp] -theorem sum_neg (xs : IntList) : (-xs).sum = -(xs.sum) := by - induction xs with - | nil => simp - | cons x xs ih => simp_all [Int.neg_add] - -@[simp] -theorem sum_smul (i : Int) (xs : IntList) : (i * xs).sum = i * (xs.sum) := by - induction xs with - | nil => simp - | cons x xs ih => simp_all [Int.mul_add] - -/-- The dot product of two `IntList`s. -/ -def dot (xs ys : IntList) : Int := (xs * ys).sum - -example : IntList.dot [a, b, c] [x, y, z] = IntList.dot [a, b, c, d] [x, y, z] := rfl -example : IntList.dot [a, b, c] [x, y, z] = IntList.dot [a, b, c] [x, y, z, w] := rfl - -@[local simp] theorem dot_nil_left : dot ([] : IntList) ys = 0 := rfl -@[simp] theorem dot_nil_right : dot xs ([] : IntList) = 0 := by simp [dot] -@[simp] theorem dot_cons₂ : dot (x::xs) (y::ys) = x * y + dot xs ys := rfl - --- theorem dot_comm (xs ys : IntList) : dot xs ys = dot ys xs := by --- rw [dot, dot, mul_comm] - -@[simp] theorem dot_set_left (xs ys : IntList) (i : Nat) (z : Int) : - dot (xs.set i z) ys = dot xs ys + (z - xs.get i) * ys.get i := by - induction xs generalizing i ys with - | nil => - induction i generalizing ys with - | zero => cases ys <;> simp - | succ i => cases ys <;> simp_all - | cons x xs ih => - induction i generalizing ys with - | zero => - cases ys with - | nil => simp - | cons y ys => - simp only [Nat.zero_eq, set_cons_zero, dot_cons₂, get_cons_zero, Int.sub_mul] - rw [Int.add_right_comm, Int.add_comm (x * y), Int.sub_add_cancel] - | succ i => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.add_assoc] - -theorem dot_distrib_left (xs ys zs : IntList) : (xs + ys).dot zs = xs.dot zs + ys.dot zs := by - simp [dot, mul_distrib_left, sum_add] - -@[simp] theorem dot_neg_left (xs ys : IntList) : (-xs).dot ys = -(xs.dot ys) := by - simp [dot, mul_neg_left] - -@[simp] theorem dot_smul_left (xs ys : IntList) (i : Int) : (i * xs).dot ys = i * xs.dot ys := by - simp [dot] - -theorem dot_of_left_zero (w : ∀ x, x ∈ xs → x = 0) : dot xs ys = 0 := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => - rw [dot_cons₂, w x (by simp), ih] - · simp - · intro x m - apply w - exact List.mem_cons_of_mem _ m - -/-- Division of an `IntList` by a integer. -/ -def sdiv (xs : IntList) (g : Int) : IntList := xs.map fun x => x / g - -@[simp] theorem sdiv_nil : sdiv [] g = [] := rfl -@[simp] theorem sdiv_cons : sdiv (x::xs) g = (x / g) :: sdiv xs g := rfl - -/-- The gcd of the absolute values of the entries of an `IntList`. -/ -def gcd (xs : IntList) : Nat := xs.foldr (fun x g => Nat.gcd x.natAbs g) 0 - -@[simp] theorem gcd_nil : gcd [] = 0 := rfl -@[simp] theorem gcd_cons : gcd (x :: xs) = Nat.gcd x.natAbs (gcd xs) := rfl - -theorem gcd_cons_div_left : (gcd (x::xs) : Int) ∣ x := by - simp only [gcd, List.foldr_cons, Int.ofNat_dvd_left] - apply Nat.gcd_dvd_left - -theorem gcd_cons_div_right : gcd (x::xs) ∣ gcd xs := by - simp only [gcd, List.foldr_cons] - apply Nat.gcd_dvd_right - -theorem gcd_cons_div_right' : (gcd (x::xs) : Int) ∣ (gcd xs : Int) := by - rw [Int.ofNat_dvd_left, Int.natAbs_ofNat] - exact gcd_cons_div_right - -theorem gcd_dvd (xs : IntList) {a : Int} (m : a ∈ xs) : (xs.gcd : Int) ∣ a := by - rw [Int.ofNat_dvd_left] - induction m with - | head => - simp only [gcd_cons] - apply Nat.gcd_dvd_left - | tail b m ih => -- FIXME: why is the argument of tail implicit? - simp only [gcd_cons] - exact Nat.dvd_trans (Nat.gcd_dvd_right _ _) ih - -theorem dvd_gcd (xs : IntList) (c : Nat) (w : ∀ {a : Int}, a ∈ xs → (c : Int) ∣ a) : - c ∣ xs.gcd := by - simp only [Int.ofNat_dvd_left] at w - induction xs with - | nil => simpa using Nat.dvd_zero c - | cons x xs ih => - simp - apply Nat.dvd_gcd - · apply w - simp - · apply ih - intro b m - apply w - exact List.mem_cons_of_mem x m - -theorem gcd_eq_iff (xs : IntList) (g : Nat) : - xs.gcd = g ↔ - (∀ {a : Int}, a ∈ xs → (g : Int) ∣ a) ∧ - (∀ (c : Nat), (∀ {a : Int}, a ∈ xs → (c : Int) ∣ a) → c ∣ g) := by - constructor - · rintro rfl - exact ⟨gcd_dvd _, dvd_gcd _⟩ - · rintro ⟨hi, hg⟩ - apply Nat.dvd_antisymm - · apply hg - intro i m - exact gcd_dvd xs m - · exact dvd_gcd xs g hi - -attribute [simp] Int.zero_dvd - -@[simp] theorem gcd_eq_zero (xs : IntList) : xs.gcd = 0 ↔ ∀ x ∈ xs, x = 0 := by - simp [gcd_eq_iff, Nat.dvd_zero] - -@[simp] theorem dot_mod_gcd_left (xs ys : IntList) : dot xs ys % xs.gcd = 0 := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => - rw [dot_cons₂, Int.add_emod, - ← Int.emod_emod_of_dvd (x * y) (gcd_cons_div_left), - ← Int.emod_emod_of_dvd (dot xs ys) (Int.ofNat_dvd.mpr gcd_cons_div_right)] - simp_all - -theorem gcd_dvd_dot_left (xs ys : IntList) : (xs.gcd : Int) ∣ dot xs ys := - Int.dvd_of_emod_eq_zero (dot_mod_gcd_left xs ys) - -@[simp] -theorem dot_eq_zero_of_left_eq_zero {xs ys : IntList} (h : ∀ x ∈ xs, x = 0) : dot xs ys = 0 := by - induction xs generalizing ys with - | nil => rfl - | cons x xs ih => - cases ys with - | nil => rfl - | cons y ys => - rw [dot_cons₂, h x (List.mem_cons_self _ _), ih (fun x m => h x (List.mem_cons_of_mem _ m)), - Int.zero_mul, Int.add_zero] - -theorem dot_sdiv_left (xs ys : IntList) {d : Int} (h : d ∣ xs.gcd) : - dot (xs.sdiv d) ys = (dot xs ys) / d := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => - have wx : d ∣ x := Int.dvd_trans h (gcd_cons_div_left) - have wxy : d ∣ x * y := Int.dvd_trans wx (Int.dvd_mul_right x y) - have w : d ∣ (IntList.gcd xs : Int) := Int.dvd_trans h (gcd_cons_div_right') - simp_all [Int.add_ediv_of_dvd_left, Int.mul_ediv_assoc'] - -/-- Apply "balanced mod" to each entry in an `IntList`. -/ -abbrev bmod (x : IntList) (m : Nat) : IntList := x.map (Int.bmod · m) - -theorem bmod_length (x : IntList) (m) : (bmod x m).length ≤ x.length := - Nat.le_of_eq (List.length_map _ _) - -/-- -The difference between the balanced mod of a dot product, -and the dot product with balanced mod applied to each entry of the left factor. --/ -abbrev bmod_dot_sub_dot_bmod (m : Nat) (a b : IntList) : Int := - (Int.bmod (dot a b) m) - dot (bmod a m) b - -theorem dvd_bmod_dot_sub_dot_bmod (m : Nat) (xs ys : IntList) : - (m : Int) ∣ bmod_dot_sub_dot_bmod m xs ys := by - dsimp [bmod_dot_sub_dot_bmod] - rw [Int.dvd_iff_emod_eq_zero] - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => - simp only [IntList.dot_cons₂, List.map_cons] - specialize ih ys - rw [Int.sub_emod, Int.bmod_emod] at ih - rw [Int.sub_emod, Int.bmod_emod, Int.add_emod, Int.add_emod (Int.bmod x m * y), - ← Int.sub_emod, ← Int.sub_sub, Int.sub_eq_add_neg, Int.sub_eq_add_neg, - Int.add_assoc (x * y % m), Int.add_comm (IntList.dot _ _ % m), ← Int.add_assoc, - Int.add_assoc, ← Int.sub_eq_add_neg, ← Int.sub_eq_add_neg, Int.add_emod, ih, Int.add_zero, - Int.emod_emod, Int.mul_emod, Int.mul_emod (Int.bmod x m), Int.bmod_emod, Int.sub_self, - Int.zero_emod] diff --git a/Std/Tactic/Omega/LinearCombo.lean b/Std/Tactic/Omega/LinearCombo.lean deleted file mode 100644 index 379dee9db5..0000000000 --- a/Std/Tactic/Omega/LinearCombo.lean +++ /dev/null @@ -1,183 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ - --- replace `IntList` with `IntDict` here to use sparse representations -import Std.Tactic.Omega.Coeffs.IntList - -/-! -# Linear combinations - -We use this data structure while processing hypotheses. - --/ - -initialize Lean.registerTraceClass `omega - -namespace Std.Tactic.Omega - -/-- Internal representation of a linear combination of atoms, and a constant term. -/ -structure LinearCombo where - /-- Constant term. -/ - const : Int := 0 - /-- Coefficients of the atoms. -/ - coeffs : Coeffs := [] -deriving DecidableEq, Repr - -namespace LinearCombo - -instance : ToString LinearCombo where - toString lc := - s!"{lc.const}{String.join <| lc.coeffs.toList.enum.map fun ⟨i, c⟩ => s!" + {c} * x{i+1}"}" - -open Lean in -instance : ToExpr LinearCombo where - toExpr lc := - (Expr.const ``LinearCombo.mk []).app (toExpr lc.const) |>.app (toExpr lc.coeffs) - toTypeExpr := .const ``LinearCombo [] - -instance : Inhabited LinearCombo := ⟨{const := 1}⟩ - -theorem ext {a b : LinearCombo} (w₁ : a.const = b.const) (w₂ : a.coeffs = b.coeffs) : - a = b := by - cases a; cases b - subst w₁; subst w₂ - congr - -/-- -Evaluate a linear combination `⟨r, [c_1, …, c_k]⟩` at values `[v_1, …, v_k]` to obtain -`r + (c_1 * x_1 + (c_2 * x_2 + ... (c_k * x_k + 0))))`. --/ -def eval (lc : LinearCombo) (values : Coeffs) : Int := - lc.const + lc.coeffs.dot values - -@[simp] theorem eval_nil : (lc : LinearCombo).eval .nil = lc.const := by - simp [eval] - -/-- The `i`-th coordinate function. -/ -def coordinate (i : Nat) : LinearCombo where - const := 0 - coeffs := Coeffs.set .nil i 1 - -@[simp] theorem coordinate_eval (i : Nat) (v : Coeffs) : - (coordinate i).eval v = v.get i := by - simp [eval, coordinate] - -theorem coordinate_eval_0 : (coordinate 0).eval (.ofList (a0 :: t)) = a0 := by simp -theorem coordinate_eval_1 : (coordinate 1).eval (.ofList (a0 :: a1 :: t)) = a1 := by simp -theorem coordinate_eval_2 : (coordinate 2).eval (.ofList (a0 :: a1 :: a2 :: t)) = a2 := by simp -theorem coordinate_eval_3 : - (coordinate 3).eval (.ofList (a0 :: a1 :: a2 :: a3 :: t)) = a3 := by simp -theorem coordinate_eval_4 : - (coordinate 4).eval (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: t)) = a4 := by simp -theorem coordinate_eval_5 : - (coordinate 5).eval (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: t)) = a5 := by simp -theorem coordinate_eval_6 : - (coordinate 6).eval (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: t)) = a6 := by simp -theorem coordinate_eval_7 : - (coordinate 7).eval - (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: a7 :: t)) = a7 := by simp -theorem coordinate_eval_8 : - (coordinate 8).eval - (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: a7 :: a8 :: t)) = a8 := by simp -theorem coordinate_eval_9 : - (coordinate 9).eval - (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: a7 :: a8 :: a9 :: t)) = a9 := by simp - -/-- Implementation of addition on `LinearCombo`. -/ -def add (l₁ l₂ : LinearCombo) : LinearCombo where - const := l₁.const + l₂.const - coeffs := l₁.coeffs + l₂.coeffs - -instance : Add LinearCombo := ⟨add⟩ - -@[simp] theorem add_const {l₁ l₂ : LinearCombo} : (l₁ + l₂).const = l₁.const + l₂.const := rfl -@[simp] theorem add_coeffs {l₁ l₂ : LinearCombo} : (l₁ + l₂).coeffs = l₁.coeffs + l₂.coeffs := rfl - -/-- Implementation of subtraction on `LinearCombo`. -/ -def sub (l₁ l₂ : LinearCombo) : LinearCombo where - const := l₁.const - l₂.const - coeffs := l₁.coeffs - l₂.coeffs - -instance : Sub LinearCombo := ⟨sub⟩ - -@[simp] theorem sub_const {l₁ l₂ : LinearCombo} : (l₁ - l₂).const = l₁.const - l₂.const := rfl -@[simp] theorem sub_coeffs {l₁ l₂ : LinearCombo} : (l₁ - l₂).coeffs = l₁.coeffs - l₂.coeffs := rfl - -/-- Implementation of negation on `LinearCombo`. -/ -def neg (lc : LinearCombo) : LinearCombo where - const := -lc.const - coeffs := -lc.coeffs - -instance : Neg LinearCombo := ⟨neg⟩ - -@[simp] theorem neg_const {l : LinearCombo} : (-l).const = -l.const := rfl -@[simp] theorem neg_coeffs {l : LinearCombo} : (-l).coeffs = -l.coeffs := rfl - -theorem sub_eq_add_neg (l₁ l₂ : LinearCombo) : l₁ - l₂ = l₁ + -l₂ := by - rcases l₁ with ⟨a₁, c₁⟩; rcases l₂ with ⟨a₂, c₂⟩ - apply ext - · simp [Int.sub_eq_add_neg] - · simp [Coeffs.sub_eq_add_neg] - -/-- Implementation of scalar multiplication of a `LinearCombo` by an `Int`. -/ -def smul (lc : LinearCombo) (i : Int) : LinearCombo where - const := i * lc.const - coeffs := lc.coeffs.smul i - -instance : HMul Int LinearCombo LinearCombo := ⟨fun i lc => lc.smul i⟩ - -@[simp] theorem smul_const {lc : LinearCombo} {i : Int} : (i * lc).const = i * lc.const := rfl -@[simp] theorem smul_coeffs {lc : LinearCombo} {i : Int} : (i * lc).coeffs = i * lc.coeffs := rfl - -@[simp] theorem add_eval (l₁ l₂ : LinearCombo) (v : Coeffs) : - (l₁ + l₂).eval v = l₁.eval v + l₂.eval v := by - rcases l₁ with ⟨r₁, c₁⟩; rcases l₂ with ⟨r₂, c₂⟩ - simp only [eval, add_const, add_coeffs, Int.add_assoc, Int.add_left_comm] - congr - exact Coeffs.dot_distrib_left c₁ c₂ v - -@[simp] theorem neg_eval (lc : LinearCombo) (v : Coeffs) : (-lc).eval v = - lc.eval v := by - rcases lc with ⟨a, coeffs⟩ - simp [eval, Int.neg_add] - -@[simp] theorem sub_eval (l₁ l₂ : LinearCombo) (v : Coeffs) : - (l₁ - l₂).eval v = l₁.eval v - l₂.eval v := by - simp [sub_eq_add_neg, Int.sub_eq_add_neg] - -@[simp] theorem smul_eval (lc : LinearCombo) (i : Int) (v : Coeffs) : - (i * lc).eval v = i * lc.eval v := by - rcases lc with ⟨a, coeffs⟩ - simp [eval, Int.mul_add] - -theorem smul_eval_comm (lc : LinearCombo) (i : Int) (v : Coeffs) : - (i * lc).eval v = lc.eval v * i := by - simp [Int.mul_comm] - -/-- -Multiplication of two linear combinations. -This is useful only if at least one of the linear combinations is constant, -and otherwise should be considered as a junk value. --/ -def mul (l₁ l₂ : LinearCombo) : LinearCombo := - l₂.const * l₁ + l₁.const * l₂ - { const := l₁.const * l₂.const } - -theorem mul_eval_of_const_left (l₁ l₂ : LinearCombo) (v : Coeffs) (w : l₁.coeffs.isZero) : - (mul l₁ l₂).eval v = l₁.eval v * l₂.eval v := by - have : Coeffs.dot l₁.coeffs v = 0 := IntList.dot_of_left_zero w - simp [mul, eval, this, Coeffs.sub_eq_add_neg, Coeffs.dot_distrib_left, Int.add_mul, Int.mul_add, - Int.mul_comm] - -theorem mul_eval_of_const_right (l₁ l₂ : LinearCombo) (v : Coeffs) (w : l₂.coeffs.isZero) : - (mul l₁ l₂).eval v = l₁.eval v * l₂.eval v := by - have : Coeffs.dot l₂.coeffs v = 0 := IntList.dot_of_left_zero w - simp [mul, eval, this, Coeffs.sub_eq_add_neg, Coeffs.dot_distrib_left, Int.add_mul, Int.mul_add, - Int.mul_comm] - -theorem mul_eval (l₁ l₂ : LinearCombo) (v : Coeffs) (w : l₁.coeffs.isZero ∨ l₂.coeffs.isZero) : - (mul l₁ l₂).eval v = l₁.eval v * l₂.eval v := by - rcases w with w | w - · rw [mul_eval_of_const_left _ _ _ w] - · rw [mul_eval_of_const_right _ _ _ w] diff --git a/Std/Tactic/Omega/Logic.lean b/Std/Tactic/Omega/Logic.lean deleted file mode 100644 index 86a695df0b..0000000000 --- a/Std/Tactic/Omega/Logic.lean +++ /dev/null @@ -1,31 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ - -import Std.Tactic.Alias - -/-! -# Specializations of basic logic lemmas - -These are useful for `omega` while constructing proofs, but not considered generally useful -so are hidden in the `Std.Tactic.Omega` namespace. - -If you find yourself needing them elsewhere, please move them first to another file. --/ - -namespace Std.Tactic.Omega - -alias ⟨and_not_not_of_not_or, _⟩ := not_or -alias ⟨Decidable.or_not_not_of_not_and, _⟩ := Decidable.not_and_iff_or_not - -alias ⟨Decidable.and_or_not_and_not_of_iff, _⟩ := Decidable.iff_iff_and_or_not_and_not - -theorem Decidable.not_iff_iff_and_not_or_not_and [Decidable a] [Decidable b] : - (¬ (a ↔ b)) ↔ (a ∧ ¬ b) ∨ ((¬ a) ∧ b) := by - by_cases b <;> simp_all [Decidable.not_not] - -alias ⟨Decidable.and_not_or_not_and_of_not_iff, _⟩ := Decidable.not_iff_iff_and_not_or_not_and - -alias ⟨Decidable.and_not_of_not_imp, _⟩ := Decidable.not_imp_iff_and_not diff --git a/Std/Tactic/Omega/MinNatAbs.lean b/Std/Tactic/Omega/MinNatAbs.lean deleted file mode 100644 index 4f9ee6cbc7..0000000000 --- a/Std/Tactic/Omega/MinNatAbs.lean +++ /dev/null @@ -1,133 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Data.List.Init.Lemmas -import Std.Data.Option.Lemmas - -/-! -# `List.nonzeroMinimum`, `List.minNatAbs`, `List.maxNatAbs` - -`List.minNatAbs` computes the minimum non-zero absolute value of a `List Int`. -This is not generally useful outside of the implementation of the `omega` tactic, -so we keep it in the `Std/Tactic/Omega` directory -(although the definitions are in the `List` namespace). - --/ - - -namespace List - -/-- -The minimum non-zero entry in a list of natural numbers, or zero if all entries are zero. - -We completely characterize the function via -`nonzeroMinimum_eq_zero_iff` and `nonzeroMinimum_eq_nonzero_iff` below. --/ -def nonzeroMinimum (xs : List Nat) : Nat := xs.filter (· ≠ 0) |>.minimum? |>.getD 0 - -open Classical in -@[simp] theorem nonzeroMinimum_eq_zero_iff {xs : List Nat} : - xs.nonzeroMinimum = 0 ↔ ∀ x ∈ xs, x = 0 := by - simp [nonzeroMinimum, Option.getD_eq_iff, minimum?_eq_none_iff, minimum?_eq_some_iff', - filter_eq_nil, mem_filter] - -theorem nonzeroMinimum_mem {xs : List Nat} (w : xs.nonzeroMinimum ≠ 0) : - xs.nonzeroMinimum ∈ xs := by - dsimp [nonzeroMinimum] at * - generalize h : (xs.filter (· ≠ 0) |>.minimum?) = m at * - match m, w with - | some (m+1), _ => simp_all [minimum?_eq_some_iff', mem_filter] - -theorem nonzeroMinimum_pos {xs : List Nat} (m : a ∈ xs) (h : a ≠ 0) : 0 < xs.nonzeroMinimum := - Nat.pos_iff_ne_zero.mpr fun w => h (nonzeroMinimum_eq_zero_iff.mp w _ m) - -theorem nonzeroMinimum_le {xs : List Nat} (m : a ∈ xs) (h : a ≠ 0) : xs.nonzeroMinimum ≤ a := by - have : (xs.filter (· ≠ 0) |>.minimum?) = some xs.nonzeroMinimum := by - have w := nonzeroMinimum_pos m h - dsimp [nonzeroMinimum] at * - generalize h : (xs.filter (· ≠ 0) |>.minimum?) = m? at * - match m?, w with - | some m?, _ => rfl - rw [minimum?_eq_some_iff'] at this - apply this.2 - simp [List.mem_filter] - exact ⟨m, h⟩ - -theorem nonzeroMinimum_eq_nonzero_iff {xs : List Nat} {y : Nat} (h : y ≠ 0) : - xs.nonzeroMinimum = y ↔ y ∈ xs ∧ (∀ x ∈ xs, y ≤ x ∨ x = 0) := by - constructor - · rintro rfl - constructor - exact nonzeroMinimum_mem h - intro y m - by_cases w : y = 0 - · right; exact w - · left; apply nonzeroMinimum_le m w - · rintro ⟨m, w⟩ - apply Nat.le_antisymm - · exact nonzeroMinimum_le m h - · have nz : xs.nonzeroMinimum ≠ 0 := by - apply Nat.pos_iff_ne_zero.mp - apply nonzeroMinimum_pos m h - specialize w (nonzeroMinimum xs) (nonzeroMinimum_mem nz) - cases w with - | inl h => exact h - | inr h => exact False.elim (nz h) - -theorem nonzeroMinimum_eq_of_nonzero {xs : List Nat} (h : xs.nonzeroMinimum ≠ 0) : - ∃ x ∈ xs, xs.nonzeroMinimum = x := - ⟨xs.nonzeroMinimum, ((nonzeroMinimum_eq_nonzero_iff h).mp rfl).1, rfl⟩ - -theorem nonzeroMinimum_le_iff {xs : List Nat} {y : Nat} : - xs.nonzeroMinimum ≤ y ↔ xs.nonzeroMinimum = 0 ∨ ∃ x ∈ xs, x ≤ y ∧ x ≠ 0 := by - refine ⟨fun h => ?_, fun h => ?_⟩ - · rw [Classical.or_iff_not_imp_right] - simp only [ne_eq, not_exists, not_and, Classical.not_not, nonzeroMinimum_eq_zero_iff] - intro w - apply nonzeroMinimum_eq_zero_iff.mp - if p : xs.nonzeroMinimum = 0 then - exact p - else - exact w _ (nonzeroMinimum_mem p) h - · match h with - | .inl h => simp [h] - | .inr ⟨x, m, le, ne⟩ => exact Nat.le_trans (nonzeroMinimum_le m ne) le - -theorem nonzeroMininum_map_le_nonzeroMinimum (f : α → β) (p : α → Nat) (q : β → Nat) (xs : List α) - (h : ∀ a, a ∈ xs → (p a = 0 ↔ q (f a) = 0)) - (w : ∀ a, a ∈ xs → p a ≠ 0 → q (f a) ≤ p a) : - ((xs.map f).map q).nonzeroMinimum ≤ (xs.map p).nonzeroMinimum := by - rw [nonzeroMinimum_le_iff] - if z : (xs.map p).nonzeroMinimum = 0 then - rw [nonzeroMinimum_eq_zero_iff] - simp_all - else - have := nonzeroMinimum_eq_of_nonzero z - simp only [mem_map] at this - obtain ⟨x, ⟨a, m, rfl⟩, eq⟩ := this - refine .inr ⟨q (f a), List.mem_map_of_mem _ (List.mem_map_of_mem _ m), ?_, ?_⟩ - · rw [eq] at z ⊢ - apply w _ m z - · rwa [Ne, ← h _ m, ← eq] - -/-- -The minimum absolute value of a nonzero entry, or zero if all entries are zero. - -We completely characterize the function via -`minNatAbs_eq_zero_iff` and `minNatAbs_eq_nonzero_iff` below. --/ -def minNatAbs (xs : List Int) : Nat := xs.map Int.natAbs |>.nonzeroMinimum - -@[simp] theorem minNatAbs_eq_zero_iff {xs : List Int} : xs.minNatAbs = 0 ↔ ∀ y ∈ xs, y = 0 := by - simp [minNatAbs] - -theorem minNatAbs_eq_nonzero_iff (xs : List Int) (w : z ≠ 0) : - xs.minNatAbs = z ↔ (∃ y ∈ xs, y.natAbs = z) ∧ (∀ y ∈ xs, z ≤ y.natAbs ∨ y = 0) := by - simp [minNatAbs, nonzeroMinimum_eq_nonzero_iff w] - -@[simp] theorem minNatAbs_nil : ([] : List Int).minNatAbs = 0 := rfl - -/-- The maximum absolute value in a list of integers. -/ -def maxNatAbs (xs : List Int) : Nat := xs.map Int.natAbs |>.maximum? |>.getD 0 diff --git a/Std/Tactic/Omega/OmegaM.lean b/Std/Tactic/Omega/OmegaM.lean deleted file mode 100644 index 5a00afef35..0000000000 --- a/Std/Tactic/Omega/OmegaM.lean +++ /dev/null @@ -1,218 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.Int -import Std.Tactic.Omega.LinearCombo -import Std.Tactic.Omega.Config -import Std.Lean.Expr - -/-! -# The `OmegaM` state monad. - -We keep track of the linear atoms (up to defeq) that have been encountered so far, -and also generate new facts as new atoms are recorded. - -The main functions are: -* `atoms : OmegaM (List Expr)` which returns the atoms recorded so far -* `lookup (e : Expr) : OmegaM (Nat × Option (HashSet Expr))` which checks if an `Expr` has - already been recorded as an atom, and records it. - `lookup` return the index in `atoms` for this `Expr`. - The `Option (HashSet Expr)` return value is `none` is the expression has been previously - recorded, and otherwise contains new facts that should be added to the `omega` problem. - * for each new atom `a` of the form `((x : Nat) : Int)`, the fact that `0 ≤ a` - * for each new atom `a` of the form `x / k`, for `k` a positive numeral, the facts that - `k * a ≤ x < k * a + k` - * for each new atom of the form `((a - b : Nat) : Int)`, the fact: - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0` - * for each new atom of the form `min a b`, the facts `min a b ≤ a` and `min a b ≤ b` - (and similarly for `max`) - * for each new atom of the form `if P then a else b`, the disjunction: - `(P ∧ (if P then a else b) = a) ∨ (¬ P ∧ (if P then a else b) = b)` -The `OmegaM` monad also keeps an internal cache of visited expressions -(not necessarily atoms, but arbitrary subexpressions of one side of a linear relation) -to reduce duplication. -The cache maps `Expr`s to pairs consisting of a `LinearCombo`, -and proof that the expression is equal to the evaluation of the `LinearCombo` at the atoms. --/ - -open Lean Meta - -namespace Std.Tactic.Omega - -/-- Context for the `OmegaM` monad, containing the user configurable options. -/ -structure Context where - /-- User configurable options for `omega`. -/ - cfg : OmegaConfig - -/-- The internal state for the `OmegaM` monad, recording previously encountered atoms. -/ -structure State where - /-- The atoms up-to-defeq encountered so far. -/ - atoms : Array Expr := #[] - -/-- An intermediate layer in the `OmegaM` monad. -/ -abbrev OmegaM' := StateRefT State (ReaderT Context MetaM) - -/-- -Cache of expressions that have been visited, and their reflection as a linear combination. --/ -def Cache : Type := HashMap Expr (LinearCombo × OmegaM' Expr) - -/-- -The `OmegaM` monad maintains two pieces of state: -* the linear atoms discovered while processing hypotheses -* a cache mapping subexpressions of one side of a linear inequality to `LinearCombo`s - (and a proof that the `LinearCombo` evaluates at the atoms to the original expression). -/ -abbrev OmegaM := StateRefT Cache OmegaM' - -/-- Run a computation in the `OmegaM` monad, starting with no recorded atoms. -/ -def OmegaM.run (m : OmegaM α) (cfg : OmegaConfig) : MetaM α := - m.run' HashMap.empty |>.run' {} { cfg } - -/-- Retrieve the user-specified configuration options. -/ -def cfg : OmegaM OmegaConfig := do pure (← read).cfg - -/-- Retrieve the list of atoms. -/ -def atoms : OmegaM (List Expr) := return (← getThe State).atoms.toList - -/-- Return the `Expr` representing the list of atoms. -/ -def atomsList : OmegaM Expr := do mkListLit (.const ``Int []) (← atoms) - -/-- Return the `Expr` representing the list of atoms as a `Coeffs`. -/ -def atomsCoeffs : OmegaM Expr := do - return .app (.const ``Coeffs.ofList []) (← atomsList) - -/-- Run an `OmegaM` computation, restoring the state afterwards depending on the result. -/ -def commitWhen (t : OmegaM (α × Bool)) : OmegaM α := do - let state ← getThe State - let cache ← getThe Cache - let (a, r) ← t - if !r then do - modifyThe State fun _ => state - modifyThe Cache fun _ => cache - pure a - -/-- -Run an `OmegaM` computation, restoring the state afterwards. --/ -def withoutModifyingState (t : OmegaM α) : OmegaM α := - commitWhen (do pure (← t, false)) - -/-- Wrapper around `Expr.nat?` that also allows `Nat.cast`. -/ -def natCast? (n : Expr) : Option Nat := - match n.getAppFnArgs with - | (``Nat.cast, #[_, _, n]) => n.nat? - | _ => n.nat? - -/-- Wrapper around `Expr.int?` that also allows `Nat.cast`. -/ -def intCast? (n : Expr) : Option Int := - match n.getAppFnArgs with - | (``Nat.cast, #[_, _, n]) => n.nat? - | _ => n.int? - -theorem ite_disjunction {α : Type u} {P : Prop} [Decidable P] {a b : α} : - (P ∧ (if P then a else b) = a) ∨ (¬ P ∧ (if P then a else b) = b) := by - by_cases P <;> simp_all - -/-- Construct the term with type hint `(Eq.refl a : a = b)`-/ -def mkEqReflWithExpectedType (a b : Expr) : MetaM Expr := do - mkExpectedTypeHint (← mkEqRefl a) (← mkEq a b) - -/-- -Analyzes a newly recorded atom, -returning a collection of interesting facts about it that should be added to the context. --/ -def analyzeAtom (e : Expr) : OmegaM (HashSet Expr) := do - match e.getAppFnArgs with - | (``Nat.cast, #[.const ``Int [], _, e']) => - -- Casts of natural numbers are non-negative. - let mut r := HashSet.empty.insert (Expr.app (.const ``Int.ofNat_nonneg []) e') - match (← cfg).splitNatSub, e'.getAppFnArgs with - | true, (``HSub.hSub, #[_, _, _, _, a, b]) => - -- `((a - b : Nat) : Int)` gives a dichotomy - r := r.insert (mkApp2 (.const ``Int.ofNat_sub_dichotomy []) a b) - | _, (``Int.natAbs, #[x]) => - r := r.insert (mkApp (.const ``Int.le_natAbs []) x) - r := r.insert (mkApp (.const ``Int.neg_le_natAbs []) x) - | _, (``Fin.val, #[n, i]) => - r := r.insert (mkApp2 (.const ``Fin.isLt []) n i) - | _, _ => pure () - return r - | (``HDiv.hDiv, #[_, _, _, _, x, k]) => match natCast? k with - | none - | some 0 => pure ∅ - | some _ => - -- `k * x/k ≤ x < k * x/k + k` - let ne_zero := mkApp3 (.const ``Ne [1]) (.const ``Int []) k (toExpr (0 : Int)) - let pos := mkApp4 (.const ``LT.lt [0]) (.const ``Int []) (.const ``Int.instLTInt []) - (toExpr (0 : Int)) k - pure <| HashSet.empty.insert - (mkApp3 (.const ``Int.mul_ediv_self_le []) x k (← mkDecideProof ne_zero)) |>.insert - (mkApp3 (.const ``Int.lt_mul_ediv_self_add []) x k (← mkDecideProof pos)) - | (``HMod.hMod, #[_, _, _, _, x, k]) => - match k.getAppFnArgs with - | (``HPow.hPow, #[_, _, _, _, b, exp]) => match natCast? b with - | none - | some 0 => pure ∅ - | some _ => - let b_pos := mkApp4 (.const ``LT.lt [0]) (.const ``Int []) (.const ``Int.instLTInt []) - (toExpr (0 : Int)) b - let pow_pos := mkApp3 (.const ``Int.pos_pow_of_pos []) b exp (← mkDecideProof b_pos) - pure <| HashSet.empty.insert - (mkApp3 (.const ``Int.emod_nonneg []) x k - (mkApp3 (.const ``Int.ne_of_gt []) k (toExpr (0 : Int)) pow_pos)) |>.insert - (mkApp3 (.const ``Int.emod_lt_of_pos []) x k pow_pos) - | (``Nat.cast, #[.const ``Int [], _, k']) => - match k'.getAppFnArgs with - | (``HPow.hPow, #[_, _, _, _, b, exp]) => match natCast? b with - | none - | some 0 => pure ∅ - | some _ => - let b_pos := mkApp4 (.const ``LT.lt [0]) (.const ``Nat []) (.const ``instLTNat []) - (toExpr (0 : Nat)) b - let pow_pos := mkApp3 (.const ``Nat.pos_pow_of_pos []) b exp (← mkDecideProof b_pos) - let cast_pos := mkApp2 (.const ``Int.ofNat_pos_of_pos []) k' pow_pos - pure <| HashSet.empty.insert - (mkApp3 (.const ``Int.emod_nonneg []) x k - (mkApp3 (.const ``Int.ne_of_gt []) k (toExpr (0 : Int)) cast_pos)) |>.insert - (mkApp3 (.const ``Int.emod_lt_of_pos []) x k cast_pos) - | _ => pure ∅ - | _ => pure ∅ - | (``Min.min, #[_, _, x, y]) => - pure <| HashSet.empty.insert (mkApp2 (.const ``Int.min_le_left []) x y) |>.insert - (mkApp2 (.const ``Int.min_le_right []) x y) - | (``Max.max, #[_, _, x, y]) => - pure <| HashSet.empty.insert (mkApp2 (.const ``Int.le_max_left []) x y) |>.insert - (mkApp2 (.const ``Int.le_max_right []) x y) - | (``ite, #[α, i, dec, t, e]) => - if α == (.const ``Int []) then - pure <| HashSet.empty.insert <| mkApp5 (.const ``ite_disjunction [0]) α i dec t e - else - pure {} - | _ => pure ∅ - -/-- -Look up an expression in the atoms, recording it if it has not previously appeared. - -Return its index, and, if it is new, a collection of interesting facts about the atom. -* for each new atom `a` of the form `((x : Nat) : Int)`, the fact that `0 ≤ a` -* for each new atom `a` of the form `x / k`, for `k` a positive numeral, the facts that - `k * a ≤ x < k * a + k` -* for each new atom of the form `((a - b : Nat) : Int)`, the fact: - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0` --/ -def lookup (e : Expr) : OmegaM (Nat × Option (HashSet Expr)) := do - let c ← getThe State - for h : i in [:c.atoms.size] do - if ← isDefEq e c.atoms[i] then - return (i, none) - trace[omega] "New atom: {e}" - let facts ← analyzeAtom e - if ← isTracingEnabledFor `omega then - unless facts.isEmpty do - trace[omega] "New facts: {← facts.toList.mapM fun e => inferType e}" - let i ← modifyGetThe State fun c => (c.atoms.size, { c with atoms := c.atoms.push e }) - return (i, some facts) - -end Omega diff --git a/Std/Tactic/Relation/Rfl.lean b/Std/Tactic/Relation/Rfl.lean index fb14972946..13a1c7d4c4 100644 --- a/Std/Tactic/Relation/Rfl.lean +++ b/Std/Tactic/Relation/Rfl.lean @@ -3,8 +3,8 @@ Copyright (c) 2022 Newell Jensen. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Newell Jensen, Thomas Murrills -/ -import Std.Lean.Elab.Tactic import Lean.Meta.Tactic.Apply +import Lean.Elab.Tactic.Basic /-! # `rfl` tactic extension for reflexive relations diff --git a/test/omega/benchmark.lean b/test/omega/benchmark.lean index 0e6f2b2d15..78a1a6fdc8 100644 --- a/test/omega/benchmark.lean +++ b/test/omega/benchmark.lean @@ -1,4 +1,3 @@ -import Std.Tactic.Omega.Frontend /-! # Benchmarking the `omega` tactic diff --git a/test/omega/examples.lean b/test/omega/examples.lean index 3f530b0e19..8e6603435e 100644 --- a/test/omega/examples.lean +++ b/test/omega/examples.lean @@ -1,4 +1,3 @@ -import Std.Tactic.Omega.Frontend -- Turn on `trace.omega` to get detailed information about the processing of hypotheses, -- and the justification of the contradiction found. diff --git a/test/omega/test.lean b/test/omega/test.lean index 095e8f110a..3e136fb1fa 100644 --- a/test/omega/test.lean +++ b/test/omega/test.lean @@ -1,6 +1,3 @@ -import Std.Tactic.Omega.Frontend - -open Std.Tactic.Omega example : True := by fail_if_success omega From 3e4027b1ec77c13569f4ec1f45cfe2b253492c80 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 19 Feb 2024 22:59:00 +1100 Subject: [PATCH 066/213] fixes --- Std/Data/HashMap/Basic.lean | 2 +- Std/Data/HashMap/WF.lean | 8 ++++---- Std/Data/List/Basic.lean | 8 ++++++-- Std/Data/Range/Lemmas.lean | 4 ++-- Std/Lean/Meta/Basic.lean | 7 ------- Std/Tactic/SolveByElim/Backtrack.lean | 1 + 6 files changed, 14 insertions(+), 16 deletions(-) diff --git a/Std/Data/HashMap/Basic.lean b/Std/Data/HashMap/Basic.lean index 5a41196e0f..4f9317d128 100644 --- a/Std/Data/HashMap/Basic.lean +++ b/Std/Data/HashMap/Basic.lean @@ -203,7 +203,7 @@ Applies `f` to each key-value pair `a, b` in the map. If it returns `some c` the have : m'.1.size > 0 := by have := Array.size_mapM (m := StateT (ULift Nat) Id) (go .nil) m.buckets.1 simp [SatisfiesM_StateT_eq, SatisfiesM_Id_eq] at this - simp [this, Id.run, StateT.run, m.2.2] + simp [this, Id.run, StateT.run, m.2.2, m'] ⟨m'.2.1, m'.1, this⟩ where /-- Inner loop of `filterMap`. Note that this reverses the bucket lists, diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index 06378b19da..bd77e10f83 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -311,7 +311,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable let g₁ (l : AssocList α β) := l.toList.filterMap (fun x => (f x.1 x.2).map (x.1, ·)) have H1 (l n acc) : filterMap.go f acc l n = (((g₁ l).reverse ++ acc.toList).toAssocList, ⟨n.1 + (g₁ l).length⟩) := by - induction l generalizing n acc with simp [filterMap.go, *] + induction l generalizing n acc with simp [filterMap.go, g₁, *] | cons a b l => match f a b with | none => rfl | some c => simp; rw [Nat.add_right_comm]; rfl @@ -322,7 +322,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable (l.map g, ⟨n.1 + .sum ((l.map g).map (·.toList.length))⟩) := by induction l generalizing n with | nil => rfl - | cons l L IH => simp [bind, StateT.bind, IH, H1, Nat.add_assoc]; rfl + | cons l L IH => simp [bind, StateT.bind, IH, H1, Nat.add_assoc, g]; rfl have H3 (l : List _) : (l.filterMap (fun (a, b) => (f a b).map (a, ·))).map (fun a => a.fst) |>.Sublist (l.map (·.1)) := by @@ -335,7 +335,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable suffices ∀ bk sz (h : 0 < bk.length), m.buckets.val.mapM (m := M) (filterMap.go f .nil) ⟨0⟩ = (⟨bk⟩, ⟨sz⟩) → WF ⟨sz, ⟨bk⟩, h⟩ from this _ _ _ rfl - simp [Array.mapM_eq_mapM_data, bind, StateT.bind, H2] + simp [Array.mapM_eq_mapM_data, bind, StateT.bind, H2, g] intro bk sz h e'; cases e' refine .mk (by simp [Buckets.size]) ⟨?_, fun i h => ?_⟩ · simp only [List.forall_mem_map_iff, List.toList_toAssocList] @@ -343,7 +343,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable have := H.out.2.1 _ h rw [← List.pairwise_map (R := (¬ · == ·))] at this ⊢ exact this.sublist (H3 l.toList) - · simp [Array.getElem_eq_data_get] at h ⊢ + · simp only [Array.getElem_eq_data_get] at h ⊢ have := H.out.2.2 _ h; simp [AssocList.All] at this ⊢ rintro _ _ h' _ _ rfl; exact this _ h' diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index 02f62b8ed4..fae17b3a3b 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -199,8 +199,12 @@ def enumFromTR (n : Nat) (l : List α) : List (Nat × α) := | [], n => rfl | a::as, n => by rw [← show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as] - simp [enumFrom] - rw [Array.foldr_eq_foldr_data]; simp [go] + simp [enumFrom, f] + -- Note: there was a regression here caused by leanprover/lean4#3388. + -- Previously the `go` was in the `simp`, not the `rw`, but currently `simp` can't use it. + -- A fix is in the works. + rw [Array.foldr_eq_foldr_data, go] + simp theorem replicateTR_loop_eq : ∀ n, replicateTR.loop a n acc = replicate n a ++ acc | 0 => rfl diff --git a/Std/Data/Range/Lemmas.lean b/Std/Data/Range/Lemmas.lean index 76bc082c3c..5c2dcc900b 100644 --- a/Std/Data/Range/Lemmas.lean +++ b/Std/Data/Range/Lemmas.lean @@ -58,7 +58,7 @@ theorem forIn'_eq_forIn_range' [Monad m] (r : Std.Range) suffices ∀ H, forIn' [start:stop:step] init f = forIn (L.pmap Subtype.mk H) init f' from this _ intro H; dsimp only [forIn', Range.forIn'] if h : start < stop then - simp [numElems, Nat.not_le.2 h]; split + simp [numElems, Nat.not_le.2 h, L]; split · subst step suffices ∀ n H init, forIn'.loop start stop 0 f n start (Nat.le_refl _) init = @@ -88,7 +88,7 @@ theorem forIn'_eq_forIn_range' [Monad m] (r : Std.Range) have := h2 0; simp at this rw [forIn'.loop]; simp [List.forIn, this, ih]; rfl else - simp [List.range', h, numElems_stop_le_start ⟨start, stop, step⟩ (Nat.not_lt.1 h)] + simp [List.range', h, numElems_stop_le_start ⟨start, stop, step⟩ (Nat.not_lt.1 h), L] cases stop <;> unfold forIn'.loop <;> simp [List.forIn', h] theorem forIn_eq_forIn_range' [Monad m] (r : Std.Range) diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index f41ad0ed91..8bdaecf130 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -285,13 +285,6 @@ where | none => acc.modify fun s => s.push goal | some goals => goals.forM (go acc) -/-- Return local hypotheses which are not "implementation detail", as `Expr`s. -/ -def getLocalHyps [Monad m] [MonadLCtx m] : m (Array Expr) := do - let mut hs := #[] - for d in ← getLCtx do - if !d.isImplementationDetail then hs := hs.push d.toExpr - return hs - /-- Given a monadic function `F` that takes a type and a term of that type and produces a new term, lifts this to the monadic function that opens a `∀` telescope, applies `F` to the body, diff --git a/Std/Tactic/SolveByElim/Backtrack.lean b/Std/Tactic/SolveByElim/Backtrack.lean index 588afcfd79..93b03ed4e8 100644 --- a/Std/Tactic/SolveByElim/Backtrack.lean +++ b/Std/Tactic/SolveByElim/Backtrack.lean @@ -6,6 +6,7 @@ Authors: Scott Morrison import Std.Data.List.Basic import Std.Lean.Except import Std.Lean.Meta.Basic +import Std.Lean.Meta.Iterator /-! # `backtrack` From 0fc11f3a4146199b81b1078d949c5a693467fe11 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 19 Feb 2024 23:02:21 +1100 Subject: [PATCH 067/213] fix --- Std/Data/HashMap/WF.lean | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index bd77e10f83..21423c8598 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -343,9 +343,12 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable have := H.out.2.1 _ h rw [← List.pairwise_map (R := (¬ · == ·))] at this ⊢ exact this.sublist (H3 l.toList) - · simp only [Array.getElem_eq_data_get] at h ⊢ - have := H.out.2.2 _ h; simp [AssocList.All] at this ⊢ - rintro _ _ h' _ _ rfl; exact this _ h' + · simp only [Array.size_mk, List.length_map, Array.data_length, Array.getElem_eq_data_get, + List.get_map] at h ⊢ + have := H.out.2.2 _ h + simp [AssocList.All] at this ⊢ + rintro _ _ h' _ _ rfl + exact this _ h' end Imp From 5cb2a5897386f5c903f52e0ccbe51a8983e09c10 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 19 Feb 2024 23:06:15 +1100 Subject: [PATCH 068/213] fixes --- Std/Data/HashMap/WF.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index 21423c8598..0688ad3417 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -346,7 +346,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable · simp only [Array.size_mk, List.length_map, Array.data_length, Array.getElem_eq_data_get, List.get_map] at h ⊢ have := H.out.2.2 _ h - simp [AssocList.All] at this ⊢ + simp [AssocList.All, g₁] at this ⊢ rintro _ _ h' _ _ rfl exact this _ h' From afdc0885c6a787112fdbaf46d170601afb6775a2 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 19 Feb 2024 23:12:55 +1100 Subject: [PATCH 069/213] Delete --- Std/Data/Array/Init/Lemmas.lean | 1 - Std/Data/List.lean | 1 - Std/Data/List/Count.lean | 1 - Std/Data/List/Init/Attach.lean | 1 - Std/Data/List/Init/Lemmas.lean | 24 ------------------------ 5 files changed, 28 deletions(-) delete mode 100644 Std/Data/List/Init/Lemmas.lean diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index 4fc2cbd60c..8d0ed724e4 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Bool -import Std.Data.List.Init.Lemmas import Std.Classes.SatisfiesM /-! diff --git a/Std/Data/List.lean b/Std/Data/List.lean index 137c762db9..4165ebcfe7 100644 --- a/Std/Data/List.lean +++ b/Std/Data/List.lean @@ -1,7 +1,6 @@ import Std.Data.List.Basic import Std.Data.List.Count import Std.Data.List.Init.Attach -import Std.Data.List.Init.Lemmas import Std.Data.List.Lemmas import Std.Data.List.Pairwise import Std.Data.List.Perm diff --git a/Std/Data/List/Count.lean b/Std/Data/List/Count.lean index a50809b5cb..0087e86007 100644 --- a/Std/Data/List/Count.lean +++ b/Std/Data/List/Count.lean @@ -5,7 +5,6 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M -/ import Std.Data.List.Basic import Std.Data.List.Lemmas -import Std.Data.List.Init.Lemmas /-! # Counting in lists diff --git a/Std/Data/List/Init/Attach.lean b/Std/Data/List/Init/Attach.lean index 241c72ed3f..63ebca89df 100644 --- a/Std/Data/List/Init/Attach.lean +++ b/Std/Data/List/Init/Attach.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Data.List.Init.Lemmas namespace List diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean deleted file mode 100644 index e060dba28a..0000000000 --- a/Std/Data/List/Init/Lemmas.lean +++ /dev/null @@ -1,24 +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 --/ - -namespace List - -open Nat - -/-! -# Bootstrapping theorems for lists - -These are theorems used in the definitions of `Std.Data.List.Basic` and tactics. -New theorems should be added to `Std.Data.List.Lemmas` if they are not needed by the bootstrap. --/ - --- A specialization of `minimum?_eq_some_iff` to Nat. -theorem minimum?_eq_some_iff' {xs : List Nat} : - xs.minimum? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, a ≤ b) := - minimum?_eq_some_iff - (le_refl := Nat.le_refl) - (min_eq_or := fun _ _ => Nat.min_def .. ▸ by split <;> simp) - (le_min_iff := fun _ _ _ => Nat.le_min) From 1586642b4218ab894f2a0e8d411844aa06be6d89 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 19 Feb 2024 23:22:55 +1100 Subject: [PATCH 070/213] remove imports --- Std/Data/BitVec/Basic.lean | 1 - Std/Data/Fin/Lemmas.lean | 1 - Std/Data/Nat/Bitwise.lean | 4 ++-- 3 files changed, 2 insertions(+), 4 deletions(-) diff --git a/Std/Data/BitVec/Basic.lean b/Std/Data/BitVec/Basic.lean index ee0e1d5459..6c8d2f2944 100644 --- a/Std/Data/BitVec/Basic.lean +++ b/Std/Data/BitVec/Basic.lean @@ -4,7 +4,6 @@ institutional affiliations. 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 -/ -import Std.Data.Fin.Basic import Std.Data.Nat.Bitwise import Std.Tactic.Alias diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 0d44305b49..6fd2666be0 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Fin.Basic -import Std.Data.Nat.Lemmas import Std.Tactic.Simpa import Std.Tactic.NormCast.Lemmas import Std.Tactic.SimpTrace diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean index 60f2ead06b..ddf2f7c112 100644 --- a/Std/Data/Nat/Bitwise.lean +++ b/Std/Data/Nat/Bitwise.lean @@ -10,9 +10,9 @@ This module defines properties of the bitwise operations on Natural numbers. It is primarily intended to support the bitvector library. -/ -import Std.Data.Bool -import Std.Data.Nat.Lemmas +import Std.Data.Nat.Basic import Std.Tactic.Simpa +import Std.Tactic.Basic namespace Nat From c8ada7a9a1bb1a8ce4db126e3a1a498079f8b156 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 20 Feb 2024 12:34:47 +1100 Subject: [PATCH 071/213] reduce imports --- Std/Tactic/GuardMsgs.lean | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Std/Tactic/GuardMsgs.lean b/Std/Tactic/GuardMsgs.lean index f425891424..f0f3ab7568 100644 --- a/Std/Tactic/GuardMsgs.lean +++ b/Std/Tactic/GuardMsgs.lean @@ -3,9 +3,7 @@ Copyright (c) 2023 Kyle Miller. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kyle Miller -/ -import Lean.Elab.Command -import Lean.Meta.Tactic.TryThis -import Std.CodeAction.Basic +import Std.CodeAction.Attr import Std.Lean.Position /-! `#guard_msgs` command for testing commands From 6d2ee66e748b09b827f7df9f33a5065786c22865 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Tue, 20 Feb 2024 09:14:58 +0000 Subject: [PATCH 072/213] chore: bump to nightly-2024-02-20 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 1fbcac3216..0e72c49726 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-19 +leanprover/lean4:nightly-2024-02-20 From 21e80abfc64b6872740daf3e06a60f386aade64d Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 20 Feb 2024 22:13:21 +1100 Subject: [PATCH 073/213] adaptations for nightly-2024-02-20 --- Std.lean | 4 - Std/Classes/Order.lean | 1 - Std/Classes/SetNotation.lean | 28 -- Std/Data/Array/Lemmas.lean | 1 - Std/Data/BitVec.lean | 4 - Std/Data/BitVec/Basic.lean | 533 --------------------- Std/Data/BitVec/Bitblast.lean | 172 ------- Std/Data/BitVec/Folds.lean | 57 --- Std/Data/BitVec/Lemmas.lean | 522 -------------------- Std/Data/BitVec/Simprocs.lean | 283 ----------- Std/Data/Fin/Lemmas.lean | 822 +------------------------------- Std/Data/Int/Gcd.lean | 1 - Std/Data/List/Lemmas.lean | 1 - Std/Data/Nat.lean | 1 - Std/Data/Nat/Basic.lean | 9 - Std/Data/Nat/Bitwise.lean | 497 ------------------- Std/Data/Rat/Lemmas.lean | 1 - Std/Data/String/Lemmas.lean | 1 - Std/Lean/Parser.lean | 21 - Std/Tactic/NormCast.lean | 318 ------------ Std/Tactic/NormCast/Ext.lean | 219 --------- Std/Tactic/NormCast/Lemmas.lean | 18 - Std/Tactic/Simpa.lean | 117 ----- test/simpa.lean | 1 - 24 files changed, 1 insertion(+), 3631 deletions(-) delete mode 100644 Std/Classes/SetNotation.lean delete mode 100644 Std/Data/BitVec/Basic.lean delete mode 100644 Std/Data/BitVec/Bitblast.lean delete mode 100644 Std/Data/BitVec/Folds.lean delete mode 100644 Std/Data/BitVec/Simprocs.lean delete mode 100644 Std/Data/Nat/Bitwise.lean delete mode 100644 Std/Tactic/NormCast/Ext.lean delete mode 100644 Std/Tactic/NormCast/Lemmas.lean delete mode 100644 Std/Tactic/Simpa.lean diff --git a/Std.lean b/Std.lean index 1b2cb1e4d1..f10aba2351 100644 --- a/Std.lean +++ b/Std.lean @@ -3,7 +3,6 @@ import Std.Classes.Cast import Std.Classes.Order import Std.Classes.RatCast import Std.Classes.SatisfiesM -import Std.Classes.SetNotation import Std.CodeAction import Std.CodeAction.Attr import Std.CodeAction.Basic @@ -97,8 +96,6 @@ import Std.Tactic.Lint.Simp import Std.Tactic.Lint.TypeClass import Std.Tactic.NoMatch import Std.Tactic.NormCast -import Std.Tactic.NormCast.Ext -import Std.Tactic.NormCast.Lemmas import Std.Tactic.OpenPrivate import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents @@ -108,7 +105,6 @@ import Std.Tactic.Relation.Symm import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm import Std.Tactic.SimpTrace -import Std.Tactic.Simpa import Std.Tactic.SolveByElim import Std.Tactic.SolveByElim.Backtrack import Std.Tactic.SqueezeScope diff --git a/Std/Classes/Order.lean b/Std/Classes/Order.lean index f92e96c0dd..fcf0e23bf0 100644 --- a/Std/Classes/Order.lean +++ b/Std/Classes/Order.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.Simpa /-! ## Ordering -/ diff --git a/Std/Classes/SetNotation.lean b/Std/Classes/SetNotation.lean deleted file mode 100644 index 977e1e3df3..0000000000 --- a/Std/Classes/SetNotation.lean +++ /dev/null @@ -1,28 +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 --/ - -/-- -`{ a, b, c }` is a set with elements `a`, `b`, and `c`. - -This notation works for all types that implement `Insert` and `Singleton`. --/ -syntax "{" term,+ "}" : term - -macro_rules - | `({$x:term}) => `(singleton $x) - | `({$x:term, $xs:term,*}) => `(insert $x {$xs:term,*}) - -/-- Unexpander for the `{ x }` notation. -/ -@[app_unexpander singleton] -def singletonUnexpander : Lean.PrettyPrinter.Unexpander - | `($_ $a) => `({ $a:term }) - | _ => throw () - -/-- Unexpander for the `{ x, y, ... }` notation. -/ -@[app_unexpander insert] -def insertUnexpander : Lean.PrettyPrinter.Unexpander - | `($_ $a { $ts:term,* }) => `({$a:term, $ts,*}) - | _ => throw () diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 40a055b66b..330f553080 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -9,7 +9,6 @@ import Std.Data.List.Lemmas import Std.Data.Array.Init.Lemmas import Std.Data.Array.Basic import Std.Tactic.SeqFocus -import Std.Tactic.Simpa import Std.Util.ProofWanted local macro_rules | `($x[$i]'$h) => `(getElem $x $i $h) diff --git a/Std/Data/BitVec.lean b/Std/Data/BitVec.lean index 3448b2d7c2..2df74a3107 100644 --- a/Std/Data/BitVec.lean +++ b/Std/Data/BitVec.lean @@ -1,5 +1 @@ -import Std.Data.BitVec.Basic -import Std.Data.BitVec.Bitblast -import Std.Data.BitVec.Folds import Std.Data.BitVec.Lemmas -import Std.Data.BitVec.Simprocs diff --git a/Std/Data/BitVec/Basic.lean b/Std/Data/BitVec/Basic.lean deleted file mode 100644 index 6c8d2f2944..0000000000 --- a/Std/Data/BitVec/Basic.lean +++ /dev/null @@ -1,533 +0,0 @@ -/- -Copyright (c) 2022 by the authors listed in the file AUTHORS and their -institutional affiliations. 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 --/ -import Std.Data.Nat.Bitwise -import Std.Tactic.Alias - -namespace Std - -/-! -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). -of SMT-LIBv2. --/ - -/-- -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) - deriving DecidableEq - -namespace BitVec - -/-- `cast eq i` embeds `i` into an equal `BitVec` type. -/ -@[inline] def cast (eq : n = m) (i : BitVec n) : BitVec m := - .ofFin (Fin.cast (congrArg _ eq) i.toFin) - -/-- The `BitVec` with value `i mod 2^n`. Treated as an operation on bitvectors, -this is truncation of the high bits when downcasting and zero-extension when upcasting. -/ -protected def ofNat (n : Nat) (i : Nat) : BitVec n where - toFin := Fin.ofNat' i (Nat.two_pow_pos n) - -instance : NatCast (BitVec w) := ⟨BitVec.ofNat w⟩ - -/-- Given a bitvector `a`, return the underlying `Nat`. This is O(1) because `BitVec` is a -(zero-cost) wrapper around a `Nat`. -/ -protected def toNat (a : BitVec n) : Nat := a.toFin.val - -/-- Return the bound in terms of toNat. -/ -theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt - -/-- Return the `i`-th least significant bit or `false` if `i ≥ w`. -/ -@[inline] def getLsb (x : BitVec w) (i : Nat) : Bool := x.toNat.testBit i - -/-- Return the `i`-th most significant bit or `false` if `i ≥ w`. -/ -@[inline] def getMsb (x : BitVec w) (i : Nat) : Bool := i < w && getLsb x (w-1-i) - -/-- Return most-significant bit in bitvector. -/ -@[inline] protected def msb (a : BitVec n) : Bool := getMsb a 0 - -/-- Interpret the bitvector as an integer stored in two's complement form. -/ -protected def toInt (a : BitVec n) : Int := - if a.msb then Int.ofNat a.toNat - Int.ofNat (2^n) else a.toNat - -/-- Return a bitvector `0` of size `n`. This is the bitvector with all zero bits. -/ -protected def zero (n : Nat) : BitVec n := ⟨0, Nat.two_pow_pos n⟩ - -instance : Inhabited (BitVec n) where default := .zero n - -instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i - -/-- Notation for bit vector literals. `i#n` is a shorthand for `BitVec.ofNat n i`. -/ -scoped syntax:max term:max noWs "#" noWs term:max : term -macro_rules | `($i#$n) => `(BitVec.ofNat $n $i) - -/- Support for `i#n` notation in patterns. -/ -attribute [match_pattern] BitVec.ofNat - -/-- Unexpander for bit vector literals. -/ -@[app_unexpander BitVec.ofNat] def unexpandBitVecOfNat : Lean.PrettyPrinter.Unexpander - | `($(_) $n $i) => `($i#$n) - | _ => throw () - -/-- Convert bitvector into a fixed-width hex number. -/ -protected def toHex {n : Nat} (x : BitVec n) : String := - let s := (Nat.toDigits 16 x.toNat).asString - let t := (List.replicate ((n+3) / 4 - s.length) '0').asString - t ++ s - -instance : Repr (BitVec n) where reprPrec a _ := "0x" ++ (a.toHex : Format) ++ "#" ++ repr n - -instance : ToString (BitVec n) where toString a := toString (repr a) - -/-- Theorem for normalizing the bit vector literal representation. -/ --- TODO: This needs more usage data to assess which direction the simp should go. -@[simp] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = BitVec.ofNat n i := rfl -@[simp] theorem natCast_eq_ofNat : Nat.cast x = x#w := rfl - -/-- -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 where toFin := x.toFin + y.toFin -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 where toFin := x.toFin - y.toFin -instance : Sub (BitVec n) := ⟨BitVec.sub⟩ - -/-- -Negation for bit vectors. This can be interpreted as either signed or unsigned negation -modulo `2^n`. - -SMT-Lib name: `bvneg`. --/ -protected def neg (x : BitVec n) : BitVec n := .sub 0 x -instance : Neg (BitVec n) := ⟨.neg⟩ - -/-- Bit vector of size `n` where all bits are `1`s -/ -def allOnes (n : Nat) : BitVec n := -1 - -/-- -Return the absolute value of a signed bitvector. --/ -protected def abs (s : BitVec n) : BitVec n := if s.msb then .neg s else s - -/-- -Multiplication for bit vectors. This can be interpreted as either signed or unsigned negation -modulo `2^n`. - -SMT-Lib name: `bvmul`. --/ -protected def mul (x y : BitVec n) : BitVec n := ofFin <| x.toFin * y.toFin -instance : Mul (BitVec n) := ⟨.mul⟩ - -/-- -Unsigned division for bit vectors using the Lean convention where division by zero returns zero. --/ -def udiv (x y : BitVec n) : BitVec n := ofFin <| x.toFin / y.toFin -instance : Div (BitVec n) := ⟨.udiv⟩ - -/-- -Unsigned modulo for bit vectors. - -SMT-Lib name: `bvurem`. --/ -def umod (x y : BitVec n) : BitVec n := ofFin <| x.toFin % y.toFin -instance : Mod (BitVec n) := ⟨.umod⟩ - -/-- -Unsigned division for bit vectors using the -[SMT-Lib convention](http://smtlib.cs.uiowa.edu/theories-FixedSizeBitVectors.shtml) -where division by zero returns the `allOnes` bitvector. - -SMT-Lib name: `bvudiv`. --/ -def smtUDiv (x y : BitVec n) : BitVec n := if y = 0 then -1 else .udiv x y - -/-- -Signed t-division for bit vectors using the Lean convention where division -by zero returns zero. - -```lean -sdiv 7#4 2 = 3#4 -sdiv (-9#4) 2 = -4#4 -sdiv 5#4 -2 = -2#4 -sdiv (-7#4) (-2) = 3#4 -``` --/ -def sdiv (s t : BitVec n) : BitVec n := - match s.msb, t.msb with - | false, false => udiv s t - | false, true => .neg (udiv s (.neg t)) - | true, false => .neg (udiv (.neg s) t) - | true, true => udiv (.neg s) (.neg t) - -/-- -Signed division for bit vectors using SMTLIB rules for division by zero. - -Specifically, `smtSDiv x 0 = if x >= 0 then -1 else 1` - -SMT-Lib name: `bvsdiv`. --/ -def smtSDiv (s t : BitVec n) : BitVec n := - match s.msb, t.msb with - | false, false => smtUDiv s t - | false, true => .neg (smtUDiv s (.neg t)) - | true, false => .neg (smtUDiv (.neg s) t) - | true, true => smtUDiv (.neg s) (.neg t) - -/-- -Remainder for signed division rounding to zero. - -SMT_Lib name: `bvsrem`. --/ -def srem (s t : BitVec n) : BitVec n := - match s.msb, t.msb with - | false, false => umod s t - | false, true => umod s (.neg t) - | true, false => .neg (umod (.neg s) t) - | true, true => .neg (umod (.neg s) (.neg t)) - -/-- -Remainder for signed division rounded to negative infinity. - -SMT_Lib name: `bvsmod`. --/ -def smod (s t : BitVec m) : BitVec m := - match s.msb, t.msb with - | false, false => .umod s t - | false, true => - let u := .umod s (.neg t) - (if u = BitVec.ofNat m 0 then u else .add u t) - | true, false => - let u := .umod (.neg s) t - (if u = BitVec.ofNat m 0 then u else .sub t u) - | true, true => .neg (.umod (.neg s) (.neg t)) - -/-- -Unsigned less-than for bit vectors. - -SMT-Lib name: `bvult`. --/ -protected def ult (x y : BitVec n) : Bool := x.toFin < y.toFin -instance : LT (BitVec n) where lt x y := x.toFin < y.toFin -instance (x y : BitVec n) : Decidable (x < y) := - inferInstanceAs (Decidable (x.toFin < y.toFin)) - -/-- -Unsigned less-than-or-equal-to for bit vectors. - -SMT-Lib name: `bvule`. --/ -protected def ule (x y : BitVec n) : Bool := x.toFin ≤ y.toFin - -instance : LE (BitVec n) where le x y := x.toFin ≤ y.toFin -instance (x y : BitVec n) : Decidable (x ≤ y) := - inferInstanceAs (Decidable (x.toFin ≤ y.toFin)) - -/-- -Signed less-than for bit vectors. - -```lean -BitVec.slt 6#4 7 = true -BitVec.slt 7#4 8 = false -``` -SMT-Lib name: `bvslt`. --/ -protected def slt (x y : BitVec n) : Bool := x.toInt < y.toInt - -/-- -Signed less-than-or-equal-to for bit vectors. - -SMT-Lib name: `bvsle`. --/ -protected def sle (x y : BitVec n) : Bool := x.toInt ≤ y.toInt - -/-- -Bitwise AND for bit vectors. - -```lean -0b1010#4 &&& 0b0110#4 = 0b0010#4 -``` - -SMT-Lib name: `bvand`. --/ -protected def and (x y : BitVec n) : BitVec n where toFin := - ⟨x.toNat &&& y.toNat, Nat.and_lt_two_pow x.toNat y.isLt⟩ -instance : AndOp (BitVec w) := ⟨.and⟩ - -/-- -Bitwise OR for bit vectors. - -```lean -0b1010#4 ||| 0b0110#4 = 0b1110#4 -``` - -SMT-Lib name: `bvor`. --/ -protected def or (x y : BitVec n) : BitVec n where toFin := - ⟨x.toNat ||| y.toNat, Nat.or_lt_two_pow x.isLt y.isLt⟩ -instance : OrOp (BitVec w) := ⟨.or⟩ - -/-- - Bitwise XOR for bit vectors. - -```lean -0b1010#4 ^^^ 0b0110#4 = 0b1100#4 -``` - -SMT-Lib name: `bvxor`. --/ -protected def xor (x y : BitVec n) : BitVec n where toFin := - ⟨x.toNat ^^^ y.toNat, Nat.xor_lt_two_pow x.isLt y.isLt⟩ -instance : Xor (BitVec w) := ⟨.xor⟩ - -/-- -Bitwise NOT for bit vectors. - -```lean -~~~(0b0101#4) == 0b1010 -``` -SMT-Lib name: `bvnot`. --/ -protected def not (x : BitVec n) : BitVec n := - allOnes n ^^^ x -instance : Complement (BitVec w) := ⟨.not⟩ - -/-- The `BitVec` with value `(2^n + (i mod 2^n)) mod 2^n`. -/ -protected def ofInt (n : Nat) (i : Int) : BitVec n := - match i with - | Int.ofNat a => .ofNat n a - | Int.negSucc a => ~~~.ofNat n a - -instance : IntCast (BitVec w) := ⟨BitVec.ofInt w⟩ - -/-- -Left shift for bit vectors. The low bits are filled with zeros. As a numeric operation, this is -equivalent to `a * 2^s`, modulo `2^n`. - -SMT-Lib name: `bvshl` except this operator uses a `Nat` shift value. --/ -protected def shiftLeft (a : BitVec n) (s : Nat) : BitVec n := .ofNat n (a.toNat <<< s) -instance : HShiftLeft (BitVec w) Nat (BitVec w) := ⟨.shiftLeft⟩ - -/-- -(Logical) right shift for bit vectors. The high bits are filled with zeros. -As a numeric operation, this is equivalent to `a / 2^s`, rounding down. - -SMT-Lib name: `bvlshr` except this operator uses a `Nat` shift value. --/ -def ushiftRight (a : BitVec n) (s : Nat) : BitVec n := - ⟨a.toNat >>> s, by - let ⟨a, lt⟩ := a - simp only [BitVec.toNat, Nat.shiftRight_eq_div_pow, Nat.div_lt_iff_lt_mul (Nat.two_pow_pos s)] - rw [←Nat.mul_one a] - exact Nat.mul_lt_mul_of_lt_of_le' lt (Nat.two_pow_pos s) (Nat.le_refl 1)⟩ - -instance : HShiftRight (BitVec w) Nat (BitVec w) := ⟨.ushiftRight⟩ - -/-- -Arithmetic right shift for bit vectors. The high bits are filled with the -most-significant bit. -As a numeric operation, this is equivalent to `a.toInt >>> s`. - -SMT-Lib name: `bvashr` except this operator uses a `Nat` shift value. --/ -def sshiftRight (a : BitVec n) (s : Nat) : BitVec n := .ofInt n (a.toInt >>> s) - -instance {n} : HShiftLeft (BitVec m) (BitVec n) (BitVec m) := ⟨fun x y => x <<< y.toNat⟩ -instance {n} : HShiftRight (BitVec m) (BitVec n) (BitVec m) := ⟨fun x y => x >>> y.toNat⟩ - -/-- -Rotate left for bit vectors. All the bits of `x` are shifted to higher positions, with the top `n` -bits wrapping around to fill the low bits. - -```lean -rotateLeft 0b0011#4 3 = 0b1001 -``` -SMT-Lib name: `rotate_left` except this operator uses a `Nat` shift amount. --/ -def rotateLeft (x : BitVec w) (n : Nat) : BitVec w := x <<< n ||| x >>> (w - n) - -/-- -Rotate right for bit vectors. All the bits of `x` are shifted to lower positions, with the -bottom `n` bits wrapping around to fill the high bits. - -```lean -rotateRight 0b01001#5 1 = 0b10100 -``` -SMT-Lib name: `rotate_right` except this operator uses a `Nat` shift amount. --/ -def rotateRight (x : BitVec w) (n : Nat) : BitVec w := x >>> n ||| x <<< (w - n) - -/-- -A version of `zeroExtend` that requires a proof, but is a noop. --/ -def zeroExtend' {n w : Nat} (le : n ≤ w) (x : BitVec n) : BitVec w := - ⟨x.toNat, by - apply Nat.lt_of_lt_of_le x.isLt - exact Nat.pow_le_pow_of_le_right (by trivial) le⟩ - -/-- -`shiftLeftZeroExtend x n` returns `zeroExtend (w+n) x <<< n` without -needing to compute `x % 2^(2+n)`. --/ -def shiftLeftZeroExtend (msbs : BitVec w) (m : Nat) : BitVec (w+m) := - let shiftLeftLt {x : Nat} (p : x < 2^w) (m : Nat) : x <<< m < 2^(w+m) := by - simp [Nat.shiftLeft_eq, Nat.pow_add] - apply Nat.mul_lt_mul_of_pos_right p - exact (Nat.two_pow_pos m) - ⟨msbs.toNat <<< m, shiftLeftLt msbs.isLt m⟩ - -/-- -Concatenation of bitvectors. This uses the "big endian" convention that the more significant -input is on the left, so `0xAB#8 ++ 0xCD#8 = 0xABCD#16`. - -SMT-Lib name: `concat`. --/ -def append (msbs : BitVec n) (lsbs : BitVec m) : BitVec (n+m) := - shiftLeftZeroExtend msbs m ||| zeroExtend' (Nat.le_add_left m n) lsbs - -instance : HAppend (BitVec w) (BitVec v) (BitVec (w + v)) := ⟨.append⟩ - -/-- -Extraction of bits `start` to `start + len - 1` from a bit vector of size `n` to yield a -new bitvector of size `len`. If `start + len > n`, then the vector will be zero-padded in the -high bits. --/ -def extractLsb' (start len : Nat) (a : BitVec n) : BitVec len := .ofNat _ (a.toNat >>> start) - -/-- -Extraction of bits `hi` (inclusive) down to `lo` (inclusive) from a bit vector of size `n` to -yield a new bitvector of size `hi - lo + 1`. - -SMT-Lib name: `extract`. --/ -def extractLsb (hi lo : Nat) (a : BitVec n) : BitVec (hi - lo + 1) := extractLsb' lo _ a - --- TODO: write this using multiplication -/-- `replicate i x` concatenates `i` copies of `x` into a new vector of length `w*i`. -/ -def replicate : (i : Nat) → BitVec w → BitVec (w*i) - | 0, _ => 0 - | n+1, x => - have hEq : w + w*n = w*(n + 1) := by - rw [Nat.mul_add, Nat.add_comm, Nat.mul_one] - hEq ▸ (x ++ replicate n x) - -/-- Fills a bitvector with `w` copies of the bit `b`. -/ -def fill (w : Nat) (b : Bool) : BitVec w := bif b then -1 else 0 - -/-- -Zero extend vector `x` of length `w` by adding zeros in the high bits until it has length `v`. -If `v < w` then it truncates the high bits instead. - -SMT-Lib name: `zero_extend`. --/ -def zeroExtend (v : Nat) (x : BitVec w) : BitVec v := - if h : w ≤ v then - zeroExtend' h x - else - .ofNat v x.toNat - -/-- -Truncate the high bits of bitvector `x` of length `w`, resulting in a vector of length `v`. -If `v > w` then it zero-extends the vector instead. --/ -alias truncate := zeroExtend - -/-- -Sign extend a vector of length `w`, extending with `i` additional copies of the most significant -bit in `x`. If `x` is an empty vector, then the sign is treated as zero. - -SMT-Lib name: `sign_extend`. --/ -def signExtend (v : Nat) (x : BitVec w) : BitVec v := .ofInt v x.toInt - -/-! We add simp-lemmas that rewrite bitvector operations into the equivalent notation -/ -@[simp] theorem append_eq (x : BitVec w) (y : BitVec v) : BitVec.append x y = x ++ y := rfl -@[simp] theorem shiftLeft_eq (x : BitVec w) (n : Nat) : BitVec.shiftLeft x n = x <<< n := rfl -@[simp] theorem ushiftRight_eq (x : BitVec w) (n : Nat) : BitVec.ushiftRight x n = x >>> n := rfl -@[simp] theorem not_eq (x : BitVec w) : BitVec.not x = ~~~x := rfl -@[simp] theorem and_eq (x y : BitVec w) : BitVec.and x y = x &&& y := rfl -@[simp] theorem or_eq (x y : BitVec w) : BitVec.or x y = x ||| y := rfl -@[simp] theorem xor_eq (x y : BitVec w) : BitVec.xor x y = x ^^^ y := rfl -@[simp] theorem neg_eq (x : BitVec w) : BitVec.neg x = -x := rfl -@[simp] theorem add_eq (x y : BitVec w) : BitVec.add x y = x + y := rfl -@[simp] theorem sub_eq (x y : BitVec w) : BitVec.sub x y = x - y := rfl -@[simp] theorem mul_eq (x y : BitVec w) : BitVec.mul x y = x * y := rfl -@[simp] theorem zero_eq : BitVec.zero n = 0#n := rfl - -@[simp] theorem cast_ofNat {n m : Nat} (h : n = m) (x : Nat) : - cast h (BitVec.ofNat n x) = BitVec.ofNat m x := by - subst h; rfl - -@[simp] theorem cast_cast {n m k : Nat} (h₁ : n = m) (h₂ : m = k) (x : BitVec n) : - cast h₂ (cast h₁ x) = cast (h₁ ▸ h₂) x := - rfl - -@[simp] theorem cast_eq {n : Nat} (h : n = n) (x : BitVec n) : - cast h x = x := - rfl - -/-- Turn a `Bool` into a bitvector of length `1` -/ -def ofBool (b : Bool) : BitVec 1 := cond b 1 0 - -@[simp] theorem ofBool_false : ofBool false = 0 := by trivial -@[simp] theorem ofBool_true : ofBool true = 1 := by trivial - -/-- The empty bitvector -/ -abbrev nil : BitVec 0 := 0 - -/-! -### Cons and Concat -We give special names to the operations of adding a single bit to either end of a bitvector. -We follow the precedent of `Vector.cons`/`Vector.concat` both for the name, and for the decision -to have the resulting size be `n + 1` for both operations (rather than `1 + n`, which would be the -result of appending a single bit to the front in the naive implementation). --/ - -/-- Append a single bit to the end of a bitvector, using big endian order (see `append`). - That is, the new bit is the least significant bit. -/ -def concat {n} (msbs : BitVec n) (lsb : Bool) : BitVec (n+1) := msbs ++ (ofBool lsb) - -/-- Prepend a single bit to the front of a bitvector, using big endian order (see `append`). - That is, the new bit is the most significant bit. -/ -def cons {n} (msb : Bool) (lsbs : BitVec n) : BitVec (n+1) := - ((ofBool msb) ++ lsbs).cast (Nat.add_comm ..) - -/-- All empty bitvectors are equal -/ -instance : Subsingleton (BitVec 0) where - allEq := by intro ⟨0, _⟩ ⟨0, _⟩; rfl - -/-- Every bitvector of length 0 is equal to `nil`, i.e., there is only one empty bitvector -/ -theorem eq_nil : ∀ (x : BitVec 0), x = nil - | ofFin ⟨0, _⟩ => rfl - -theorem append_ofBool (msbs : BitVec w) (lsb : Bool) : - msbs ++ ofBool lsb = concat msbs lsb := - rfl - -theorem ofBool_append (msb : Bool) (lsbs : BitVec w) : - ofBool msb ++ lsbs = (cons msb lsbs).cast (Nat.add_comm ..) := - rfl diff --git a/Std/Data/BitVec/Bitblast.lean b/Std/Data/BitVec/Bitblast.lean deleted file mode 100644 index 9c068721f1..0000000000 --- a/Std/Data/BitVec/Bitblast.lean +++ /dev/null @@ -1,172 +0,0 @@ -/- -Copyright (c) 2023 by the authors listed in the file AUTHORS and their -institutional affiliations. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix --/ -import Std.Data.BitVec.Folds - -/-! -# Bitblasting of bitvectors - -This module provides theorems for showing the equivalence between BitVec operations using -the `Fin 2^n` representation and Boolean vectors. It is still under development, but -intended to provide a path for converting SAT and SMT solver proofs about BitVectors -as vectors of bits into proofs about Lean `BitVec` values. - -The module is named for the bit-blasting operation in an SMT solver that converts bitvector -expressions into expressions about individual bits in each vector. - -## Main results -* `x + y : BitVec w` is `(adc x y false).2`. - - -## Future work -All other operations are to be PR'ed later and are already proved in -https://github.com/mhk119/lean-smt/blob/bitvec/Smt/Data/Bitwise.lean. - --/ - -open Nat Bool - -/-! ### Preliminaries -/ - -namespace Std.BitVec - -private theorem testBit_limit {x i : Nat} (x_lt_succ : x < 2^(i+1)) : - testBit x i = decide (x ≥ 2^i) := by - cases xi : testBit x i with - | true => - simp [testBit_implies_ge xi] - | false => - simp - cases Nat.lt_or_ge x (2^i) with - | inl x_lt => - exact x_lt - | inr x_ge => - have ⟨j, ⟨j_ge, jp⟩⟩ := ge_two_pow_implies_high_bit_true x_ge - cases Nat.lt_or_eq_of_le j_ge with - | inr x_eq => - simp [x_eq, jp] at xi - | inl x_lt => - exfalso - apply Nat.lt_irrefl - calc x < 2^(i+1) := x_lt_succ - _ ≤ 2 ^ j := Nat.pow_le_pow_of_le_right Nat.zero_lt_two x_lt - _ ≤ x := testBit_implies_ge jp - -private theorem mod_two_pow_succ (x i : Nat) : - x % 2^(i+1) = 2^i*(x.testBit i).toNat + x % (2 ^ i):= by - apply Nat.eq_of_testBit_eq - intro j - simp only [Nat.mul_add_lt_is_or, testBit_or, testBit_mod_two_pow, testBit_shiftLeft, - Nat.testBit_bool_to_nat, Nat.sub_eq_zero_iff_le, Nat.mod_lt, Nat.two_pow_pos, - testBit_mul_pow_two] - rcases Nat.lt_trichotomy i j with i_lt_j | i_eq_j | j_lt_i - · have i_le_j : i ≤ j := Nat.le_of_lt i_lt_j - have not_j_le_i : ¬(j ≤ i) := Nat.not_le_of_lt i_lt_j - have not_j_lt_i : ¬(j < i) := Nat.not_lt_of_le i_le_j - have not_j_lt_i_succ : ¬(j < i + 1) := - Nat.not_le_of_lt (Nat.succ_lt_succ i_lt_j) - simp [i_le_j, not_j_le_i, not_j_lt_i, not_j_lt_i_succ] - · simp [i_eq_j] - · have j_le_i : j ≤ i := Nat.le_of_lt j_lt_i - have j_le_i_succ : j < i + 1 := Nat.succ_le_succ j_le_i - have not_j_ge_i : ¬(j ≥ i) := Nat.not_le_of_lt j_lt_i - simp [j_lt_i, j_le_i, not_j_ge_i, j_le_i_succ] - -private theorem mod_two_pow_lt (x i : Nat) : x % 2 ^ i < 2^i := Nat.mod_lt _ (Nat.two_pow_pos _) - -/-! ### Addition -/ - -/-- carry w x y c returns true if the `w` carry bit is true when computing `x + y + c`. -/ -def carry (w x y : Nat) (c : Bool) : Bool := decide (x % 2^w + y % 2^w + c.toNat ≥ 2^w) - -@[simp] theorem carry_zero : carry 0 x y c = c := by - cases c <;> simp [carry, mod_one] - -/-- At least two out of three booleans are true. -/ -abbrev atLeastTwo (a b c : Bool) : Bool := a && b || a && c || b && c - -/-- Carry function for bitwise addition. -/ -def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, Bool.xor x (Bool.xor y c)) - -/-- Bitwise addition implemented via a ripple carry adder. -/ -def adc (x y : BitVec w) : Bool → Bool × BitVec w := - iunfoldr fun (i : Fin w) c => adcb (x.getLsb i) (y.getLsb i) c - -theorem adc_overflow_limit (x y i : Nat) (c : Bool) : x % 2^i + (y % 2^i + c.toNat) < 2^(i+1) := by - have : c.toNat ≤ 1 := Bool.toNat_le_one c - rw [Nat.pow_succ] - omega - -theorem carry_succ (w x y : Nat) (c : Bool) : - carry (succ w) x y c = atLeastTwo (x.testBit w) (y.testBit w) (carry w x y c) := by - simp only [carry, mod_two_pow_succ, atLeastTwo] - simp only [Nat.pow_succ'] - generalize testBit x w = xh - generalize testBit y w = yh - have sum_bnd : x%2^w + (y%2^w + c.toNat) < 2*2^w := by - simp only [← Nat.pow_succ'] - exact adc_overflow_limit x y w c - cases xh <;> cases yh <;> (simp; omega) - -theorem getLsb_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool) : - getLsb (x + y + zeroExtend w (ofBool c)) i = - Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x.toNat y.toNat c)) := by - let ⟨x, x_lt⟩ := x - let ⟨y, y_lt⟩ := y - simp only [getLsb, toNat_add, toNat_zeroExtend, i_lt, toNat_ofFin, toNat_ofBool, - Nat.mod_add_mod, Nat.add_mod_mod] - apply Eq.trans - rw [← Nat.div_add_mod x (2^i), ← Nat.div_add_mod y (2^i)] - simp only - [ Nat.testBit_mod_two_pow, - Nat.testBit_mul_two_pow_add_eq, - i_lt, - decide_True, - Bool.true_and, - Nat.add_assoc, - Nat.add_left_comm (_%_) (_ * _) _, - testBit_limit (adc_overflow_limit x y i c) - ] - simp [testBit_to_div_mod, carry, Nat.add_assoc] - -theorem getLsb_add {i : Nat} (i_lt : i < w) (x y : BitVec w) : - getLsb (x + y) i = - Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x.toNat y.toNat false)) := by - simpa using getLsb_add_add_bool i_lt x y false - -theorem adc_spec (x y : BitVec w) (c : Bool) : - adc x y c = (carry w x.toNat y.toNat c, x + y + zeroExtend w (ofBool c)) := by - simp only [adc] - apply iunfoldr_replace - (fun i => carry i x.toNat y.toNat c) - (x + y + zeroExtend w (ofBool c)) - c - case init => - simp [carry, Nat.mod_one] - cases c <;> rfl - case step => - intro ⟨i, lt⟩ - simp only [adcb, Prod.mk.injEq, carry_succ] - apply And.intro - case left => - rw [testBit_toNat, testBit_toNat] - case right => - simp [getLsb_add_add_bool lt] - -theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := by - simp [adc_spec] - -/-! ### add -/ - -/-- 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)] - · rfl - · simp [adcb, atLeastTwo] - -/-- Subtracting `x` from the all ones bitvector is equivalent to taking its complement -/ -theorem allOnes_sub_eq_not (x : BitVec w) : allOnes w - x = ~~~x := by - rw [← add_not_self x, BitVec.add_comm, add_sub_cancel] diff --git a/Std/Data/BitVec/Folds.lean b/Std/Data/BitVec/Folds.lean deleted file mode 100644 index 952b930006..0000000000 --- a/Std/Data/BitVec/Folds.lean +++ /dev/null @@ -1,57 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix --/ -import Std.Data.BitVec.Lemmas -import Std.Data.Nat.Lemmas - -namespace Std.BitVec - -/-- -iunfoldr is an iterative operation that applies a function `f` repeatedly. - -It produces a sequence of state values `[s_0, s_1 .. s_w]` and a bitvector -`v` where `f i s_i = (s_{i+1}, b_i)` and `b_i` is bit `i`th least-significant bit -in `v` (e.g., `getLsb v i = b_i`). - -Theorems involving `iunfoldr` can be eliminated using `iunfoldr_replace` below. --/ -def iunfoldr (f : Fin w -> α → α × Bool) (s : α) : α × BitVec w := - Fin.hIterate (fun i => α × BitVec i) (s, nil) fun i q => - (fun p => ⟨p.fst, cons p.snd q.snd⟩) (f i q.fst) - -theorem iunfoldr.fst_eq - {f : Fin w → α → α × Bool} (state : Nat → α) (s : α) - (init : s = state 0) - (ind : ∀(i : Fin w), (f i (state i.val)).fst = state (i.val+1)) : - (iunfoldr f s).fst = state w := by - unfold iunfoldr - apply Fin.hIterate_elim (fun i (p : α × BitVec i) => p.fst = state i) - case init => - exact init - case step => - intro i ⟨s, v⟩ p - simp_all [ind i] - -private theorem iunfoldr.eq_test - {f : Fin w → α → α × Bool} (state : Nat → α) (value : BitVec w) (a : α) - (init : state 0 = a) - (step : ∀(i : Fin w), f i (state i.val) = (state (i.val+1), value.getLsb i.val)) : - iunfoldr f a = (state w, BitVec.truncate w value) := by - apply Fin.hIterate_eq (fun i => ((state i, BitVec.truncate i value) : α × BitVec i)) - case init => - simp only [init, eq_nil] - case step => - intro i - simp_all [truncate_succ] - -/-- -Correctness theorem for `iunfoldr`. --/ -theorem iunfoldr_replace - {f : Fin w → α → α × Bool} (state : Nat → α) (value : BitVec w) (a : α) - (init : state 0 = a) - (step : ∀(i : Fin w), f i (state i.val) = (state (i.val+1), value.getLsb i.val)) : - iunfoldr f a = (state w, value) := by - simp [iunfoldr.eq_test state value a init step] diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index dbc0f30e63..65983b4fb0 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -4,541 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joe Hendrix -/ import Std.Data.Bool -import Std.Data.BitVec.Basic import Std.Data.Fin.Lemmas import Std.Data.Nat.Lemmas -import Std.Tactic.Simpa import Std.Util.ProofWanted namespace Std.BitVec -/-- -This normalized a bitvec using `ofFin` to `ofNat`. --/ -theorem ofFin_eq_ofNat : @BitVec.ofFin w (Fin.mk x lt) = BitVec.ofNat w x := by - simp only [BitVec.ofNat, Fin.ofNat', lt, Nat.mod_eq_of_lt] - -/-- Prove equality of bitvectors in terms of nat operations. -/ -theorem eq_of_toNat_eq {n} : ∀ {i j : BitVec n}, i.toNat = j.toNat → i = j - | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl - /-- Replaced 2024-02-07. -/ @[deprecated] alias zero_is_unique := eq_nil -@[simp] theorem val_toFin (x : BitVec w) : x.toFin.val = x.toNat := rfl - -theorem toNat_eq (x y : BitVec n) : x = y ↔ x.toNat = y.toNat := - Iff.intro (congrArg BitVec.toNat) eq_of_toNat_eq - -theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.toFin.2 - -theorem testBit_toNat (x : BitVec w) : x.toNat.testBit i = x.getLsb i := rfl - -@[simp] theorem getLsb_ofFin (x : Fin (2^n)) (i : Nat) : - getLsb (BitVec.ofFin x) i = x.val.testBit i := rfl - -@[simp] theorem getLsb_ge (x : BitVec w) (i : Nat) (ge : i ≥ w) : getLsb x i = false := by - let ⟨x, x_lt⟩ := x - simp - apply Nat.testBit_lt_two_pow - have p : 2^w ≤ 2^i := Nat.pow_le_pow_of_le_right (by omega) ge - omega - -theorem lt_of_getLsb (x : BitVec w) (i : Nat) : getLsb x i = true → i < w := by - if h : i < w then - simp [h] - else - simp [Nat.ge_of_not_lt h] - --- We choose `eq_of_getLsb_eq` as the `@[ext]` theorem for `BitVec` --- somewhat arbitrarily over `eq_of_getMsg_eq`. -@[ext] theorem eq_of_getLsb_eq {x y : BitVec w} - (pred : ∀(i : Fin w), x.getLsb i.val = y.getLsb i.val) : x = y := by - apply eq_of_toNat_eq - apply Nat.eq_of_testBit_eq - intro i - if i_lt : i < w then - exact pred ⟨i, i_lt⟩ - else - have p : i ≥ w := Nat.le_of_not_gt i_lt - simp [testBit_toNat, getLsb_ge _ _ p] - -theorem eq_of_getMsb_eq {x y : BitVec w} - (pred : ∀(i : Fin w), x.getMsb i = y.getMsb i.val) : x = y := by - simp only [getMsb] at pred - apply eq_of_getLsb_eq - intro ⟨i, i_lt⟩ - if w_zero : w = 0 then - simp [w_zero] - else - have w_pos := Nat.pos_of_ne_zero w_zero - have r : i ≤ w - 1 := by - simp [Nat.le_sub_iff_add_le w_pos, Nat.add_succ] - exact i_lt - have q_lt : w - 1 - i < w := by - simp only [Nat.sub_sub] - apply Nat.sub_lt w_pos - simp [Nat.succ_add] - have q := pred ⟨w - 1 - i, q_lt⟩ - simpa [q_lt, Nat.sub_sub_self, r] using q - -theorem eq_of_toFin_eq : ∀ {x y : BitVec w}, x.toFin = y.toFin → x = y - | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl - -@[simp] theorem toNat_ofBool (b : Bool) : (ofBool b).toNat = b.toNat := by - cases b <;> rfl - -theorem ofNat_one (n : Nat) : BitVec.ofNat 1 n = BitVec.ofBool (n % 2 = 1) := by - rcases (Nat.mod_two_eq_zero_or_one n) with h | h <;> simp [h, BitVec.ofNat, Fin.ofNat'] - -theorem ofBool_eq_iff_eq : ∀(b b' : Bool), BitVec.ofBool b = BitVec.ofBool b' ↔ b = b' := by - decide - -@[simp] theorem toNat_ofFin (x : Fin (2^n)) : (BitVec.ofFin x).toNat = x.val := rfl - -@[simp] theorem toNat_ofNat (x w : Nat) : (x#w).toNat = x % 2^w := by - simp [BitVec.toNat, BitVec.ofNat, Fin.ofNat'] - --- Remark: we don't use `[simp]` here because simproc` subsumes it for literals. --- If `x` and `n` are not literals, applying this theorem eagerly may not be a good idea. -theorem getLsb_ofNat (n : Nat) (x : Nat) (i : Nat) : - getLsb (x#n) i = (i < n && x.testBit i) := by - simp [getLsb, BitVec.ofNat, Fin.val_ofNat'] - -@[deprecated toNat_ofNat] theorem toNat_zero (n : Nat) : (0#n).toNat = 0 := by trivial - -@[simp] theorem toNat_mod_cancel (x : BitVec n) : x.toNat % (2^n) = x.toNat := - Nat.mod_eq_of_lt x.isLt - -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) - -@[simp] theorem ofNat_toNat (m : Nat) (x : BitVec n) : x.toNat#m = truncate m x := by - let ⟨x, lt_n⟩ := x - unfold truncate - unfold zeroExtend - if h : n ≤ m then - unfold zeroExtend' - have lt_m : x < 2 ^ m := lt_two_pow_of_le lt_n h - simp [h, lt_m, Nat.mod_eq_of_lt, BitVec.toNat, BitVec.ofNat, Fin.ofNat'] - else - simp [h] - - -/-! ### msb -/ - -theorem msb_eq_decide (x : BitVec (Nat.succ w)) : BitVec.msb x = decide (2 ^ w ≤ x.toNat) := by - simp only [BitVec.msb, getMsb, Nat.zero_lt_succ, - decide_True, getLsb, Nat.testBit, Nat.succ_sub_succ_eq_sub, - Nat.sub_zero, Nat.and_one_is_mod, Bool.true_and, Nat.shiftRight_eq_div_pow] - rcases (Nat.lt_or_ge (BitVec.toNat x) (2 ^ w)) with h | h - · simp [Nat.div_eq_of_lt h, h] - · simp only [h] - rw [Nat.div_eq_sub_div (Nat.two_pow_pos w) h, Nat.div_eq_of_lt] - · decide - · have : BitVec.toNat x < 2^w + 2^w := by simpa [Nat.pow_succ, Nat.mul_two] using x.isLt - omega - -/-! ### cast -/ - -@[simp] theorem toNat_cast (h : w = v) (x : BitVec w) : (cast h x).toNat = x.toNat := rfl -@[simp] theorem toFin_cast (h : w = v) (x : BitVec w) : - (cast h x).toFin = x.toFin.cast (by rw [h]) := - rfl - -@[simp] theorem getLsb_cast (h : w = v) (x : BitVec w) : (cast h x).getLsb i = x.getLsb i := by - subst h; simp - -@[simp] theorem getMsb_cast (h : w = v) (x : BitVec w) : (cast h x).getMsb i = x.getMsb i := by - subst h; simp -@[simp] theorem msb_cast (h : w = v) (x : BitVec w) : (cast h x).msb = x.msb := by - simp [BitVec.msb] - -/-! ### zeroExtend and truncate -/ - -@[simp] theorem toNat_zeroExtend' {m n : Nat} (p : m ≤ n) (x : BitVec m) : - (zeroExtend' p x).toNat = x.toNat := by - unfold zeroExtend' - simp [p, x.isLt, Nat.mod_eq_of_lt] - -theorem toNat_zeroExtend (i : Nat) (x : BitVec n) : - BitVec.toNat (zeroExtend i x) = x.toNat % 2^i := by - let ⟨x, lt_n⟩ := x - simp only [zeroExtend] - if n_le_i : n ≤ i then - have x_lt_two_i : x < 2 ^ i := lt_two_pow_of_le lt_n n_le_i - simp [n_le_i, Nat.mod_eq_of_lt, x_lt_two_i] - else - simp [n_le_i, toNat_ofNat] - -@[simp] theorem zeroExtend_eq (x : BitVec n) : zeroExtend n x = x := by - apply eq_of_toNat_eq - let ⟨x, lt_n⟩ := x - simp [truncate, zeroExtend] - -@[simp] theorem zeroExtend_zero (m n : Nat) : zeroExtend m (0#n) = 0#m := by - apply eq_of_toNat_eq - simp [toNat_zeroExtend] - -@[simp] theorem truncate_eq (x : BitVec n) : truncate n x = x := zeroExtend_eq x - -@[simp] theorem toNat_truncate (x : BitVec n) : (truncate i x).toNat = x.toNat % 2^i := - toNat_zeroExtend i x - -@[simp] theorem getLsb_zeroExtend' (ge : m ≥ n) (x : BitVec n) (i : Nat) : - getLsb (zeroExtend' ge x) i = getLsb x i := by - simp [getLsb, toNat_zeroExtend'] - -@[simp] theorem getLsb_zeroExtend (m : Nat) (x : BitVec n) (i : Nat) : - getLsb (zeroExtend m x) i = (decide (i < m) && getLsb x i) := by - simp [getLsb, toNat_zeroExtend, Nat.testBit_mod_two_pow] - -@[simp] theorem getLsb_truncate (m : Nat) (x : BitVec n) (i : Nat) : - getLsb (truncate m x) i = (decide (i < m) && getLsb x i) := - getLsb_zeroExtend m x i - -/-! ## extractLsb -/ - -@[simp] -protected theorem extractLsb_ofFin {n} (x : Fin (2^n)) (hi lo : Nat) : - extractLsb hi lo (@BitVec.ofFin n x) = .ofNat (hi-lo+1) (x.val >>> lo) := rfl - -@[simp] -protected theorem extractLsb_ofNat (x n : Nat) (hi lo : Nat) : - extractLsb hi lo x#n = .ofNat (hi - lo + 1) ((x % 2^n) >>> lo) := by - apply eq_of_getLsb_eq - intro ⟨i, _lt⟩ - simp [BitVec.ofNat] - -@[simp] theorem extractLsb'_toNat (s m : Nat) (x : BitVec n) : - (extractLsb' s m x).toNat = (x.toNat >>> s) % 2^m := rfl - -@[simp] theorem extractLsb_toNat (hi lo : Nat) (x : BitVec n) : - (extractLsb hi lo x).toNat = (x.toNat >>> lo) % 2^(hi-lo+1) := rfl - -@[simp] theorem getLsb_extract (hi lo : Nat) (x : BitVec n) (i : Nat) : - getLsb (extractLsb hi lo x) i = (i ≤ (hi-lo) && getLsb x (lo+i)) := by - unfold getLsb - simp [Nat.lt_succ] - -/-! ### allOnes -/ - -private theorem allOnes_def : - allOnes v = .ofFin (⟨0, Nat.two_pow_pos v⟩ - ⟨1 % 2^v, Nat.mod_lt _ (Nat.two_pow_pos v)⟩) := by - rfl - -@[simp] theorem toNat_allOnes : (allOnes v).toNat = 2^v - 1 := by - simp only [allOnes_def, toNat_ofFin, Fin.coe_sub, Nat.zero_add] - by_cases h : v = 0 - · subst h - rfl - · rw [Nat.mod_eq_of_lt (Nat.one_lt_two_pow h), Nat.mod_eq_of_lt] - exact Nat.pred_lt_self (Nat.two_pow_pos v) - -@[simp] theorem getLsb_allOnes : (allOnes v).getLsb i = decide (i < v) := by - simp only [allOnes_def, getLsb_ofFin, Fin.coe_sub, Nat.zero_add, Nat.testBit_mod_two_pow] - if h : i < v then - simp only [h, decide_True, Bool.true_and] - match i, v, h with - | i, (v + 1), h => - rw [Nat.mod_eq_of_lt (by simp), Nat.testBit_two_pow_sub_one] - simp [h] - else - simp [h] - -theorem negOne_eq_allOnes : -1#w = allOnes w := - rfl - -/-! ### or -/ - -@[simp] theorem toNat_or (x y : BitVec v) : - BitVec.toNat (x ||| y) = BitVec.toNat x ||| BitVec.toNat y := rfl - -@[simp] theorem toFin_or (x y : BitVec v) : - BitVec.toFin (x ||| y) = BitVec.toFin x ||| BitVec.toFin y := by - simp only [HOr.hOr, OrOp.or, BitVec.or, Fin.lor, val_toFin, Fin.mk.injEq] - exact (Nat.mod_eq_of_lt <| Nat.or_lt_two_pow x.isLt y.isLt).symm - - -@[simp] theorem getLsb_or {x y : BitVec v} : (x ||| y).getLsb i = (x.getLsb i || y.getLsb i) := by - rw [← testBit_toNat, getLsb, getLsb] - simp - -/-! ### and -/ - -@[simp] theorem toNat_and (x y : BitVec v) : - BitVec.toNat (x &&& y) = BitVec.toNat x &&& BitVec.toNat y := rfl - -@[simp] theorem toFin_and (x y : BitVec v) : - BitVec.toFin (x &&& y) = BitVec.toFin x &&& BitVec.toFin y := by - simp only [HAnd.hAnd, AndOp.and, BitVec.and, Fin.land, val_toFin, Fin.mk.injEq] - exact (Nat.mod_eq_of_lt <| Nat.and_lt_two_pow _ y.isLt).symm - -@[simp] theorem getLsb_and {x y : BitVec v} : (x &&& y).getLsb i = (x.getLsb i && y.getLsb i) := by - rw [← testBit_toNat, getLsb, getLsb] - simp - -/-! ### xor -/ - -@[simp] theorem toNat_xor (x y : BitVec v) : - BitVec.toNat (x ^^^ y) = BitVec.toNat x ^^^ BitVec.toNat y := rfl - -@[simp] theorem toFin_xor (x y : BitVec v) : - BitVec.toFin (x ^^^ y) = BitVec.toFin x ^^^ BitVec.toFin y := by - simp only [HXor.hXor, Xor.xor, BitVec.xor, Fin.xor, val_toFin, Fin.mk.injEq] - exact (Nat.mod_eq_of_lt <| Nat.xor_lt_two_pow x.isLt y.isLt).symm - -@[simp] theorem getLsb_xor {x y : BitVec v} : - (x ^^^ y).getLsb i = (xor (x.getLsb i) (y.getLsb i)) := by - rw [← testBit_toNat, getLsb, getLsb] - simp - -/-! ### not -/ - -theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl - -@[simp] theorem toNat_not {x : BitVec v} : (~~~x).toNat = 2^v - 1 - x.toNat := by - rw [Nat.sub_sub, Nat.add_comm, not_def, toNat_xor] - apply Nat.eq_of_testBit_eq - intro i - simp only [toNat_allOnes, Nat.testBit_xor, Nat.testBit_two_pow_sub_one] - match h : BitVec.toNat x with - | 0 => simp - | y+1 => - rw [Nat.succ_eq_add_one] at h - rw [← h] - rw [Nat.testBit_two_pow_sub_succ (toNat_lt _)] - · cases w : decide (i < v) - · simp at w - simp [w] - rw [Nat.testBit_lt_two_pow] - calc BitVec.toNat x < 2 ^ v := toNat_lt _ - _ ≤ 2 ^ i := Nat.pow_le_pow_of_le_right Nat.zero_lt_two w - · simp - -@[simp] theorem toFin_not (x : BitVec w) : - (~~~x).toFin = x.toFin.rev := by - apply Fin.val_inj.mp - simp only [val_toFin, toNat_not, Fin.val_rev] - omega - -@[simp] theorem getLsb_not {x : BitVec v} : (~~~x).getLsb i = (decide (i < v) && ! x.getLsb i) := by - by_cases h' : i < v <;> simp_all [not_def] - -/-! ### shiftLeft -/ - -@[simp] theorem toNat_shiftLeft {x : BitVec v} : - BitVec.toNat (x <<< n) = BitVec.toNat x <<< n % 2^v := - BitVec.toNat_ofNat _ _ - -@[simp] theorem toFin_shiftLeft {n : Nat} (x : BitVec w) : - BitVec.toFin (x <<< n) = Fin.ofNat' (x.toNat <<< n) (Nat.two_pow_pos w) := rfl - -@[simp] theorem getLsb_shiftLeft (x : BitVec m) (n) : - getLsb (x <<< n) i = (decide (i < m) && !decide (i < n) && getLsb x (i - n)) := by - rw [← testBit_toNat, getLsb] - simp only [toNat_shiftLeft, Nat.testBit_mod_two_pow, Nat.testBit_shiftLeft, ge_iff_le] - -- This step could be a case bashing tactic. - cases h₁ : decide (i < m) <;> cases h₂ : decide (n ≤ i) <;> cases h₃ : decide (i < n) - all_goals { simp_all <;> omega } - -theorem shiftLeftZeroExtend_eq {x : BitVec w} : - shiftLeftZeroExtend x n = zeroExtend (w+n) x <<< n := by - apply eq_of_toNat_eq - rw [shiftLeftZeroExtend, zeroExtend] - split - · simp - rw [Nat.mod_eq_of_lt] - rw [Nat.shiftLeft_eq, Nat.pow_add] - exact Nat.mul_lt_mul_of_pos_right (BitVec.toNat_lt x) (Nat.two_pow_pos _) - · omega - -@[simp] theorem getLsb_shiftLeftZeroExtend (x : BitVec m) (n : Nat) : - getLsb (shiftLeftZeroExtend x n) i = ((! decide (i < n)) && getLsb x (i - n)) := by - rw [shiftLeftZeroExtend_eq] - simp only [getLsb_shiftLeft, getLsb_zeroExtend] - cases h₁ : decide (i < n) <;> cases h₂ : decide (i - n < m + n) <;> cases h₃ : decide (i < m + n) - <;> simp_all - <;> (rw [getLsb_ge]; omega) - -/-! ### ushiftRight -/ - -@[simp] theorem toNat_ushiftRight (x : BitVec n) (i : Nat) : - (x >>> i).toNat = x.toNat >>> i := rfl - -@[simp] theorem getLsb_ushiftRight (x : BitVec n) (i j : Nat) : - getLsb (x >>> i) j = getLsb x (i+j) := by - unfold getLsb ; simp - -/-! ### append -/ - -theorem append_def (x : BitVec v) (y : BitVec w) : - x ++ y = (shiftLeftZeroExtend x w ||| zeroExtend' (Nat.le_add_left w v) y) := rfl - -@[simp] theorem toNat_append (x : BitVec m) (y : BitVec n) : - (x ++ y).toNat = x.toNat <<< n ||| y.toNat := - rfl - -@[simp] theorem getLsb_append {v : BitVec n} {w : BitVec m} : - getLsb (v ++ w) i = bif i < m then getLsb w i else getLsb v (i - m) := by - simp [append_def] - by_cases h : i < m - · simp [h] - · simp [h]; simp_all - -/-! ### rev -/ - -theorem getLsb_rev (x : BitVec w) (i : Fin w) : - x.getLsb i.rev = x.getMsb i := by - simp [getLsb, getMsb] - congr 1 - omega - -theorem getMsb_rev (x : BitVec w) (i : Fin w) : - x.getMsb i.rev = x.getLsb i := by - simp only [← getLsb_rev] - simp only [Fin.rev] - congr - omega - -/-! ### cons -/ - -@[simp] theorem toNat_cons (b : Bool) (x : BitVec w) : - (cons b x).toNat = (b.toNat <<< w) ||| x.toNat := by - let ⟨x, _⟩ := x - simp [cons, toNat_append, toNat_ofBool] - -@[simp] theorem getLsb_cons (b : Bool) {n} (x : BitVec n) (i : Nat) : - getLsb (cons b x) i = if i = n then b else getLsb x i := by - simp only [getLsb, toNat_cons, Nat.testBit_or] - rw [Nat.testBit_shiftLeft] - rcases Nat.lt_trichotomy i n with i_lt_n | i_eq_n | n_lt_i - · have p1 : ¬(n ≤ i) := by omega - have p2 : i ≠ n := by omega - simp [p1, p2] - · simp [i_eq_n, testBit_toNat] - cases b <;> trivial - · have p1 : i ≠ n := by omega - have p2 : i - n ≠ 0 := by omega - simp [p1, p2, Nat.testBit_bool_to_nat] - -theorem truncate_succ (x : BitVec w) : - truncate (i+1) x = cons (getLsb x i) (truncate i x) := by - apply eq_of_getLsb_eq - intro j - simp only [getLsb_truncate, getLsb_cons, j.isLt, decide_True, Bool.true_and] - if j_eq : j.val = i then - simp [j_eq] - else - have j_lt : j.val < i := Nat.lt_of_le_of_ne (Nat.le_of_succ_le_succ j.isLt) j_eq - simp [j_eq, j_lt] - -/-! ### add -/ - -theorem add_def {n} (x y : BitVec n) : x + y = .ofNat n (x.toNat + y.toNat) := rfl - -/-- -Definition of bitvector addition as a nat. --/ -@[simp] theorem toNat_add (x y : BitVec w) : (x + y).toNat = (x.toNat + y.toNat) % 2^w := rfl -@[simp] theorem toFin_add (x y : BitVec w) : (x + y).toFin = toFin x + toFin y := rfl -@[simp] theorem ofFin_add (x : Fin (2^n)) (y : BitVec n) : - .ofFin x + y = .ofFin (x + y.toFin) := rfl -@[simp] theorem add_ofFin (x : BitVec n) (y : Fin (2^n)) : - x + .ofFin y = .ofFin (x.toFin + y) := rfl -@[simp] theorem ofNat_add_ofNat {n} (x y : Nat) : x#n + y#n = (x + y)#n := by - apply eq_of_toNat_eq ; simp [BitVec.ofNat] - -protected theorem add_assoc (x y z : BitVec n) : x + y + z = x + (y + z) := by - apply eq_of_toNat_eq ; simp [Nat.add_assoc] - -protected theorem add_comm (x y : BitVec n) : x + y = y + x := by - simp [add_def, Nat.add_comm] - -@[simp] protected theorem add_zero (x : BitVec n) : x + 0#n = x := by simp [add_def] - -@[simp] protected theorem zero_add (x : BitVec n) : 0#n + x = x := by simp [add_def] - - /-! ### sub/neg -/ -theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n (x.toNat + (2^n - y.toNat)) := by rfl - -@[simp] theorem toNat_sub {n} (x y : BitVec n) : - (x - y).toNat = ((x.toNat + (2^n - y.toNat)) % 2^n) := rfl -@[simp] theorem toFin_sub (x y : BitVec n) : (x - y).toFin = toFin x - toFin y := rfl - /-- Replaced 2024-02-06. -/ @[deprecated] alias sub_toNat := toNat_sub -@[simp] theorem ofFin_sub (x : Fin (2^n)) (y : BitVec n) : .ofFin x - y = .ofFin (x - y.toFin) := - rfl -@[simp] theorem sub_ofFin (x : BitVec n) (y : Fin (2^n)) : x - .ofFin y = .ofFin (x.toFin - y) := - rfl --- Remark: we don't use `[simp]` here because simproc` subsumes it for literals. --- If `x` and `n` are not literals, applying this theorem eagerly may not be a good idea. -theorem ofNat_sub_ofNat {n} (x y : Nat) : x#n - y#n = .ofNat n (x + (2^n - y % 2^n)) := by - apply eq_of_toNat_eq ; simp [BitVec.ofNat] - -@[simp] protected theorem sub_zero (x : BitVec n) : x - (0#n) = x := by apply eq_of_toNat_eq ; simp - -@[simp] protected theorem sub_self (x : BitVec n) : x - x = 0#n := by - apply eq_of_toNat_eq - simp only [toNat_sub] - rw [Nat.add_sub_of_le] - · simp - · exact Nat.le_of_lt x.isLt - -@[simp] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by - simp [Neg.neg, BitVec.neg] - /-- Replaced 2024-02-06. -/ @[deprecated] alias neg_toNat := toNat_neg - -theorem sub_toAdd {n} (x y : BitVec n) : x - y = x + - y := by - apply eq_of_toNat_eq - simp - -@[simp] theorem neg_zero (n:Nat) : -0#n = 0#n := by apply eq_of_toNat_eq ; simp - -theorem add_sub_cancel (x y : BitVec w) : x + y - y = x := by - apply eq_of_toNat_eq - have y_toNat_le := Nat.le_of_lt y.toNat_lt - rw [toNat_sub, toNat_add, Nat.mod_add_mod, Nat.add_assoc, ← Nat.add_sub_assoc y_toNat_le, - Nat.add_sub_cancel_left, Nat.add_mod_right, toNat_mod_cancel] - -/-! ### mul -/ - -theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl - -theorem toNat_mul (x y : BitVec n) : (x * y).toNat = (x.toNat * y.toNat) % 2 ^ n := rfl -@[simp] theorem toFin_mul (x y : BitVec n) : (x * y).toFin = (x.toFin * y.toFin) := rfl - -/-! ### le and lt -/ - -theorem le_def (x y : BitVec n) : - x ≤ y ↔ x.toNat ≤ y.toNat := Iff.rfl - -@[simp] theorem le_ofFin (x : BitVec n) (y : Fin (2^n)) : - x ≤ BitVec.ofFin y ↔ x.toFin ≤ y := Iff.rfl -@[simp] theorem ofFin_le (x : Fin (2^n)) (y : BitVec n) : - BitVec.ofFin x ≤ y ↔ x ≤ y.toFin := Iff.rfl -@[simp] theorem ofNat_le_ofNat {n} (x y : Nat) : (x#n) ≤ (y#n) ↔ x % 2^n ≤ y % 2^n := by - simp [le_def] - -theorem lt_def (x y : BitVec n) : - x < y ↔ x.toNat < y.toNat := Iff.rfl - -@[simp] theorem lt_ofFin (x : BitVec n) (y : Fin (2^n)) : - x < BitVec.ofFin y ↔ x.toFin < y := Iff.rfl -@[simp] theorem ofFin_lt (x : Fin (2^n)) (y : BitVec n) : - BitVec.ofFin x < y ↔ x < y.toFin := Iff.rfl -@[simp] theorem ofNat_lt_ofNat {n} (x y : Nat) : (x#n) < (y#n) ↔ x % 2^n < y % 2^n := by - simp [lt_def] - -protected theorem lt_of_le_ne (x y : BitVec n) (h1 : x <= y) (h2 : ¬ x = y) : x < y := by - revert h1 h2 - let ⟨x, lt⟩ := x - let ⟨y, lt⟩ := y - simp - exact Nat.lt_of_le_of_ne diff --git a/Std/Data/BitVec/Simprocs.lean b/Std/Data/BitVec/Simprocs.lean deleted file mode 100644 index 9263d2f80e..0000000000 --- a/Std/Data/BitVec/Simprocs.lean +++ /dev/null @@ -1,283 +0,0 @@ -/- -Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura --/ -import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Nat -import Std.Data.BitVec.Basic - -namespace Std.BitVec -open Lean Meta Simp - -/-- A bit-vector literal -/ -structure Literal where - /-- Size. -/ - n : Nat - /-- Actual value. -/ - value : BitVec n - -/-- -Try to convert an `OfNat.ofNat`-application into a bitvector literal. --/ -private def fromOfNatExpr? (e : Expr) : SimpM (Option Literal) := OptionT.run do - guard (e.isAppOfArity ``OfNat.ofNat 3) - let type ← whnf e.appFn!.appFn!.appArg! - guard (type.isAppOfArity ``BitVec 1) - let n ← Nat.fromExpr? type.appArg! - let v ← Nat.fromExpr? e.appFn!.appArg! - return { n, value := BitVec.ofNat n v } - -/-- -Try to convert an `Std.BitVec.ofNat`-application into a bitvector literal. --/ -private def fromBitVecExpr? (e : Expr) : SimpM (Option Literal) := OptionT.run do - guard (e.isAppOfArity ``Std.BitVec.ofNat 2) - let n ← Nat.fromExpr? e.appFn!.appArg! - let v ← Nat.fromExpr? e.appArg! - return { n, value := BitVec.ofNat n v } - -/-- -Try to convert `OfNat.ofNat`/`Std.BitVec.OfNat` application into a -bitvector literal. --/ -def fromExpr? (e : Expr) : SimpM (Option Literal) := OptionT.run do - fromBitVecExpr? e <|> fromOfNatExpr? e - -/-- -Convert a bitvector literal into an expression. --/ --- Using `Std.BitVec.ofNat` because it is being used in `simp` theorems -def Literal.toExpr (lit : Literal) : Expr := - mkApp2 (mkConst ``Std.BitVec.ofNat) (mkNatLit lit.n) (mkNatLit lit.value.toNat) - -/-- -Helper function for reducing homogenous unary bitvector operators. --/ -@[inline] def reduceUnary (declName : Name) (arity : Nat) - (op : {n : Nat} → BitVec n → BitVec n) (e : Expr) : SimpM Step := do - unless e.isAppOfArity declName arity do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let v := { v with value := op v.value } - return .done { expr := v.toExpr } - -/-- -Helper function for reducing homogenous binary bitvector operators. --/ -@[inline] def reduceBin (declName : Name) (arity : Nat) - (op : {n : Nat} → BitVec n → BitVec n → BitVec n) (e : Expr) : SimpM Step := do - unless e.isAppOfArity declName arity do return .continue - let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue - let some v₂ ← fromExpr? e.appArg! | return .continue - if h : v₁.n = v₂.n then - trace[Meta.debug] "reduce [{declName}] {v₁.value}, {v₂.value}" - let v := { v₁ with value := op v₁.value (h ▸ v₂.value) } - return .done { expr := v.toExpr } - else - return .continue - -/-- -Helper function for reducing bitvector functions such as `getLsb` and `getMsb`. --/ -@[inline] def reduceGetBit (declName : Name) (op : {n : Nat} → BitVec n → Nat → Bool) (e : Expr) - : SimpM Step := do - unless e.isAppOfArity declName 3 do return .continue - let some v ← fromExpr? e.appFn!.appArg! | return .continue - let some i ← Nat.fromExpr? e.appArg! | return .continue - let b := op v.value i - return .done { expr := toExpr b } - -/-- -Helper function for reducing bitvector functions such as `shiftLeft` and `rotateRight`. --/ -@[inline] def reduceShift (declName : Name) (arity : Nat) - (op : {n : Nat} → BitVec n → Nat → BitVec n) (e : Expr) : SimpM Step := do - unless e.isAppOfArity declName arity do return .continue - let some v ← fromExpr? e.appFn!.appArg! | return .continue - let some i ← Nat.fromExpr? e.appArg! | return .continue - let v := { v with value := op v.value i } - return .done { expr := v.toExpr } - -/-- -Helper function for reducing bitvector predicates. --/ -@[inline] def reduceBinPred (declName : Name) (arity : Nat) - (op : {n : Nat} → BitVec n → BitVec n → Bool) (e : Expr) (isProp := true) : SimpM Step := do - unless e.isAppOfArity declName arity do return .continue - let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue - let some v₂ ← fromExpr? e.appArg! | return .continue - if h : v₁.n = v₂.n then - let b := op v₁.value (h ▸ v₂.value) - if isProp then - evalPropStep e b - else - return .done { expr := toExpr b } - else - return .continue - -/-- Simplification procedure for negation of `BitVec`s. -/ -simproc [simp, seval] reduceNeg ((- _ : BitVec _)) := reduceUnary ``Neg.neg 3 (- ·) -/-- Simplification procedure for bitwise not of `BitVec`s. -/ -simproc [simp, seval] reduceNot ((~~~ _ : BitVec _)) := - reduceUnary ``Complement.complement 3 (~~~ ·) -/-- Simplification procedure for absolute value of `BitVec`s. -/ -simproc [simp, seval] reduceAbs (BitVec.abs _) := reduceUnary ``BitVec.abs 2 BitVec.abs -/-- Simplification procedure for bitwise and of `BitVec`s. -/ -simproc [simp, seval] reduceAnd ((_ &&& _ : BitVec _)) := reduceBin ``HAnd.hAnd 6 (· &&& ·) -/-- Simplification procedure for bitwise or of `BitVec`s. -/ -simproc [simp, seval] reduceOr ((_ ||| _ : BitVec _)) := reduceBin ``HOr.hOr 6 (· ||| ·) -/-- Simplification procedure for bitwise xor of `BitVec`s. -/ -simproc [simp, seval] reduceXOr ((_ ^^^ _ : BitVec _)) := reduceBin ``HXor.hXor 6 (· ^^^ ·) -/-- Simplification procedure for addition of `BitVec`s. -/ -simproc [simp, seval] reduceAdd ((_ + _ : BitVec _)) := reduceBin ``HAdd.hAdd 6 (· + ·) -/-- Simplification procedure for multiplication of `BitVec`s. -/ -simproc [simp, seval] reduceMul ((_ * _ : BitVec _)) := reduceBin ``HMul.hMul 6 (· * ·) -/-- Simplification procedure for subtraction of `BitVec`s. -/ -simproc [simp, seval] reduceSub ((_ - _ : BitVec _)) := reduceBin ``HSub.hSub 6 (· - ·) -/-- Simplification procedure for division of `BitVec`s. -/ -simproc [simp, seval] reduceDiv ((_ / _ : BitVec _)) := reduceBin ``HDiv.hDiv 6 (· / ·) -/-- Simplification procedure for the modulo operation on `BitVec`s. -/ -simproc [simp, seval] reduceMod ((_ % _ : BitVec _)) := reduceBin ``HMod.hMod 6 (· % ·) -/-- Simplification procedure for for the unsigned modulo operation on `BitVec`s. -/ -simproc [simp, seval] reduceUMod ((umod _ _ : BitVec _)) := reduceBin ``umod 3 umod -/-- Simplification procedure for unsigned division of `BitVec`s. -/ -simproc [simp, seval] reduceUDiv ((udiv _ _ : BitVec _)) := reduceBin ``udiv 3 udiv -/-- Simplification procedure for division of `BitVec`s using the SMT-Lib conventions. -/ -simproc [simp, seval] reduceSMTUDiv ((smtUDiv _ _ : BitVec _)) := reduceBin ``smtUDiv 3 smtUDiv -/-- Simplification procedure for the signed modulo operation on `BitVec`s. -/ -simproc [simp, seval] reduceSMod ((smod _ _ : BitVec _)) := reduceBin ``smod 3 smod -/-- Simplification procedure for signed remainder of `BitVec`s. -/ -simproc [simp, seval] reduceSRem ((srem _ _ : BitVec _)) := reduceBin ``srem 3 srem -/-- Simplification procedure for signed t-division of `BitVec`s. -/ -simproc [simp, seval] reduceSDiv ((sdiv _ _ : BitVec _)) := reduceBin ``sdiv 3 sdiv -/-- Simplification procedure for signed division of `BitVec`s using the SMT-Lib conventions. -/ -simproc [simp, seval] reduceSMTSDiv ((smtSDiv _ _ : BitVec _)) := reduceBin ``smtSDiv 3 smtSDiv -/-- Simplification procedure for `getLsb` (lowest significant bit) on `BitVec`. -/ -simproc [simp, seval] reduceGetLsb (getLsb _ _) := reduceGetBit ``getLsb getLsb -/-- Simplification procedure for `getMsb` (most significant bit) on `BitVec`. -/ -simproc [simp, seval] reduceGetMsb (getMsb _ _) := reduceGetBit ``getMsb getMsb - -/-- Simplification procedure for shift left on `BitVec`. -/ -simproc [simp, seval] reduceShiftLeft (BitVec.shiftLeft _ _) := - reduceShift ``BitVec.shiftLeft 3 BitVec.shiftLeft -/-- Simplification procedure for unsigned shift right on `BitVec`. -/ -simproc [simp, seval] reduceUShiftRight (BitVec.ushiftRight _ _) := - reduceShift ``BitVec.ushiftRight 3 BitVec.ushiftRight -/-- Simplification procedure for signed shift right on `BitVec`. -/ -simproc [simp, seval] reduceSShiftRight (BitVec.sshiftRight _ _) := - reduceShift ``BitVec.sshiftRight 3 BitVec.sshiftRight -/-- Simplification procedure for shift left on `BitVec`. -/ -simproc [simp, seval] reduceHShiftLeft ((_ <<< _ : BitVec _)) := - reduceShift ``HShiftLeft.hShiftLeft 6 (· <<< ·) -/-- Simplification procedure for shift right on `BitVec`. -/ -simproc [simp, seval] reduceHShiftRight ((_ >>> _ : BitVec _)) := - reduceShift ``HShiftRight.hShiftRight 6 (· >>> ·) -/-- Simplification procedure for rotate left on `BitVec`. -/ -simproc [simp, seval] reduceRotateLeft (BitVec.rotateLeft _ _) := - reduceShift ``BitVec.rotateLeft 3 BitVec.rotateLeft -/-- Simplification procedure for rotate right on `BitVec`. -/ -simproc [simp, seval] reduceRotateRight (BitVec.rotateRight _ _) := - reduceShift ``BitVec.rotateRight 3 BitVec.rotateRight - -/-- Simplification procedure for append on `BitVec`. -/ -simproc [simp, seval] reduceAppend ((_ ++ _ : BitVec _)) := fun e => do - unless e.isAppOfArity ``HAppend.hAppend 6 do return .continue - let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue - let some v₂ ← fromExpr? e.appArg! | return .continue - let v : Literal := { n := v₁.n + v₂.n, value := v₁.value ++ v₂.value } - return .done { expr := v.toExpr } - -/-- Simplification procedure for casting `BitVec`s along an equality of the size. -/ -simproc [simp, seval] reduceCast (cast _ _) := fun e => do - unless e.isAppOfArity ``cast 4 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some m ← Nat.fromExpr? e.appFn!.appFn!.appArg! | return .continue - let v : Literal := { n := m, value := BitVec.ofNat m v.value.toNat } - return .done { expr := v.toExpr } - -/-- Simplification procedure for `BitVec.toNat`. -/ -simproc [simp, seval] reduceToNat (BitVec.toNat _) := fun e => do - unless e.isAppOfArity ``BitVec.toNat 2 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - return .done { expr := mkNatLit v.value.toNat } - -/-- Simplification procedure for `BitVec.toInt`. -/ -simproc [simp, seval] reduceToInt (BitVec.toInt _) := fun e => do - unless e.isAppOfArity ``BitVec.toInt 2 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - return .done { expr := Int.toExpr v.value.toInt } - -/-- Simplification procedure for `BitVec.ofInt`. -/ -simproc [simp, seval] reduceOfInt (BitVec.ofInt _ _) := fun e => do - unless e.isAppOfArity ``BitVec.ofInt 2 do return .continue - let some n ← Nat.fromExpr? e.appFn!.appArg! | return .continue - let some i ← Int.fromExpr? e.appArg! | return .continue - let lit : Literal := { n, value := BitVec.ofInt n i } - return .done { expr := lit.toExpr } - -/-- Simplification procedure for `<` on `BitVec`s. -/ -simproc [simp, seval] reduceLT (( _ : BitVec _) < _) := reduceBinPred ``LT.lt 4 (· < ·) -/-- Simplification procedure for `≤` on `BitVec`s. -/ -simproc [simp, seval] reduceLE (( _ : BitVec _) ≤ _) := reduceBinPred ``LE.le 4 (. ≤ .) -/-- Simplification procedure for `>` on `BitVec`s. -/ -simproc [simp, seval] reduceGT (( _ : BitVec _) > _) := reduceBinPred ``GT.gt 4 (. > .) -/-- Simplification procedure for `≥` on `BitVec`s. -/ -simproc [simp, seval] reduceGE (( _ : BitVec _) ≥ _) := reduceBinPred ``GE.ge 4 (. ≥ .) - -/-- Simplification procedure for unsigned less than `ult` on `BitVec`s. -/ -simproc [simp, seval] reduceULT (BitVec.ult _ _) := - reduceBinPred ``BitVec.ult 3 BitVec.ult (isProp := false) -/-- Simplification procedure for unsigned less than or equal `ule` on `BitVec`s. -/ -simproc [simp, seval] reduceULE (BitVec.ule _ _) := - reduceBinPred ``BitVec.ule 3 BitVec.ule (isProp := false) -/-- Simplification procedure for signed less than `slt` on `BitVec`s. -/ -simproc [simp, seval] reduceSLT (BitVec.slt _ _) := - reduceBinPred ``BitVec.slt 3 BitVec.slt (isProp := false) -/-- Simplification procedure for signed less than or equal `sle` on `BitVec`s. -/ -simproc [simp, seval] reduceSLE (BitVec.sle _ _) := - reduceBinPred ``BitVec.sle 3 BitVec.sle (isProp := false) - -/-- Simplification procedure for `zeroExtend'` on `BitVec`s. -/ -simproc [simp, seval] reduceZeroExtend' (zeroExtend' _ _) := fun e => do - unless e.isAppOfArity ``zeroExtend' 4 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some w ← Nat.fromExpr? e.appFn!.appFn!.appArg! | return .continue - if h : v.n ≤ w then - let lit : Literal := { n := w, value := v.value.zeroExtend' h } - return .done { expr := lit.toExpr } - else - return .continue - -/-- Simplification procedure for `shiftLeftZeroExtend` on `BitVec`s. -/ -simproc [simp, seval] reduceShiftLeftZeroExtend (shiftLeftZeroExtend _ _) := fun e => do - unless e.isAppOfArity ``shiftLeftZeroExtend 3 do return .continue - let some v ← fromExpr? e.appFn!.appArg! | return .continue - let some m ← Nat.fromExpr? e.appArg! | return .continue - let lit : Literal := { n := v.n + m, value := v.value.shiftLeftZeroExtend m } - return .done { expr := lit.toExpr } - -/-- Simplification procedure for `extractLsb'` on `BitVec`s. -/ -simproc [simp, seval] reduceExtracLsb' (extractLsb' _ _ _) := fun e => do - unless e.isAppOfArity ``extractLsb' 4 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some start ← Nat.fromExpr? e.appFn!.appFn!.appArg! | return .continue - let some len ← Nat.fromExpr? e.appFn!.appArg! | return .continue - let lit : Literal := { n := len, value := v.value.extractLsb' start len } - return .done { expr := lit.toExpr } - -/-- Simplification procedure for `replicate` on `BitVec`s. -/ -simproc [simp, seval] reduceReplicate (replicate _ _) := fun e => do - unless e.isAppOfArity ``replicate 3 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some w ← Nat.fromExpr? e.appFn!.appArg! | return .continue - let lit : Literal := { n := v.n * w, value := v.value.replicate w } - return .done { expr := lit.toExpr } - -/-- Simplification procedure for `zeroExtend` on `BitVec`s. -/ -simproc [simp, seval] reduceZeroExtend (zeroExtend _ _) := fun e => do - unless e.isAppOfArity ``zeroExtend 3 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some n ← Nat.fromExpr? e.appFn!.appArg! | return .continue - let lit : Literal := { n, value := v.value.zeroExtend n } - return .done { expr := lit.toExpr } - -end Std.BitVec diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 6fd2666be0..f49e30b2a2 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -4,828 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Fin.Basic -import Std.Tactic.Simpa -import Std.Tactic.NormCast.Lemmas import Std.Tactic.SimpTrace namespace Fin -/-- If you actually have an element of `Fin n`, then the `n` is always positive -/ -theorem size_pos (i : Fin n) : 0 < n := Nat.lt_of_le_of_lt (Nat.zero_le _) i.2 - -theorem mod_def (a m : Fin n) : a % m = Fin.mk (a % m) (Nat.lt_of_le_of_lt (Nat.mod_le _ _) a.2) := - rfl - -theorem mul_def (a b : Fin n) : a * b = Fin.mk ((a * b) % n) (Nat.mod_lt _ a.size_pos) := rfl - -theorem sub_def (a b : Fin n) : a - b = Fin.mk ((a + (n - b)) % n) (Nat.mod_lt _ a.size_pos) := rfl - -theorem size_pos' : ∀ [Nonempty (Fin n)], 0 < n | ⟨i⟩ => i.size_pos - -@[simp] theorem is_lt (a : Fin n) : (a : Nat) < n := a.2 - -theorem pos_iff_nonempty {n : Nat} : 0 < n ↔ Nonempty (Fin n) := - ⟨fun h => ⟨⟨0, h⟩⟩, fun ⟨i⟩ => i.pos⟩ - -/-! ### coercions and constructions -/ - -@[simp] protected theorem eta (a : Fin n) (h : a < n) : (⟨a, h⟩ : Fin n) = a := rfl - -@[ext] theorem ext {a b : Fin n} (h : (a : Nat) = b) : a = b := eq_of_val_eq h - -theorem val_inj {a b : Fin n} : a.1 = b.1 ↔ a = b := ⟨Fin.eq_of_val_eq, Fin.val_eq_of_eq⟩ - -theorem ext_iff {a b : Fin n} : a = b ↔ a.1 = b.1 := val_inj.symm - -theorem val_ne_iff {a b : Fin n} : a.1 ≠ b.1 ↔ a ≠ b := not_congr val_inj - -theorem exists_iff {p : Fin n → Prop} : (∃ i, p i) ↔ ∃ i h, p ⟨i, h⟩ := - ⟨fun ⟨⟨i, hi⟩, hpi⟩ => ⟨i, hi, hpi⟩, fun ⟨i, hi, hpi⟩ => ⟨⟨i, hi⟩, hpi⟩⟩ - -theorem forall_iff {p : Fin n → Prop} : (∀ i, p i) ↔ ∀ i h, p ⟨i, h⟩ := - ⟨fun h i hi => h ⟨i, hi⟩, fun h ⟨i, hi⟩ => h i hi⟩ - -protected theorem mk.inj_iff {n a b : Nat} {ha : a < n} {hb : b < n} : - (⟨a, ha⟩ : Fin n) = ⟨b, hb⟩ ↔ a = b := ext_iff - -theorem val_mk {m n : Nat} (h : m < n) : (⟨m, h⟩ : Fin n).val = m := rfl - -theorem eq_mk_iff_val_eq {a : Fin n} {k : Nat} {hk : k < n} : - a = ⟨k, hk⟩ ↔ (a : Nat) = k := ext_iff - -theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta .. - -@[simp] theorem val_ofNat' (a : Nat) (is_pos : n > 0) : - (Fin.ofNat' a is_pos).val = a % n := rfl - -@[deprecated ofNat'_zero_val] theorem ofNat'_zero_val : (Fin.ofNat' 0 h).val = 0 := Nat.zero_mod _ - -@[simp] theorem mod_val (a b : Fin n) : (a % b).val = a.val % b.val := - rfl - -@[simp] theorem div_val (a b : Fin n) : (a / b).val = a.val / b.val := - rfl - -@[simp] theorem modn_val (a : Fin n) (b : Nat) : (a.modn b).val = a.val % b := - rfl - -theorem ite_val {n : Nat} {c : Prop} [Decidable c] {x : c → Fin n} (y : ¬c → Fin n) : - (if h : c then x h else y h).val = if h : c then (x h).val else (y h).val := by - by_cases c <;> simp [*] - -theorem dite_val {n : Nat} {c : Prop} [Decidable c] {x y : Fin n} : - (if c then x else y).val = if c then x.val else y.val := by - by_cases c <;> simp [*] - -/-! ### order -/ - -theorem le_def {a b : Fin n} : a ≤ b ↔ a.1 ≤ b.1 := .rfl - -theorem lt_def {a b : Fin n} : a < b ↔ a.1 < b.1 := .rfl - -theorem lt_iff_val_lt_val {a b : Fin n} : a < b ↔ a.val < b.val := Iff.rfl - -@[simp] protected theorem not_le {a b : Fin n} : ¬ a ≤ b ↔ b < a := Nat.not_le - -@[simp] protected theorem not_lt {a b : Fin n} : ¬ a < b ↔ b ≤ a := Nat.not_lt - -protected theorem ne_of_lt {a b : Fin n} (h : a < b) : a ≠ b := Fin.ne_of_val_ne (Nat.ne_of_lt h) - -protected theorem ne_of_gt {a b : Fin n} (h : a < b) : b ≠ a := Fin.ne_of_val_ne (Nat.ne_of_gt h) - -protected theorem le_of_lt {a b : Fin n} (h : a < b) : a ≤ b := Nat.le_of_lt h - -theorem is_le (i : Fin (n + 1)) : i ≤ n := Nat.le_of_lt_succ i.is_lt - -@[simp] theorem is_le' {a : Fin n} : a ≤ n := Nat.le_of_lt a.is_lt - -theorem mk_lt_of_lt_val {b : Fin n} {a : Nat} (h : a < b) : - (⟨a, Nat.lt_trans h b.is_lt⟩ : Fin n) < b := h - -theorem mk_le_of_le_val {b : Fin n} {a : Nat} (h : a ≤ b) : - (⟨a, Nat.lt_of_le_of_lt h b.is_lt⟩ : Fin n) ≤ b := h - -@[simp] theorem mk_le_mk {x y : Nat} {hx hy} : (⟨x, hx⟩ : Fin n) ≤ ⟨y, hy⟩ ↔ x ≤ y := .rfl - -@[simp] theorem mk_lt_mk {x y : Nat} {hx hy} : (⟨x, hx⟩ : Fin n) < ⟨y, hy⟩ ↔ x < y := .rfl - -@[simp] theorem val_zero (n : Nat) : (0 : Fin (n + 1)).1 = 0 := rfl - -@[simp] theorem mk_zero : (⟨0, Nat.succ_pos n⟩ : Fin (n + 1)) = 0 := rfl - -@[simp] theorem zero_le (a : Fin (n + 1)) : 0 ≤ a := Nat.zero_le a.val - -theorem zero_lt_one : (0 : Fin (n + 2)) < 1 := Nat.zero_lt_one - -@[simp] theorem not_lt_zero (a : Fin (n + 1)) : ¬a < 0 := nofun - -theorem pos_iff_ne_zero {a : Fin (n + 1)} : 0 < a ↔ a ≠ 0 := by - rw [lt_def, val_zero, Nat.pos_iff_ne_zero, ← val_ne_iff]; rfl - -theorem eq_zero_or_eq_succ {n : Nat} : ∀ i : Fin (n + 1), i = 0 ∨ ∃ j : Fin n, i = j.succ - | 0 => .inl rfl - | ⟨j + 1, h⟩ => .inr ⟨⟨j, Nat.lt_of_succ_lt_succ h⟩, rfl⟩ - -theorem eq_succ_of_ne_zero {n : Nat} {i : Fin (n + 1)} (hi : i ≠ 0) : ∃ j : Fin n, i = j.succ := - (eq_zero_or_eq_succ i).resolve_left hi - -@[simp] theorem val_rev (i : Fin n) : rev i = n - (i + 1) := rfl - -@[simp] theorem rev_rev (i : Fin n) : rev (rev i) = i := ext <| by - rw [val_rev, val_rev, ← Nat.sub_sub, Nat.sub_sub_self (by exact i.2), Nat.add_sub_cancel] - -@[simp] theorem rev_le_rev {i j : Fin n} : rev i ≤ rev j ↔ j ≤ i := by - simp only [le_def, val_rev, Nat.sub_le_sub_iff_left (Nat.succ_le.2 j.is_lt)] - exact Nat.succ_le_succ_iff - -@[simp] theorem rev_inj {i j : Fin n} : rev i = rev j ↔ i = j := - ⟨fun h => by simpa using congrArg rev h, congrArg _⟩ - -theorem rev_eq {n a : Nat} (i : Fin (n + 1)) (h : n = a + i) : - rev i = ⟨a, Nat.lt_succ_of_le (h ▸ Nat.le_add_right ..)⟩ := by - ext; dsimp - conv => lhs; congr; rw [h] - rw [Nat.add_assoc, Nat.add_sub_cancel] - -@[simp] theorem rev_lt_rev {i j : Fin n} : rev i < rev j ↔ j < i := by - rw [← Fin.not_le, ← Fin.not_le, rev_le_rev] - -@[simp, norm_cast] theorem val_last (n : Nat) : last n = n := rfl - -theorem le_last (i : Fin (n + 1)) : i ≤ last n := Nat.le_of_lt_succ i.is_lt - -theorem last_pos : (0 : Fin (n + 2)) < last (n + 1) := Nat.succ_pos _ - -theorem eq_last_of_not_lt {i : Fin (n + 1)} (h : ¬(i : Nat) < n) : i = last n := - ext <| Nat.le_antisymm (le_last i) (Nat.not_lt.1 h) - -theorem val_lt_last {i : Fin (n + 1)} : i ≠ last n → (i : Nat) < n := - Decidable.not_imp_comm.1 eq_last_of_not_lt - -@[simp] theorem rev_last (n : Nat) : rev (last n) = 0 := ext <| by simp - -@[simp] theorem rev_zero (n : Nat) : rev 0 = last n := by - rw [← rev_rev (last _), rev_last] - -/-! ### addition, numerals, and coercion from Nat -/ - -@[simp] theorem val_one (n : Nat) : (1 : Fin (n + 2)).val = 1 := rfl - -@[simp] theorem mk_one : (⟨1, Nat.succ_lt_succ (Nat.succ_pos n)⟩ : Fin (n + 2)) = (1 : Fin _) := rfl - -theorem subsingleton_iff_le_one : Subsingleton (Fin n) ↔ n ≤ 1 := by - (match n with | 0 | 1 | n+2 => ?_) <;> try simp - · exact ⟨nofun⟩ - · exact ⟨fun ⟨0, _⟩ ⟨0, _⟩ => rfl⟩ - · exact iff_of_false (fun h => Fin.ne_of_lt zero_lt_one (h.elim ..)) (of_decide_eq_false rfl) - -instance subsingleton_zero : Subsingleton (Fin 0) := subsingleton_iff_le_one.2 (by decide) - -instance subsingleton_one : Subsingleton (Fin 1) := subsingleton_iff_le_one.2 (by decide) - -theorem fin_one_eq_zero (a : Fin 1) : a = 0 := Subsingleton.elim a 0 - -theorem add_def (a b : Fin n) : a + b = Fin.mk ((a + b) % n) (Nat.mod_lt _ a.size_pos) := rfl - -theorem val_add (a b : Fin n) : (a + b).val = (a.val + b.val) % n := rfl - -theorem val_add_one_of_lt {n : Nat} {i : Fin n.succ} (h : i < last _) : (i + 1).1 = i + 1 := by - match n with - | 0 => cases h - | n+1 => rw [val_add, val_one, Nat.mod_eq_of_lt (by exact Nat.succ_lt_succ h)] - -@[simp] theorem last_add_one : ∀ n, last n + 1 = 0 - | 0 => rfl - | n + 1 => by ext; rw [val_add, val_zero, val_last, val_one, Nat.mod_self] - -theorem val_add_one {n : Nat} (i : Fin (n + 1)) : - ((i + 1 : Fin (n + 1)) : Nat) = if i = last _ then (0 : Nat) else i + 1 := by - match Nat.eq_or_lt_of_le (le_last i) with - | .inl h => cases Fin.eq_of_val_eq h; simp - | .inr h => simpa [Fin.ne_of_lt h] using val_add_one_of_lt h - -@[simp] theorem val_two {n : Nat} : (2 : Fin (n + 3)).val = 2 := rfl - -theorem add_one_pos (i : Fin (n + 1)) (h : i < Fin.last n) : (0 : Fin (n + 1)) < i + 1 := by - match n with - | 0 => cases h - | n+1 => - rw [Fin.lt_def, val_last, ← Nat.add_lt_add_iff_right] at h - rw [Fin.lt_def, val_add, val_zero, val_one, Nat.mod_eq_of_lt h] - exact Nat.zero_lt_succ _ - -theorem one_pos : (0 : Fin (n + 2)) < 1 := Nat.succ_pos 0 - -theorem zero_ne_one : (0 : Fin (n + 2)) ≠ 1 := Fin.ne_of_lt one_pos - -/-! ### succ and casts into larger Fin types -/ - -@[simp] theorem val_succ (j : Fin n) : (j.succ : Nat) = j + 1 := rfl - -@[simp] theorem succ_pos (a : Fin n) : (0 : Fin (n + 1)) < a.succ := by - simp [Fin.lt_def, Nat.succ_pos] - -@[simp] theorem succ_le_succ_iff {a b : Fin n} : a.succ ≤ b.succ ↔ a ≤ b := Nat.succ_le_succ_iff - -@[simp] theorem succ_lt_succ_iff {a b : Fin n} : a.succ < b.succ ↔ a < b := Nat.succ_lt_succ_iff - -@[simp] theorem succ_inj {a b : Fin n} : a.succ = b.succ ↔ a = b := by - refine ⟨fun h => ext ?_, congrArg _⟩ - apply Nat.le_antisymm <;> exact succ_le_succ_iff.1 (h ▸ Nat.le_refl _) - -theorem succ_ne_zero {n} : ∀ k : Fin n, Fin.succ k ≠ 0 - | ⟨k, _⟩, heq => Nat.succ_ne_zero k <| ext_iff.1 heq - -@[simp] theorem succ_zero_eq_one : Fin.succ (0 : Fin (n + 1)) = 1 := rfl - -/-- Version of `succ_one_eq_two` to be used by `dsimp` -/ -@[simp] theorem succ_one_eq_two : Fin.succ (1 : Fin (n + 2)) = 2 := rfl - -@[simp] theorem succ_mk (n i : Nat) (h : i < n) : - Fin.succ ⟨i, h⟩ = ⟨i + 1, Nat.succ_lt_succ h⟩ := rfl - -theorem mk_succ_pos (i : Nat) (h : i < n) : - (0 : Fin (n + 1)) < ⟨i.succ, Nat.add_lt_add_right h 1⟩ := by - rw [lt_def, val_zero]; exact Nat.succ_pos i - -theorem one_lt_succ_succ (a : Fin n) : (1 : Fin (n + 2)) < a.succ.succ := by - let n+1 := n - rw [← succ_zero_eq_one, succ_lt_succ_iff]; exact succ_pos a - -@[simp] theorem add_one_lt_iff {n : Nat} {k : Fin (n + 2)} : k + 1 < k ↔ k = last _ := by - simp only [lt_def, val_add, val_last, ext_iff] - let ⟨k, hk⟩ := k - match Nat.eq_or_lt_of_le (Nat.le_of_lt_succ hk) with - | .inl h => cases h; simp [Nat.succ_pos] - | .inr hk' => simp [Nat.ne_of_lt hk', Nat.mod_eq_of_lt (Nat.succ_lt_succ hk'), Nat.le_succ] - -@[simp] theorem add_one_le_iff {n : Nat} : ∀ {k : Fin (n + 1)}, k + 1 ≤ k ↔ k = last _ := by - match n with - | 0 => - intro (k : Fin 1) - exact iff_of_true (Subsingleton.elim (α := Fin 1) (k+1) _ ▸ Nat.le_refl _) (fin_one_eq_zero ..) - | n + 1 => - intro (k : Fin (n+2)) - rw [← add_one_lt_iff, lt_def, le_def, Nat.lt_iff_le_and_ne, and_iff_left] - rw [val_add_one] - split <;> simp [*, (Nat.succ_ne_zero _).symm, Nat.ne_of_gt (Nat.lt_succ_self _)] - -@[simp] theorem last_le_iff {n : Nat} {k : Fin (n + 1)} : last n ≤ k ↔ k = last n := by - rw [ext_iff, Nat.le_antisymm_iff, le_def, and_iff_right (by apply le_last)] - -@[simp] theorem lt_add_one_iff {n : Nat} {k : Fin (n + 1)} : k < k + 1 ↔ k < last n := by - rw [← Decidable.not_iff_not]; simp - -@[simp] theorem le_zero_iff {n : Nat} {k : Fin (n + 1)} : k ≤ 0 ↔ k = 0 := - ⟨fun h => Fin.eq_of_val_eq <| Nat.eq_zero_of_le_zero h, (· ▸ Nat.le_refl _)⟩ - -theorem succ_succ_ne_one (a : Fin n) : Fin.succ (Fin.succ a) ≠ 1 := - Fin.ne_of_gt (one_lt_succ_succ a) - -@[simp] theorem coe_castLT (i : Fin m) (h : i.1 < n) : (castLT i h : Nat) = i := rfl - -@[simp] theorem castLT_mk (i n m : Nat) (hn : i < n) (hm : i < m) : castLT ⟨i, hn⟩ hm = ⟨i, hm⟩ := - rfl - -@[simp] theorem coe_castLE (h : n ≤ m) (i : Fin n) : (castLE h i : Nat) = i := rfl - -@[simp] theorem castLE_mk (i n m : Nat) (hn : i < n) (h : n ≤ m) : - castLE h ⟨i, hn⟩ = ⟨i, Nat.lt_of_lt_of_le hn h⟩ := rfl - -@[simp] theorem castLE_zero {n m : Nat} (h : n.succ ≤ m.succ) : castLE h 0 = 0 := by simp [ext_iff] - -@[simp] theorem castLE_succ {m n : Nat} (h : m + 1 ≤ n + 1) (i : Fin m) : - castLE h i.succ = (castLE (Nat.succ_le_succ_iff.mp h) i).succ := by simp [ext_iff] - -@[simp] theorem castLE_castLE {k m n} (km : k ≤ m) (mn : m ≤ n) (i : Fin k) : - Fin.castLE mn (Fin.castLE km i) = Fin.castLE (Nat.le_trans km mn) i := - Fin.ext (by simp only [coe_castLE]) - -@[simp] theorem castLE_comp_castLE {k m n} (km : k ≤ m) (mn : m ≤ n) : - Fin.castLE mn ∘ Fin.castLE km = Fin.castLE (Nat.le_trans km mn) := - funext (castLE_castLE km mn) - -@[simp] theorem coe_cast (h : n = m) (i : Fin n) : (cast h i : Nat) = i := rfl - -@[simp] theorem cast_last {n' : Nat} {h : n + 1 = n' + 1} : cast h (last n) = last n' := - ext (by rw [coe_cast, val_last, val_last, Nat.succ.inj h]) - -@[simp] theorem cast_mk (h : n = m) (i : Nat) (hn : i < n) : cast h ⟨i, hn⟩ = ⟨i, h ▸ hn⟩ := rfl - -@[simp] theorem cast_trans {k : Nat} (h : n = m) (h' : m = k) {i : Fin n} : - cast h' (cast h i) = cast (Eq.trans h h') i := rfl - -theorem castLE_of_eq {m n : Nat} (h : m = n) {h' : m ≤ n} : castLE h' = Fin.cast h := rfl - -@[simp] theorem coe_castAdd (m : Nat) (i : Fin n) : (castAdd m i : Nat) = i := rfl - -@[simp] theorem castAdd_zero : (castAdd 0 : Fin n → Fin (n + 0)) = cast rfl := rfl - -theorem castAdd_lt {m : Nat} (n : Nat) (i : Fin m) : (castAdd n i : Nat) < m := by simp - -@[simp] theorem castAdd_mk (m : Nat) (i : Nat) (h : i < n) : - castAdd m ⟨i, h⟩ = ⟨i, Nat.lt_add_right m h⟩ := rfl - -@[simp] theorem castAdd_castLT (m : Nat) (i : Fin (n + m)) (hi : i.val < n) : - castAdd m (castLT i hi) = i := rfl - -@[simp] theorem castLT_castAdd (m : Nat) (i : Fin n) : - castLT (castAdd m i) (castAdd_lt m i) = i := rfl - -/-- For rewriting in the reverse direction, see `Fin.cast_castAdd_left`. -/ -theorem castAdd_cast {n n' : Nat} (m : Nat) (i : Fin n') (h : n' = n) : - castAdd m (Fin.cast h i) = Fin.cast (congrArg (. + m) h) (castAdd m i) := ext rfl - -theorem cast_castAdd_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) : - cast h (castAdd m i) = castAdd m (cast (Nat.add_right_cancel h) i) := rfl - -@[simp] theorem cast_castAdd_right {n m m' : Nat} (i : Fin n) (h : n + m' = n + m) : - cast h (castAdd m' i) = castAdd m i := rfl - -theorem castAdd_castAdd {m n p : Nat} (i : Fin m) : - castAdd p (castAdd n i) = cast (Nat.add_assoc ..).symm (castAdd (n + p) i) := rfl - -/-- The cast of the successor is the successor of the cast. See `Fin.succ_cast_eq` for rewriting in -the reverse direction. -/ -@[simp] theorem cast_succ_eq {n' : Nat} (i : Fin n) (h : n.succ = n'.succ) : - cast h i.succ = (cast (Nat.succ.inj h) i).succ := rfl - -theorem succ_cast_eq {n' : Nat} (i : Fin n) (h : n = n') : - (cast h i).succ = cast (by rw [h]) i.succ := rfl - -@[simp] theorem coe_castSucc (i : Fin n) : (Fin.castSucc i : Nat) = i := rfl - -@[simp] theorem castSucc_mk (n i : Nat) (h : i < n) : castSucc ⟨i, h⟩ = ⟨i, Nat.lt.step h⟩ := rfl - -@[simp] theorem cast_castSucc {n' : Nat} {h : n + 1 = n' + 1} {i : Fin n} : - cast h (castSucc i) = castSucc (cast (Nat.succ.inj h) i) := rfl - -theorem castSucc_lt_succ (i : Fin n) : Fin.castSucc i < i.succ := - lt_def.2 <| by simp only [coe_castSucc, val_succ, Nat.lt_succ_self] - -theorem le_castSucc_iff {i : Fin (n + 1)} {j : Fin n} : i ≤ Fin.castSucc j ↔ i < j.succ := by - simpa [lt_def, le_def] using Nat.succ_le_succ_iff.symm - -theorem castSucc_lt_iff_succ_le {n : Nat} {i : Fin n} {j : Fin (n + 1)} : - Fin.castSucc i < j ↔ i.succ ≤ j := .rfl - -@[simp] theorem succ_last (n : Nat) : (last n).succ = last n.succ := rfl - -@[simp] theorem succ_eq_last_succ {n : Nat} (i : Fin n.succ) : - i.succ = last (n + 1) ↔ i = last n := by rw [← succ_last, succ_inj] - -@[simp] theorem castSucc_castLT (i : Fin (n + 1)) (h : (i : Nat) < n) : - castSucc (castLT i h) = i := rfl - -@[simp] theorem castLT_castSucc {n : Nat} (a : Fin n) (h : (a : Nat) < n) : - castLT (castSucc a) h = a := rfl - -@[simp] theorem castSucc_lt_castSucc_iff {a b : Fin n} : - Fin.castSucc a < Fin.castSucc b ↔ a < b := .rfl - -theorem castSucc_inj {a b : Fin n} : castSucc a = castSucc b ↔ a = b := by simp [ext_iff] - -theorem castSucc_lt_last (a : Fin n) : castSucc a < last n := a.is_lt - -@[simp] theorem castSucc_zero : castSucc (0 : Fin (n + 1)) = 0 := rfl - -@[simp] theorem castSucc_one {n : Nat} : castSucc (1 : Fin (n + 2)) = 1 := rfl - -/-- `castSucc i` is positive when `i` is positive -/ -theorem castSucc_pos {i : Fin (n + 1)} (h : 0 < i) : 0 < castSucc i := by - simpa [lt_def] using h - -@[simp] theorem castSucc_eq_zero_iff (a : Fin (n + 1)) : castSucc a = 0 ↔ a = 0 := by simp [ext_iff] - -theorem castSucc_ne_zero_iff (a : Fin (n + 1)) : castSucc a ≠ 0 ↔ a ≠ 0 := - not_congr <| castSucc_eq_zero_iff a - -theorem castSucc_fin_succ (n : Nat) (j : Fin n) : - castSucc (Fin.succ j) = Fin.succ (castSucc j) := by simp [Fin.ext_iff] - -@[simp] -theorem coeSucc_eq_succ {a : Fin n} : castSucc a + 1 = a.succ := by - cases n - · exact a.elim0 - · simp [ext_iff, add_def, Nat.mod_eq_of_lt (Nat.succ_lt_succ a.is_lt)] - -theorem lt_succ {a : Fin n} : castSucc a < a.succ := by - rw [castSucc, lt_def, coe_castAdd, val_succ]; exact Nat.lt_succ_self a.val - -theorem exists_castSucc_eq {n : Nat} {i : Fin (n + 1)} : (∃ j, castSucc j = i) ↔ i ≠ last n := - ⟨fun ⟨j, hj⟩ => hj ▸ Fin.ne_of_lt j.castSucc_lt_last, - fun hi => ⟨i.castLT <| Fin.val_lt_last hi, rfl⟩⟩ - -theorem succ_castSucc {n : Nat} (i : Fin n) : i.castSucc.succ = castSucc i.succ := rfl - -@[simp] theorem coe_addNat (m : Nat) (i : Fin n) : (addNat i m : Nat) = i + m := rfl - -@[simp] theorem addNat_one {i : Fin n} : addNat i 1 = i.succ := rfl - -theorem le_coe_addNat (m : Nat) (i : Fin n) : m ≤ addNat i m := - Nat.le_add_left _ _ - -@[simp] theorem addNat_mk (n i : Nat) (hi : i < m) : - addNat ⟨i, hi⟩ n = ⟨i + n, Nat.add_lt_add_right hi n⟩ := rfl - -@[simp] theorem cast_addNat_zero {n n' : Nat} (i : Fin n) (h : n + 0 = n') : - cast h (addNat i 0) = cast ((Nat.add_zero _).symm.trans h) i := rfl - -/-- For rewriting in the reverse direction, see `Fin.cast_addNat_left`. -/ -theorem addNat_cast {n n' m : Nat} (i : Fin n') (h : n' = n) : - addNat (cast h i) m = cast (congrArg (. + m) h) (addNat i m) := rfl - -theorem cast_addNat_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) : - cast h (addNat i m) = addNat (cast (Nat.add_right_cancel h) i) m := rfl - -@[simp] theorem cast_addNat_right {n m m' : Nat} (i : Fin n) (h : n + m' = n + m) : - cast h (addNat i m') = addNat i m := - ext <| (congrArg ((· + ·) (i : Nat)) (Nat.add_left_cancel h) : _) - -@[simp] theorem coe_natAdd (n : Nat) {m : Nat} (i : Fin m) : (natAdd n i : Nat) = n + i := rfl - -@[simp] theorem natAdd_mk (n i : Nat) (hi : i < m) : - natAdd n ⟨i, hi⟩ = ⟨n + i, Nat.add_lt_add_left hi n⟩ := rfl - -theorem le_coe_natAdd (m : Nat) (i : Fin n) : m ≤ natAdd m i := Nat.le_add_right .. - -theorem natAdd_zero {n : Nat} : natAdd 0 = cast (Nat.zero_add n).symm := by ext; simp - -/-- For rewriting in the reverse direction, see `Fin.cast_natAdd_right`. -/ -theorem natAdd_cast {n n' : Nat} (m : Nat) (i : Fin n') (h : n' = n) : - natAdd m (cast h i) = cast (congrArg _ h) (natAdd m i) := rfl - -theorem cast_natAdd_right {n n' m : Nat} (i : Fin n') (h : m + n' = m + n) : - cast h (natAdd m i) = natAdd m (cast (Nat.add_left_cancel h) i) := rfl - -@[simp] theorem cast_natAdd_left {n m m' : Nat} (i : Fin n) (h : m' + n = m + n) : - cast h (natAdd m' i) = natAdd m i := - ext <| (congrArg (· + (i : Nat)) (Nat.add_right_cancel h) : _) - -theorem castAdd_natAdd (p m : Nat) {n : Nat} (i : Fin n) : - castAdd p (natAdd m i) = cast (Nat.add_assoc ..).symm (natAdd m (castAdd p i)) := rfl - -theorem natAdd_castAdd (p m : Nat) {n : Nat} (i : Fin n) : - natAdd m (castAdd p i) = cast (Nat.add_assoc ..) (castAdd p (natAdd m i)) := rfl - -theorem natAdd_natAdd (m n : Nat) {p : Nat} (i : Fin p) : - natAdd m (natAdd n i) = cast (Nat.add_assoc ..) (natAdd (m + n) i) := - ext <| (Nat.add_assoc ..).symm - -@[simp] -theorem cast_natAdd_zero {n n' : Nat} (i : Fin n) (h : 0 + n = n') : - cast h (natAdd 0 i) = cast ((Nat.zero_add _).symm.trans h) i := - ext <| Nat.zero_add _ - -@[simp] -theorem cast_natAdd (n : Nat) {m : Nat} (i : Fin m) : - cast (Nat.add_comm ..) (natAdd n i) = addNat i n := ext <| Nat.add_comm .. - -@[simp] -theorem cast_addNat {n : Nat} (m : Nat) (i : Fin n) : - cast (Nat.add_comm ..) (addNat i m) = natAdd m i := ext <| Nat.add_comm .. - -@[simp] theorem natAdd_last {m n : Nat} : natAdd n (last m) = last (n + m) := rfl - -theorem natAdd_castSucc {m n : Nat} {i : Fin m} : natAdd n (castSucc i) = castSucc (natAdd n i) := - rfl - -theorem rev_castAdd (k : Fin n) (m : Nat) : rev (castAdd m k) = addNat (rev k) m := ext <| by - rw [val_rev, coe_castAdd, coe_addNat, val_rev, Nat.sub_add_comm (Nat.succ_le_of_lt k.is_lt)] - -theorem rev_addNat (k : Fin n) (m : Nat) : rev (addNat k m) = castAdd m (rev k) := by - rw [← rev_rev (castAdd ..), rev_castAdd, rev_rev] - -theorem rev_castSucc (k : Fin n) : rev (castSucc k) = succ (rev k) := k.rev_castAdd 1 - -theorem rev_succ (k : Fin n) : rev (succ k) = castSucc (rev k) := k.rev_addNat 1 - -/-! ### pred -/ - -@[simp] theorem coe_pred (j : Fin (n + 1)) (h : j ≠ 0) : (j.pred h : Nat) = j - 1 := rfl - -@[simp] theorem succ_pred : ∀ (i : Fin (n + 1)) (h : i ≠ 0), (i.pred h).succ = i - | ⟨0, h⟩, hi => by simp only [mk_zero, ne_eq, not_true] at hi - | ⟨n + 1, h⟩, hi => rfl - -@[simp] -theorem pred_succ (i : Fin n) {h : i.succ ≠ 0} : i.succ.pred h = i := by - cases i - rfl - -theorem pred_eq_iff_eq_succ {n : Nat} (i : Fin (n + 1)) (hi : i ≠ 0) (j : Fin n) : - i.pred hi = j ↔ i = j.succ := - ⟨fun h => by simp only [← h, Fin.succ_pred], fun h => by simp only [h, Fin.pred_succ]⟩ - -theorem pred_mk_succ (i : Nat) (h : i < n + 1) : - Fin.pred ⟨i + 1, Nat.add_lt_add_right h 1⟩ (ne_of_val_ne (Nat.ne_of_gt (mk_succ_pos i h))) = - ⟨i, h⟩ := by - simp only [ext_iff, coe_pred, Nat.add_sub_cancel] - -@[simp] theorem pred_mk_succ' (i : Nat) (h₁ : i + 1 < n + 1 + 1) (h₂) : - Fin.pred ⟨i + 1, h₁⟩ h₂ = ⟨i, Nat.lt_of_succ_lt_succ h₁⟩ := pred_mk_succ i _ - --- This is not a simp theorem by default, because `pred_mk_succ` is nicer when it applies. -theorem pred_mk {n : Nat} (i : Nat) (h : i < n + 1) (w) : Fin.pred ⟨i, h⟩ w = - ⟨i - 1, Nat.sub_lt_right_of_lt_add (Nat.pos_iff_ne_zero.2 (Fin.val_ne_of_ne w)) h⟩ := - rfl - -@[simp] theorem pred_le_pred_iff {n : Nat} {a b : Fin n.succ} {ha : a ≠ 0} {hb : b ≠ 0} : - a.pred ha ≤ b.pred hb ↔ a ≤ b := by rw [← succ_le_succ_iff, succ_pred, succ_pred] - -@[simp] theorem pred_lt_pred_iff {n : Nat} {a b : Fin n.succ} {ha : a ≠ 0} {hb : b ≠ 0} : - a.pred ha < b.pred hb ↔ a < b := by rw [← succ_lt_succ_iff, succ_pred, succ_pred] - -@[simp] theorem pred_inj : - ∀ {a b : Fin (n + 1)} {ha : a ≠ 0} {hb : b ≠ 0}, a.pred ha = b.pred hb ↔ a = b - | ⟨0, _⟩, _, ha, _ => by simp only [mk_zero, ne_eq, not_true] at ha - | ⟨i + 1, _⟩, ⟨0, _⟩, _, hb => by simp only [mk_zero, ne_eq, not_true] at hb - | ⟨i + 1, hi⟩, ⟨j + 1, hj⟩, ha, hb => by simp [ext_iff] - -@[simp] theorem pred_one {n : Nat} : - Fin.pred (1 : Fin (n + 2)) (Ne.symm (Fin.ne_of_lt one_pos)) = 0 := rfl - -theorem pred_add_one (i : Fin (n + 2)) (h : (i : Nat) < n + 1) : - pred (i + 1) (Fin.ne_of_gt (add_one_pos _ (lt_def.2 h))) = castLT i h := by - rw [ext_iff, coe_pred, coe_castLT, val_add, val_one, Nat.mod_eq_of_lt, Nat.add_sub_cancel] - exact Nat.add_lt_add_right h 1 - -@[simp] theorem coe_subNat (i : Fin (n + m)) (h : m ≤ i) : (i.subNat m h : Nat) = i - m := rfl - -@[simp] theorem subNat_mk {i : Nat} (h₁ : i < n + m) (h₂ : m ≤ i) : - subNat m ⟨i, h₁⟩ h₂ = ⟨i - m, Nat.sub_lt_right_of_lt_add h₂ h₁⟩ := rfl - -@[simp] theorem pred_castSucc_succ (i : Fin n) : - pred (castSucc i.succ) (Fin.ne_of_gt (castSucc_pos i.succ_pos)) = castSucc i := rfl - -@[simp] theorem addNat_subNat {i : Fin (n + m)} (h : m ≤ i) : addNat (subNat m i h) m = i := - ext <| Nat.sub_add_cancel h - -@[simp] theorem subNat_addNat (i : Fin n) (m : Nat) (h : m ≤ addNat i m := le_coe_addNat m i) : - subNat m (addNat i m) h = i := ext <| Nat.add_sub_cancel i m - -@[simp] theorem natAdd_subNat_cast {i : Fin (n + m)} (h : n ≤ i) : - natAdd n (subNat n (cast (Nat.add_comm ..) i) h) = i := by simp [← cast_addNat]; rfl - -/-! ### recursion and induction principles -/ - -/-- Define `motive n i` by induction on `i : Fin n` interpreted as `(0 : Fin (n - i)).succ.succ…`. -This function has two arguments: `zero n` defines `0`-th element `motive (n+1) 0` of an -`(n+1)`-tuple, and `succ n i` defines `(i+1)`-st element of `(n+1)`-tuple based on `n`, `i`, and -`i`-th element of `n`-tuple. -/ --- FIXME: Performance review -@[elab_as_elim] def succRec {motive : ∀ n, Fin n → Sort _} - (zero : ∀ n, motive n.succ (0 : Fin (n + 1))) - (succ : ∀ n i, motive n i → motive n.succ i.succ) : ∀ {n : Nat} (i : Fin n), motive n i - | 0, i => i.elim0 - | Nat.succ n, ⟨0, _⟩ => by rw [mk_zero]; exact zero n - | Nat.succ _, ⟨Nat.succ i, h⟩ => succ _ _ (succRec zero succ ⟨i, Nat.lt_of_succ_lt_succ h⟩) - -/-- Define `motive n i` by induction on `i : Fin n` interpreted as `(0 : Fin (n - i)).succ.succ…`. -This function has two arguments: -`zero n` defines the `0`-th element `motive (n+1) 0` of an `(n+1)`-tuple, and -`succ n i` defines the `(i+1)`-st element of an `(n+1)`-tuple based on `n`, `i`, -and the `i`-th element of an `n`-tuple. - -A version of `Fin.succRec` taking `i : Fin n` as the first argument. -/ --- FIXME: Performance review -@[elab_as_elim] def succRecOn {n : Nat} (i : Fin n) {motive : ∀ n, Fin n → Sort _} - (zero : ∀ n, motive (n + 1) 0) (succ : ∀ n i, motive n i → motive (Nat.succ n) i.succ) : - motive n i := i.succRec zero succ - -@[simp] theorem succRecOn_zero {motive : ∀ n, Fin n → Sort _} {zero succ} (n) : - @Fin.succRecOn (n + 1) 0 motive zero succ = zero n := by - cases n <;> rfl - -@[simp] theorem succRecOn_succ {motive : ∀ n, Fin n → Sort _} {zero succ} {n} (i : Fin n) : - @Fin.succRecOn (n + 1) i.succ motive zero succ = succ n i (Fin.succRecOn i zero succ) := by - cases i; rfl - -/-- Define `motive i` by induction on `i : Fin (n + 1)` via induction on the underlying `Nat` value. -This function has two arguments: `zero` handles the base case on `motive 0`, -and `succ` defines the inductive step using `motive i.castSucc`. --/ --- FIXME: Performance review -@[elab_as_elim] def induction {motive : Fin (n + 1) → Sort _} (zero : motive 0) - (succ : ∀ i : Fin n, motive (castSucc i) → motive i.succ) : - ∀ i : Fin (n + 1), motive i - | ⟨0, hi⟩ => by rwa [Fin.mk_zero] - | ⟨i+1, hi⟩ => succ ⟨i, Nat.lt_of_succ_lt_succ hi⟩ (induction zero succ ⟨i, Nat.lt_of_succ_lt hi⟩) - -@[simp] theorem induction_zero {motive : Fin (n + 1) → Sort _} (zero : motive 0) - (hs : ∀ i : Fin n, motive (castSucc i) → motive i.succ) : - (induction zero hs : ∀ i : Fin (n + 1), motive i) 0 = zero := rfl - -@[simp] theorem induction_succ {motive : Fin (n + 1) → Sort _} (zero : motive 0) - (succ : ∀ i : Fin n, motive (castSucc i) → motive i.succ) (i : Fin n) : - induction (motive := motive) zero succ i.succ = succ i (induction zero succ (castSucc i)) := rfl - -/-- Define `motive i` by induction on `i : Fin (n + 1)` via induction on the underlying `Nat` value. -This function has two arguments: `zero` handles the base case on `motive 0`, -and `succ` defines the inductive step using `motive i.castSucc`. - -A version of `Fin.induction` taking `i : Fin (n + 1)` as the first argument. --/ --- FIXME: Performance review -@[elab_as_elim] def inductionOn (i : Fin (n + 1)) {motive : Fin (n + 1) → Sort _} (zero : motive 0) - (succ : ∀ i : Fin n, motive (castSucc i) → motive i.succ) : motive i := induction zero succ i - -/-- Define `f : Π i : Fin n.succ, motive i` by separately handling the cases `i = 0` and -`i = j.succ`, `j : Fin n`. -/ -@[elab_as_elim] def cases {motive : Fin (n + 1) → Sort _} - (zero : motive 0) (succ : ∀ i : Fin n, motive i.succ) : - ∀ i : Fin (n + 1), motive i := induction zero fun i _ => succ i - -@[simp] theorem cases_zero {n} {motive : Fin (n + 1) → Sort _} {zero succ} : - @Fin.cases n motive zero succ 0 = zero := rfl - -@[simp] theorem cases_succ {n} {motive : Fin (n + 1) → Sort _} {zero succ} (i : Fin n) : - @Fin.cases n motive zero succ i.succ = succ i := rfl - -@[simp] theorem cases_succ' {n} {motive : Fin (n + 1) → Sort _} {zero succ} - {i : Nat} (h : i + 1 < n + 1) : - @Fin.cases n motive zero succ ⟨i.succ, h⟩ = succ ⟨i, Nat.lt_of_succ_lt_succ h⟩ := rfl - -theorem forall_fin_succ {P : Fin (n + 1) → Prop} : (∀ i, P i) ↔ P 0 ∧ ∀ i : Fin n, P i.succ := - ⟨fun H => ⟨H 0, fun _ => H _⟩, fun ⟨H0, H1⟩ i => Fin.cases H0 H1 i⟩ - -theorem exists_fin_succ {P : Fin (n + 1) → Prop} : (∃ i, P i) ↔ P 0 ∨ ∃ i : Fin n, P i.succ := - ⟨fun ⟨i, h⟩ => Fin.cases Or.inl (fun i hi => Or.inr ⟨i, hi⟩) i h, fun h => - (h.elim fun h => ⟨0, h⟩) fun ⟨i, hi⟩ => ⟨i.succ, hi⟩⟩ - -theorem forall_fin_one {p : Fin 1 → Prop} : (∀ i, p i) ↔ p 0 := - ⟨fun h => h _, fun h i => Subsingleton.elim i 0 ▸ h⟩ - -theorem exists_fin_one {p : Fin 1 → Prop} : (∃ i, p i) ↔ p 0 := - ⟨fun ⟨i, h⟩ => Subsingleton.elim i 0 ▸ h, fun h => ⟨_, h⟩⟩ - -theorem forall_fin_two {p : Fin 2 → Prop} : (∀ i, p i) ↔ p 0 ∧ p 1 := - forall_fin_succ.trans <| and_congr_right fun _ => forall_fin_one - -theorem exists_fin_two {p : Fin 2 → Prop} : (∃ i, p i) ↔ p 0 ∨ p 1 := - exists_fin_succ.trans <| or_congr_right exists_fin_one - -theorem fin_two_eq_of_eq_zero_iff : ∀ {a b : Fin 2}, (a = 0 ↔ b = 0) → a = b := by - simp only [forall_fin_two]; decide - -/-- -Define `motive i` by reverse induction on `i : Fin (n + 1)` via induction on the underlying `Nat` -value. This function has two arguments: `last` handles the base case on `motive (Fin.last n)`, -and `cast` defines the inductive step using `motive i.succ`, inducting downwards. --/ -@[elab_as_elim] def reverseInduction {motive : Fin (n + 1) → Sort _} (last : motive (Fin.last n)) - (cast : ∀ i : Fin n, motive i.succ → motive (castSucc i)) (i : Fin (n + 1)) : motive i := - if hi : i = Fin.last n then _root_.cast (congrArg motive hi.symm) last - else - let j : Fin n := ⟨i, Nat.lt_of_le_of_ne (Nat.le_of_lt_succ i.2) fun h => hi (Fin.ext h)⟩ - cast _ (reverseInduction last cast j.succ) -termination_by n + 1 - i -decreasing_by decreasing_with - -- FIXME: we put the proof down here to avoid getting a dummy `have` in the definition - exact Nat.add_sub_add_right .. ▸ Nat.sub_lt_sub_left i.2 (Nat.lt_succ_self i) - -@[simp] theorem reverseInduction_last {n : Nat} {motive : Fin (n + 1) → Sort _} {zero succ} : - (reverseInduction zero succ (Fin.last n) : motive (Fin.last n)) = zero := by - rw [reverseInduction]; simp; rfl - -@[simp] theorem reverseInduction_castSucc {n : Nat} {motive : Fin (n + 1) → Sort _} {zero succ} - (i : Fin n) : reverseInduction (motive := motive) zero succ (castSucc i) = - succ i (reverseInduction zero succ i.succ) := by - rw [reverseInduction, dif_neg (Fin.ne_of_lt (Fin.castSucc_lt_last i))]; rfl - -/-- Define `f : Π i : Fin n.succ, motive i` by separately handling the cases `i = Fin.last n` and -`i = j.castSucc`, `j : Fin n`. -/ -@[elab_as_elim] def lastCases {n : Nat} {motive : Fin (n + 1) → Sort _} (last : motive (Fin.last n)) - (cast : ∀ i : Fin n, motive (castSucc i)) (i : Fin (n + 1)) : motive i := - reverseInduction last (fun i _ => cast i) i - -@[simp] theorem lastCases_last {n : Nat} {motive : Fin (n + 1) → Sort _} {last cast} : - (Fin.lastCases last cast (Fin.last n) : motive (Fin.last n)) = last := - reverseInduction_last .. - -@[simp] theorem lastCases_castSucc {n : Nat} {motive : Fin (n + 1) → Sort _} {last cast} - (i : Fin n) : (Fin.lastCases last cast (Fin.castSucc i) : motive (Fin.castSucc i)) = cast i := - reverseInduction_castSucc .. - -/-- Define `f : Π i : Fin (m + n), motive i` by separately handling the cases `i = castAdd n i`, -`j : Fin m` and `i = natAdd m j`, `j : Fin n`. -/ -@[elab_as_elim] def addCases {m n : Nat} {motive : Fin (m + n) → Sort u} - (left : ∀ i, motive (castAdd n i)) (right : ∀ i, motive (natAdd m i)) - (i : Fin (m + n)) : motive i := - if hi : (i : Nat) < m then (castAdd_castLT n i hi) ▸ (left (castLT i hi)) - else (natAdd_subNat_cast (Nat.le_of_not_lt hi)) ▸ (right _) - -@[simp] theorem addCases_left {m n : Nat} {motive : Fin (m + n) → Sort _} {left right} (i : Fin m) : - addCases (motive := motive) left right (Fin.castAdd n i) = left i := by - rw [addCases, dif_pos (castAdd_lt _ _)]; rfl - -@[simp] -theorem addCases_right {m n : Nat} {motive : Fin (m + n) → Sort _} {left right} (i : Fin n) : - addCases (motive := motive) left right (natAdd m i) = right i := by - have : ¬(natAdd m i : Nat) < m := Nat.not_lt.2 (le_coe_natAdd ..) - rw [addCases, dif_neg this]; exact eq_of_heq <| (eqRec_heq _ _).trans (by congr 1; simp) - -/-! ### clamp -/ - -@[simp] theorem coe_clamp (n m : Nat) : (clamp n m : Nat) = min n m := rfl - -/-! ### add -/ - -@[simp] theorem ofNat'_add (x : Nat) (lt : 0 < n) (y : Fin n) : - Fin.ofNat' x lt + y = Fin.ofNat' (x + y.val) lt := by - apply Fin.eq_of_val_eq - simp [Fin.ofNat', Fin.add_def] - -@[simp] theorem add_ofNat' (x : Fin n) (y : Nat) (lt : 0 < n) : - x + Fin.ofNat' y lt = Fin.ofNat' (x.val + y) lt := by - apply Fin.eq_of_val_eq - simp [Fin.ofNat', Fin.add_def] - -/-! ### sub -/ - -protected theorem coe_sub (a b : Fin n) : ((a - b : Fin n) : Nat) = (a + (n - b)) % n := by - cases a; cases b; rfl - -@[simp] theorem ofNat'_sub (x : Nat) (lt : 0 < n) (y : Fin n) : - Fin.ofNat' x lt - y = Fin.ofNat' (x + (n - y.val)) lt := by - apply Fin.eq_of_val_eq - simp [Fin.ofNat', Fin.sub_def] - -@[simp] theorem sub_ofNat' (x : Fin n) (y : Nat) (lt : 0 < n) : - x - Fin.ofNat' y lt = Fin.ofNat' (x.val + (n - y % n)) lt := by - apply Fin.eq_of_val_eq - simp [Fin.ofNat', Fin.sub_def] - -private theorem _root_.Nat.mod_eq_sub_of_lt_two_mul {x n} (h₁ : n ≤ x) (h₂ : x < 2 * n) : - x % n = x - n := by - rw [Nat.mod_eq, if_pos (by omega), Nat.mod_eq_of_lt (by omega)] - -theorem coe_sub_iff_le {a b : Fin n} : (↑(a - b) : Nat) = a - b ↔ b ≤ a := by - rw [sub_def, le_def] - dsimp only - if h : n ≤ a + (n - b) then - rw [Nat.mod_eq_sub_of_lt_two_mul h] - all_goals omega - else - rw [Nat.mod_eq_of_lt] - all_goals omega - -theorem coe_sub_iff_lt {a b : Fin n} : (↑(a - b) : Nat) = n + a - b ↔ a < b := by - rw [sub_def, lt_def] - dsimp only - if h : n ≤ a + (n - b) then - rw [Nat.mod_eq_sub_of_lt_two_mul h] - all_goals omega - else - rw [Nat.mod_eq_of_lt] - all_goals omega - -/-! ### mul -/ - -theorem val_mul {n : Nat} : ∀ a b : Fin n, (a * b).val = a.val * b.val % n - | ⟨_, _⟩, ⟨_, _⟩ => rfl - -theorem coe_mul {n : Nat} : ∀ a b : Fin n, ((a * b : Fin n) : Nat) = a * b % n - | ⟨_, _⟩, ⟨_, _⟩ => rfl - -protected theorem mul_one (k : Fin (n + 1)) : k * 1 = k := by - match n with - | 0 => exact Subsingleton.elim (α := Fin 1) .. - | n+1 => simp [ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)] - -protected theorem mul_comm (a b : Fin n) : a * b = b * a := - ext <| by rw [mul_def, mul_def, Nat.mul_comm] - -protected theorem one_mul (k : Fin (n + 1)) : (1 : Fin (n + 1)) * k = k := by - rw [Fin.mul_comm, Fin.mul_one] - -protected theorem mul_zero (k : Fin (n + 1)) : k * 0 = 0 := by simp [ext_iff, mul_def] - -protected theorem zero_mul (k : Fin (n + 1)) : (0 : Fin (n + 1)) * k = 0 := by - simp [ext_iff, mul_def] - -end Fin - -namespace USize - -@[simp] theorem lt_def {a b : USize} : a < b ↔ a.toNat < b.toNat := .rfl - -@[simp] theorem le_def {a b : USize} : a ≤ b ↔ a.toNat ≤ b.toNat := .rfl - -@[simp] theorem zero_toNat : (0 : USize).toNat = 0 := Nat.zero_mod _ - -@[simp] theorem mod_toNat (a b : USize) : (a % b).toNat = a.toNat % b.toNat := - Fin.mod_val .. - -@[simp] theorem div_toNat (a b : USize) : (a / b).toNat = a.toNat / b.toNat := - Fin.div_val .. - -@[simp] theorem modn_toNat (a : USize) (b : Nat) : (a.modn b).toNat = a.toNat % b := - Fin.modn_val .. - -theorem mod_lt (a b : USize) (h : 0 < b) : a % b < b := USize.modn_lt _ (by simp at h; exact h) - -theorem toNat.inj : ∀ {a b : USize}, a.toNat = b.toNat → a = b - | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl - -end USize +attribute [norm_cast] val_last diff --git a/Std/Data/Int/Gcd.lean b/Std/Data/Int/Gcd.lean index 2e12ac3e86..a825845693 100644 --- a/Std/Data/Int/Gcd.lean +++ b/Std/Data/Int/Gcd.lean @@ -5,7 +5,6 @@ Authors: Scott Morrison -/ import Std.Data.Int.DivMod import Std.Data.Nat.Gcd -import Std.Tactic.Simpa /-! # Results about `Int.gcd`. diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 7370f269e4..dca73ed145 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -10,7 +10,6 @@ import Std.Data.Nat.Lemmas import Std.Data.List.Basic import Std.Data.Option.Lemmas import Std.Classes.BEq -import Std.Tactic.Simpa namespace List diff --git a/Std/Data/Nat.lean b/Std/Data/Nat.lean index 6fd2edd7ca..3ae228fe3e 100644 --- a/Std/Data/Nat.lean +++ b/Std/Data/Nat.lean @@ -1,5 +1,4 @@ import Std.Data.Nat.Basic -import Std.Data.Nat.Bitwise import Std.Data.Nat.Gcd import Std.Data.Nat.Init.Basic import Std.Data.Nat.Lemmas diff --git a/Std/Data/Nat/Basic.lean b/Std/Data/Nat/Basic.lean index 155bf0d2c9..aaa4e6bfed 100644 --- a/Std/Data/Nat/Basic.lean +++ b/Std/Data/Nat/Basic.lean @@ -122,12 +122,3 @@ where else guess termination_by guess - -/-! -### testBit -We define an operation for testing individual bits in the binary representation -of a number. --/ - -/-- `testBit m n` returns whether the `(n+1)` least significant bit is `1` or `0`-/ -def testBit (m n : Nat) : Bool := (m >>> n) &&& 1 != 0 diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean deleted file mode 100644 index ddf2f7c112..0000000000 --- a/Std/Data/Nat/Bitwise.lean +++ /dev/null @@ -1,497 +0,0 @@ -/- -Copyright (c) 2023 by the authors listed in the file AUTHORS and their -institutional affiliations. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix --/ - -/- -This module defines properties of the bitwise operations on Natural numbers. - -It is primarily intended to support the bitvector library. --/ -import Std.Data.Nat.Basic -import Std.Tactic.Simpa -import Std.Tactic.Basic - -namespace Nat - -@[local simp] -private theorem one_div_two : 1/2 = 0 := by trivial - -private theorem two_pow_succ_sub_succ_div_two : (2 ^ (n+1) - (x + 1)) / 2 = 2^n - (x/2 + 1) := by - if h : x + 1 ≤ 2 ^ (n + 1) then - apply fun x => (Nat.sub_eq_of_eq_add x).symm - apply Eq.trans _ - apply Nat.add_mul_div_left _ _ Nat.zero_lt_two - rw [← Nat.sub_add_comm h] - rw [Nat.add_sub_assoc (by omega)] - rw [Nat.pow_succ'] - rw [Nat.mul_add_div Nat.zero_lt_two] - simp [show (2 * (x / 2 + 1) - (x + 1)) / 2 = 0 by omega] - else - rw [Nat.pow_succ'] at * - omega - -private theorem two_pow_succ_sub_one_div_two : (2 ^ (n+1) - 1) / 2 = 2^n - 1 := - two_pow_succ_sub_succ_div_two - -private theorem two_mul_sub_one {n : Nat} (n_pos : n > 0) : (2*n - 1) % 2 = 1 := by - match n with - | 0 => contradiction - | n + 1 => simp [Nat.mul_succ, Nat.mul_add_mod, mod_eq_of_lt] - -/-! ### Preliminaries -/ - -/-- -An induction principal that works on divison by two. --/ -noncomputable def div2Induction {motive : Nat → Sort u} - (n : Nat) (ind : ∀(n : Nat), (n > 0 → motive (n/2)) → motive n) : motive n := by - induction n using Nat.strongInductionOn with - | ind n hyp => - apply ind - intro n_pos - if n_eq : n = 0 then - simp [n_eq] at n_pos - else - apply hyp - exact Nat.div_lt_self n_pos (Nat.le_refl _) - -@[simp] theorem zero_and (x : Nat) : 0 &&& x = 0 := by rfl - -@[simp] theorem and_zero (x : Nat) : x &&& 0 = 0 := by - simp only [HAnd.hAnd, AndOp.and, land] - unfold bitwise - simp - -@[simp] theorem and_one_is_mod (x : Nat) : x &&& 1 = x % 2 := by - if xz : x = 0 then - simp [xz, zero_and] - else - have andz := and_zero (x/2) - simp only [HAnd.hAnd, AndOp.and, land] at andz - simp only [HAnd.hAnd, AndOp.and, land] - unfold bitwise - cases mod_two_eq_zero_or_one x with | _ p => - simp [xz, p, andz, one_div_two, mod_eq_of_lt] - -/-! ### testBit -/ - -@[simp] theorem zero_testBit (i : Nat) : testBit 0 i = false := by - simp only [testBit, zero_shiftRight, zero_and, bne_self_eq_false] - -@[simp] theorem testBit_zero (x : Nat) : testBit x 0 = decide (x % 2 = 1) := by - cases mod_two_eq_zero_or_one x with | _ p => simp [testBit, p] - -@[simp] theorem testBit_succ (x i : Nat) : testBit x (succ i) = testBit (x/2) i := by - unfold testBit - simp [shiftRight_succ_inside] - -theorem testBit_to_div_mod {x : Nat} : testBit x i = decide (x / 2^i % 2 = 1) := by - induction i generalizing x with - | zero => - unfold testBit - cases mod_two_eq_zero_or_one x with | _ xz => simp [xz] - | succ i hyp => - simp [hyp, Nat.div_div_eq_div_mul, Nat.pow_succ'] - -theorem ne_zero_implies_bit_true {x : Nat} (xnz : x ≠ 0) : ∃ i, testBit x i := by - induction x using div2Induction with - | ind x hyp => - have x_pos : x > 0 := Nat.pos_of_ne_zero xnz - match mod_two_eq_zero_or_one x with - | Or.inl mod2_eq => - rw [←div_add_mod x 2] at xnz - simp only [mod2_eq, ne_eq, Nat.mul_eq_zero, Nat.add_zero, false_or] at xnz - have ⟨d, dif⟩ := hyp x_pos xnz - apply Exists.intro (d+1) - simp_all - | Or.inr mod2_eq => - apply Exists.intro 0 - simp_all - -theorem ne_implies_bit_diff {x y : Nat} (p : x ≠ y) : ∃ i, testBit x i ≠ testBit y i := by - induction y using Nat.div2Induction generalizing x with - | ind y hyp => - cases Nat.eq_zero_or_pos y with - | inl yz => - simp only [yz, Nat.zero_testBit, Bool.eq_false_iff] - simp only [yz] at p - have ⟨i,ip⟩ := ne_zero_implies_bit_true p - apply Exists.intro i - simp [ip] - | inr ypos => - if lsb_diff : x % 2 = y % 2 then - rw [←Nat.div_add_mod x 2, ←Nat.div_add_mod y 2] at p - simp only [ne_eq, lsb_diff, Nat.add_right_cancel_iff, - Nat.zero_lt_succ, Nat.mul_left_cancel_iff] at p - have ⟨i, ieq⟩ := hyp ypos p - apply Exists.intro (i+1) - simpa - else - apply Exists.intro 0 - simp only [testBit_zero] - revert lsb_diff - cases mod_two_eq_zero_or_one x with | _ p => - cases mod_two_eq_zero_or_one y with | _ q => - simp [p,q] - -/-- -`eq_of_testBit_eq` allows proving two natural numbers are equal -if their bits are all equal. --/ -theorem eq_of_testBit_eq {x y : Nat} (pred : ∀i, testBit x i = testBit y i) : x = y := by - if h : x = y then - exact h - else - let ⟨i,eq⟩ := ne_implies_bit_diff h - have p := pred i - contradiction - -theorem ge_two_pow_implies_high_bit_true {x : Nat} (p : x ≥ 2^n) : ∃ i, i ≥ n ∧ testBit x i := by - induction x using div2Induction generalizing n with - | ind x hyp => - have x_pos : x > 0 := Nat.lt_of_lt_of_le (Nat.two_pow_pos n) p - have x_ne_zero : x ≠ 0 := Nat.ne_of_gt x_pos - match n with - | zero => - let ⟨j, jp⟩ := ne_zero_implies_bit_true x_ne_zero - exact Exists.intro j (And.intro (Nat.zero_le _) jp) - | succ n => - have x_ge_n : x / 2 ≥ 2 ^ n := by - simpa [le_div_iff_mul_le, ← Nat.pow_succ'] using p - have ⟨j, jp⟩ := @hyp x_pos n x_ge_n - apply Exists.intro (j+1) - apply And.intro - case left => - exact (Nat.succ_le_succ jp.left) - case right => - simpa using jp.right - -theorem testBit_implies_ge {x : Nat} (p : testBit x i = true) : x ≥ 2^i := by - simp only [testBit_to_div_mod] at p - by_contra not_ge - have x_lt : x < 2^i := Nat.lt_of_not_le not_ge - simp [div_eq_of_lt x_lt] at p - -theorem testBit_lt_two_pow {x i : Nat} (lt : x < 2^i) : x.testBit i = false := by - match p : x.testBit i with - | false => trivial - | true => - exfalso - exact Nat.not_le_of_gt lt (testBit_implies_ge p) - -theorem lt_pow_two_of_testBit (x : Nat) (p : ∀i, i ≥ n → testBit x i = false) : x < 2^n := by - by_contra not_lt - have x_ge_n := Nat.ge_of_not_lt not_lt - have ⟨i, ⟨i_ge_n, test_true⟩⟩ := ge_two_pow_implies_high_bit_true x_ge_n - have test_false := p _ i_ge_n - simp only [test_true] at test_false - -/-! ### testBit -/ - -private theorem succ_mod_two : succ x % 2 = 1 - x % 2 := by - induction x with - | zero => - trivial - | succ x hyp => - have p : 2 ≤ x + 2 := Nat.le_add_left _ _ - simp [Nat.mod_eq (x+2) 2, p, hyp] - cases Nat.mod_two_eq_zero_or_one x with | _ p => simp [p] - -private theorem testBit_succ_zero : testBit (x + 1) 0 = not (testBit x 0) := by - simp [testBit_to_div_mod, succ_mod_two] - cases Nat.mod_two_eq_zero_or_one x with | _ p => - simp [p] - -theorem testBit_two_pow_add_eq (x i : Nat) : testBit (2^i + x) i = not (testBit x i) := by - simp [testBit_to_div_mod, add_div_left, Nat.two_pow_pos, succ_mod_two] - cases mod_two_eq_zero_or_one (x / 2 ^ i) with - | _ p => simp [p] - -theorem testBit_mul_two_pow_add_eq (a b i : Nat) : - testBit (2^i*a + b) i = Bool.xor (a%2 = 1) (testBit b i) := by - match a with - | 0 => simp - | a+1 => - simp [Nat.mul_succ, Nat.add_assoc, - testBit_mul_two_pow_add_eq a, - testBit_two_pow_add_eq, - Nat.succ_mod_two] - cases mod_two_eq_zero_or_one a with - | _ p => simp [p] - -theorem testBit_two_pow_add_gt {i j : Nat} (j_lt_i : j < i) (x : Nat) : - testBit (2^i + x) j = testBit x j := by - have i_def : i = j + (i-j) := (Nat.add_sub_cancel' (Nat.le_of_lt j_lt_i)).symm - rw [i_def] - simp only [testBit_to_div_mod, Nat.pow_add, - Nat.add_comm x, Nat.mul_add_div (Nat.two_pow_pos _)] - match i_sub_j_eq : i - j with - | 0 => - exfalso - rw [Nat.sub_eq_zero_iff_le] at i_sub_j_eq - exact Nat.not_le_of_gt j_lt_i i_sub_j_eq - | d+1 => - simp [pow_succ, Nat.mul_comm _ 2, Nat.mul_add_mod] - -@[simp] theorem testBit_mod_two_pow (x j i : Nat) : - testBit (x % 2^j) i = (decide (i < j) && testBit x i) := by - induction x using Nat.strongInductionOn generalizing j i with - | ind x hyp => - rw [mod_eq] - rcases Nat.lt_or_ge x (2^j) with x_lt_j | x_ge_j - · have not_j_le_x := Nat.not_le_of_gt x_lt_j - simp [not_j_le_x] - rcases Nat.lt_or_ge i j with i_lt_j | i_ge_j - · simp [i_lt_j] - · have x_lt : x < 2^i := - calc x < 2^j := x_lt_j - _ ≤ 2^i := Nat.pow_le_pow_of_le_right Nat.zero_lt_two i_ge_j - simp [Nat.testBit_lt_two_pow x_lt] - · generalize y_eq : x - 2^j = y - have x_eq : x = y + 2^j := Nat.eq_add_of_sub_eq x_ge_j y_eq - simp only [Nat.two_pow_pos, x_eq, Nat.le_add_left, true_and, ite_true] - have y_lt_x : y < x := by - simp [x_eq] - exact Nat.lt_add_of_pos_right (Nat.two_pow_pos j) - simp only [hyp y y_lt_x] - if i_lt_j : i < j then - rw [ Nat.add_comm _ (2^_), testBit_two_pow_add_gt i_lt_j] - else - simp [i_lt_j] - -theorem testBit_one_zero : testBit 1 0 = true := by trivial - -theorem testBit_two_pow_sub_succ (h₂ : x < 2 ^ n) (i : Nat) : - testBit (2^n - (x + 1)) i = (decide (i < n) && ! testBit x i) := by - induction i generalizing n x with - | zero => - simp only [testBit_zero, zero_eq, Bool.and_eq_true, decide_eq_true_eq, - Bool.not_eq_true'] - match n with - | 0 => simp - | n+1 => - -- just logic + omega: - simp only [zero_lt_succ, decide_True, Bool.true_and] - rw [Nat.pow_succ', ← decide_not, decide_eq_decide] - rw [Nat.pow_succ'] at h₂ - omega - | succ i ih => - simp only [testBit_succ] - match n with - | 0 => - simp only [pow_zero, succ_sub_succ_eq_sub, Nat.zero_sub, Nat.zero_div, zero_testBit] - rw [decide_eq_false] <;> simp - | n+1 => - rw [Nat.two_pow_succ_sub_succ_div_two, ih] - · simp [Nat.succ_lt_succ_iff] - · rw [Nat.pow_succ'] at h₂ - omega - -@[simp] theorem testBit_two_pow_sub_one (n i : Nat) : testBit (2^n-1) i = decide (i < n) := by - rw [testBit_two_pow_sub_succ] - · simp - · exact Nat.two_pow_pos _ - -theorem testBit_bool_to_nat (b : Bool) (i : Nat) : - testBit (Bool.toNat b) i = (decide (i = 0) && b) := by - cases b <;> cases i <;> - simp [testBit_to_div_mod, Nat.pow_succ, Nat.mul_comm _ 2, - ←Nat.div_div_eq_div_mul _ 2, one_div_two, - Nat.mod_eq_of_lt] - -/-! ### bitwise -/ - -theorem testBit_bitwise - (false_false_axiom : f false false = false) (x y i : Nat) -: (bitwise f x y).testBit i = f (x.testBit i) (y.testBit i) := by - induction i using Nat.strongInductionOn generalizing x y with - | ind i hyp => - unfold bitwise - if x_zero : x = 0 then - cases p : f false true <;> - cases yi : testBit y i <;> - simp [x_zero, p, yi, false_false_axiom] - else if y_zero : y = 0 then - simp [x_zero, y_zero] - cases p : f true false <;> - cases xi : testBit x i <;> - simp [p, xi, false_false_axiom] - else - simp only [x_zero, y_zero, ←Nat.two_mul] - cases i with - | zero => - cases p : f (decide (x % 2 = 1)) (decide (y % 2 = 1)) <;> - simp [p, Nat.mul_add_mod, mod_eq_of_lt] - | succ i => - have hyp_i := hyp i (Nat.le_refl (i+1)) - cases p : f (decide (x % 2 = 1)) (decide (y % 2 = 1)) <;> - simp [p, one_div_two, hyp_i, Nat.mul_add_div] - -/-! ### bitwise -/ - -@[local simp] -private theorem eq_0_of_lt_one (x : Nat) : x < 1 ↔ x = 0 := - Iff.intro - (fun p => - match x with - | 0 => Eq.refl 0 - | _+1 => False.elim (not_lt_zero _ (Nat.lt_of_succ_lt_succ p))) - (fun p => by simp [p, Nat.zero_lt_succ]) - -private theorem eq_0_of_lt (x : Nat) : x < 2^ 0 ↔ x = 0 := eq_0_of_lt_one x - -@[local simp] -private theorem zero_lt_pow (n : Nat) : 0 < 2^n := by - induction n - case zero => simp [eq_0_of_lt] - case succ n hyp => simpa [pow_succ] - -private theorem div_two_le_of_lt_two {m n : Nat} (p : m < 2 ^ succ n) : m / 2 < 2^n := by - simp [div_lt_iff_lt_mul Nat.zero_lt_two] - exact p - -/-- This provides a bound on bitwise operations. -/ -theorem bitwise_lt_two_pow (left : x < 2^n) (right : y < 2^n) : (Nat.bitwise f x y) < 2^n := by - induction n generalizing x y with - | zero => - simp only [eq_0_of_lt] at left right - unfold bitwise - simp [left, right] - | succ n hyp => - unfold bitwise - if x_zero : x = 0 then - simp only [x_zero, if_pos] - by_cases p : f false true = true <;> simp [p, right] - else if y_zero : y = 0 then - simp only [x_zero, y_zero, if_neg, if_pos] - by_cases p : f true false = true <;> simp [p, left] - else - simp only [x_zero, y_zero, if_neg] - have hyp1 := hyp (div_two_le_of_lt_two left) (div_two_le_of_lt_two right) - by_cases p : f (decide (x % 2 = 1)) (decide (y % 2 = 1)) = true <;> - simp [p, pow_succ, mul_succ, Nat.add_assoc] - case pos => - apply lt_of_succ_le - simp only [← Nat.succ_add] - apply Nat.add_le_add <;> exact hyp1 - case neg => - apply Nat.add_lt_add <;> exact hyp1 - -/-! ### and -/ - -@[simp] theorem testBit_and (x y i : Nat) : (x &&& y).testBit i = (x.testBit i && y.testBit i) := by - simp [HAnd.hAnd, AndOp.and, land, testBit_bitwise ] - -theorem and_lt_two_pow (x : Nat) {y n : Nat} (right : y < 2^n) : (x &&& y) < 2^n := by - apply lt_pow_two_of_testBit - intro i i_ge_n - have yf : testBit y i = false := by - apply Nat.testBit_lt_two_pow - apply Nat.lt_of_lt_of_le right - exact pow_le_pow_of_le_right Nat.zero_lt_two i_ge_n - simp [testBit_and, yf] - -@[simp] theorem and_pow_two_is_mod (x n : Nat) : x &&& (2^n-1) = x % 2^n := by - apply eq_of_testBit_eq - intro i - simp only [testBit_and, testBit_mod_two_pow] - cases testBit x i <;> simp - -theorem and_pow_two_identity {x : Nat} (lt : x < 2^n) : x &&& 2^n-1 = x := by - rw [and_pow_two_is_mod] - apply Nat.mod_eq_of_lt lt - -/-! ### lor -/ - -@[simp] theorem or_zero (x : Nat) : 0 ||| x = x := by - simp only [HOr.hOr, OrOp.or, lor] - unfold bitwise - simp [@eq_comm _ 0] - -@[simp] theorem zero_or (x : Nat) : x ||| 0 = x := by - simp only [HOr.hOr, OrOp.or, lor] - unfold bitwise - simp [@eq_comm _ 0] - -@[simp] theorem testBit_or (x y i : Nat) : (x ||| y).testBit i = (x.testBit i || y.testBit i) := by - simp [HOr.hOr, OrOp.or, lor, testBit_bitwise ] - -theorem or_lt_two_pow {x y n : Nat} (left : x < 2^n) (right : y < 2^n) : x ||| y < 2^n := - bitwise_lt_two_pow left right - -/-! ### xor -/ - -@[simp] theorem testBit_xor (x y i : Nat) : - (x ^^^ y).testBit i = Bool.xor (x.testBit i) (y.testBit i) := by - simp [HXor.hXor, Xor.xor, xor, testBit_bitwise ] - -theorem xor_lt_two_pow {x y n : Nat} (left : x < 2^n) (right : y < 2^n) : x ^^^ y < 2^n := - bitwise_lt_two_pow left right - -/-! ### Arithmetic -/ - -theorem testBit_mul_pow_two_add (a : Nat) {b i : Nat} (b_lt : b < 2^i) (j : Nat) : - testBit (2 ^ i * a + b) j = - if j < i then - testBit b j - else - testBit a (j - i) := by - cases Nat.lt_or_ge j i with - | inl j_lt => - simp only [j_lt] - have i_ge := Nat.le_of_lt j_lt - have i_sub_j_nez : i-j ≠ 0 := Nat.sub_ne_zero_of_lt j_lt - have i_def : i = j + succ (pred (i-j)) := - calc i = j + (i-j) := (Nat.add_sub_cancel' i_ge).symm - _ = j + succ (pred (i-j)) := by - rw [← congrArg (j+·) (Nat.succ_pred i_sub_j_nez)] - rw [i_def] - simp only [testBit_to_div_mod, Nat.pow_add, Nat.mul_assoc] - simp only [Nat.mul_add_div (Nat.two_pow_pos _), Nat.mul_add_mod] - simp [Nat.pow_succ, Nat.mul_comm _ 2, Nat.mul_assoc, Nat.mul_add_mod] - | inr j_ge => - have j_def : j = i + (j-i) := (Nat.add_sub_cancel' j_ge).symm - simp only [ - testBit_to_div_mod, - Nat.not_lt_of_le, - j_ge, - ite_false] - simp [congrArg (2^·) j_def, Nat.pow_add, - ←Nat.div_div_eq_div_mul, - Nat.mul_add_div, - Nat.div_eq_of_lt b_lt, - Nat.two_pow_pos i] - -theorem testBit_mul_pow_two : - testBit (2 ^ i * a) j = (decide (j ≥ i) && testBit a (j-i)) := by - have gen := testBit_mul_pow_two_add a (Nat.two_pow_pos i) j - simp at gen - rw [gen] - cases Nat.lt_or_ge j i with - | _ p => simp [p, Nat.not_le_of_lt, Nat.not_lt_of_le] - -theorem mul_add_lt_is_or {b : Nat} (b_lt : b < 2^i) (a : Nat) : 2^i * a + b = 2^i * a ||| b := by - apply eq_of_testBit_eq - intro j - simp only [testBit_mul_pow_two_add _ b_lt, - testBit_or, testBit_mul_pow_two] - if j_lt : j < i then - simp [Nat.not_le_of_lt, j_lt] - else - have i_le : i ≤ j := Nat.le_of_not_lt j_lt - have b_lt_j := - calc b < 2 ^ i := b_lt - _ ≤ 2 ^ j := Nat.pow_le_pow_of_le_right Nat.zero_lt_two i_le - simp [i_le, j_lt, testBit_lt_two_pow, b_lt_j] - -/-! ### shiftLeft and shiftRight -/ - -@[simp] theorem testBit_shiftLeft (x : Nat) : testBit (x <<< i) j = - (decide (j ≥ i) && testBit x (j-i)) := by - simp [shiftLeft_eq, Nat.mul_comm _ (2^_), testBit_mul_pow_two] - -@[simp] theorem testBit_shiftRight (x : Nat) : testBit (x >>> i) j = testBit x (i+j) := by - simp [testBit, ←shiftRight_add] diff --git a/Std/Data/Rat/Lemmas.lean b/Std/Data/Rat/Lemmas.lean index 3b749f9593..ced2a09c08 100644 --- a/Std/Data/Rat/Lemmas.lean +++ b/Std/Data/Rat/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Rat.Basic -import Std.Tactic.NormCast.Ext import Std.Tactic.SeqFocus /-! # Additional lemmas about the Rational Numbers -/ diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 013b21e084..11aee37ec7 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -9,7 +9,6 @@ import Std.Data.List.Lemmas import Std.Data.String.Basic import Std.Tactic.Lint.Misc import Std.Tactic.SeqFocus -import Std.Tactic.Simpa @[simp] theorem Char.length_toString (c : Char) : c.toString.length = 1 := rfl diff --git a/Std/Lean/Parser.lean b/Std/Lean/Parser.lean index 0d8064c8d7..c93657a739 100644 --- a/Std/Lean/Parser.lean +++ b/Std/Lean/Parser.lean @@ -5,32 +5,11 @@ Authors: Mario Carneiro -/ namespace Lean.Parser.Tactic - --- syntax simpArg := simpStar <|> simpErase <|> simpLemma -/-- -A `simpArg` is either a `*`, `-lemma` or a simp lemma specification -(which includes the `↑` `↓` `←` specifications for pre, post, reverse rewriting). --/ -def simpArg := simpStar.binary `orelse (simpErase.binary `orelse simpLemma) - -/-- A simp args list is a list of `simpArg`. This is the main argument to `simp`. -/ -syntax simpArgs := " [" simpArg,* "]" - /-- Extract the arguments from a `simpArgs` syntax as an array of syntaxes -/ def getSimpArgs? : Syntax → Option (Array Syntax) | `(simpArgs| [$args,*]) => pure args.getElems | _ => none --- syntax dsimpArg := simpErase <|> simpLemma -/-- -A `dsimpArg` is similar to `simpArg`, but it does not have the `simpStar` form -because it does not make sense to use hypotheses in `dsimp`. --/ -def dsimpArg := simpErase.binary `orelse simpLemma - -/-- A dsimp args list is a list of `dsimpArg`. This is the main argument to `dsimp`. -/ -syntax dsimpArgs := " [" dsimpArg,* "]" - /-- Extract the arguments from a `dsimpArgs` syntax as an array of syntaxes -/ def getDSimpArgs? : Syntax → Option (Array Syntax) | `(dsimpArgs| [$args,*]) => pure args.getElems diff --git a/Std/Tactic/NormCast.lean b/Std/Tactic/NormCast.lean index 034c16497c..5a421d4b2b 100644 --- a/Std/Tactic/NormCast.lean +++ b/Std/Tactic/NormCast.lean @@ -5,8 +5,6 @@ Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner -/ import Lean.Elab.Tactic.Conv.Simp import Std.Lean.Meta.Simp -import Std.Tactic.NormCast.Ext -import Std.Tactic.NormCast.Lemmas import Std.Classes.Cast /-! @@ -14,7 +12,6 @@ import Std.Classes.Cast -/ open Lean Meta Simp -open Std.Tactic.NormCast namespace Int @@ -32,318 +29,3 @@ attribute [norm_cast] ofNat_lt attribute [norm_cast] ofNat_pos end Int - -namespace Std.Tactic.NormCast - -initialize registerTraceClass `Tactic.norm_cast - -/-- Prove `a = b` using the given simp set. -/ -def proveEqUsing (s : SimpTheorems) (a b : Expr) : MetaM (Option Simp.Result) := do - let go : SimpM (Option Simp.Result) := do - let a' ← Simp.simp a - let b' ← Simp.simp b - unless ← isDefEq a'.expr b'.expr do return none - a'.mkEqTrans (← mkEqSymm b b') - withReducible do - (go (← Simp.mkDefaultMethods).toMethodsRef - { simpTheorems := #[s], congrTheorems := ← Meta.getSimpCongrTheorems }).run' {} - -/-- Prove `a = b` by simplifying using move and squash lemmas. -/ -def proveEqUsingDown (a b : Expr) : MetaM (Option Simp.Result) := do - withTraceNode `Tactic.norm_cast (return m!"{exceptOptionEmoji ·} proving: {← mkEq a b}") do - proveEqUsing (← normCastExt.down.getTheorems) a b - -/-- Construct the expression `(e : ty)`. -/ -def mkCoe (e : Expr) (ty : Expr) : MetaM Expr := do - let .some e' ← coerce? e ty | failure - return e' - -/-- -Check if an expression is the coercion of some other expression, -and if so return that expression. --/ -def isCoeOf? (e : Expr) : MetaM (Option Expr) := do - if let Expr.const fn .. := e.getAppFn then - if let some info ← getCoeFnInfo? fn then - if e.getAppNumArgs == info.numArgs then - return e.getArg! info.coercee - return none - -/-- -Check if an expression is a numeral in some type, -and if so return that type and the natural number. --/ -def isNumeral? (e : Expr) : Option (Expr × Nat) := - if e.isConstOf ``Nat.zero then - (mkConst ``Nat, 0) - else if let Expr.app (Expr.app (Expr.app (Expr.const ``OfNat.ofNat ..) α ..) - (Expr.lit (Literal.natVal n) ..) ..) .. := e then - some (α, n) - else - none - -/-- -This is the main heuristic used alongside the elim and move lemmas. -The goal is to help casts move past operators by adding intermediate casts. -An expression of the shape: op (↑(x : α) : γ) (↑(y : β) : γ) -is rewritten to: op (↑(↑(x : α) : β) : γ) (↑(y : β) : γ) -when (↑(↑(x : α) : β) : γ) = (↑(x : α) : γ) can be proven with a squash lemma --/ -def splittingProcedure (expr : Expr) : MetaM Simp.Result := do - let Expr.app (Expr.app op x ..) y .. := expr | return {expr} - - let Expr.forallE _ γ (Expr.forallE _ γ' ty ..) .. ← inferType op | return {expr} - if γ'.hasLooseBVars || ty.hasLooseBVars then return {expr} - unless ← isDefEq γ γ' do return {expr} - - let msg := m!"splitting {expr}" - let msg - | .error _ => return m!"{bombEmoji} {msg}" - | .ok r => return if r.expr == expr then m!"{crossEmoji} {msg}" else - m!"{checkEmoji} {msg} to {r.expr}" - withTraceNode `Tactic.norm_cast msg do - - try - let some x' ← isCoeOf? x | failure - let some y' ← isCoeOf? y | failure - let α ← inferType x' - let β ← inferType y' - - -- TODO: fast timeout - (try - let x2 ← mkCoe (← mkCoe x' β) γ - let some x_x2 ← proveEqUsingDown x x2 | failure - Simp.mkCongrFun (← Simp.mkCongr {expr := op} x_x2) y - catch _ => - let y2 ← mkCoe (← mkCoe y' α) γ - let some y_y2 ← proveEqUsingDown y y2 | failure - Simp.mkCongr {expr := mkApp op x} y_y2) - catch _ => try - let some (_, n) := isNumeral? y | failure - let some x' ← isCoeOf? x | failure - let α ← inferType x' - let y2 ← mkCoe (← mkNumeral α n) γ - let some y_y2 ← proveEqUsingDown y y2 | failure - Simp.mkCongr {expr := mkApp op x} y_y2 - catch _ => try - let some (_, n) := isNumeral? x | failure - let some y' ← isCoeOf? y | failure - let β ← inferType y' - let x2 ← mkCoe (← mkNumeral β n) γ - let some x_x2 ← proveEqUsingDown x x2 | failure - Simp.mkCongrFun (← Simp.mkCongr {expr := op} x_x2) y - catch _ => - return {expr} - -/-- -Discharging function used during simplification in the "squash" step. --/ --- TODO: normCast takes a list of expressions to use as lemmas for the discharger --- TODO: a tactic to print the results the discharger fails to prove -def prove (e : Expr) : SimpM (Option Expr) := do - withTraceNode `Tactic.norm_cast (return m!"{exceptOptionEmoji ·} discharging: {e}") do - return (← findLocalDeclWithType? e).map mkFVar - -/-- -Core rewriting function used in the "squash" step, which moves casts upwards -and eliminates them. - -It tries to rewrite an expression using the elim and move lemmas. -On failure, it calls the splitting procedure heuristic. --/ -partial def upwardAndElim (up : SimpTheorems) (e : Expr) : SimpM Simp.Step := do - let r ← withDischarger prove do - Simp.rewrite? e up.post up.erased (tag := "squash") (rflOnly := false) - let r := r.getD { expr := e } - let r ← r.mkEqTrans (← splittingProcedure r.expr) - if r.expr == e then return Simp.Step.done {expr := e} - return Simp.Step.visit r - -/-- -If possible, rewrite `(n : α)` to `(Nat.cast n : α)` where `n` is a numeral and `α ≠ ℕ`. -Returns a pair of the new expression and proof that they are equal. --/ -def numeralToCoe (e : Expr) : MetaM Simp.Result := do - let some (α, n) := isNumeral? e | failure - if (← whnf α).isConstOf ``Nat then failure - let newE ← mkAppOptM ``Nat.cast #[α, none, toExpr n] - let some pr ← proveEqUsingDown e newE | failure - return pr - -/-- -The core simplification routine of `normCast`. --/ -def derive (e : Expr) : MetaM Simp.Result := do - withTraceNode `Tactic.norm_cast (fun _ => return m!"{e}") do - let e ← instantiateMVars e - - let config : Simp.Config := { - zeta := false - beta := false - eta := false - proj := false - iota := false - } - let congrTheorems ← Meta.getSimpCongrTheorems - - let r : Simp.Result := { expr := e } - - let withTrace phase := withTraceNode `Tactic.norm_cast fun - | .ok r => return m!"{r.expr} (after {phase})" - | .error _ => return m!"{bombEmoji} {phase}" - - -- step 1: pre-processing of numerals - let r ← withTrace "pre-processing numerals" do - let post e := return Simp.Step.done (← try numeralToCoe e catch _ => pure {expr := e}) - r.mkEqTrans (← Simp.main r.expr { config, congrTheorems } (methods := { post })).1 - - -- step 2: casts are moved upwards and eliminated - let r ← withTrace "moving upward, splitting and eliminating" do - let post := upwardAndElim (← normCastExt.up.getTheorems) - r.mkEqTrans (← Simp.main r.expr { config, congrTheorems } (methods := { post })).1 - - -- step 3: casts are squashed - let r ← withTrace "squashing" do - let simpTheorems := #[← normCastExt.squash.getTheorems] - r.mkEqTrans (← simp r.expr { simpTheorems, config, congrTheorems }).1 - - return r - -open Elab.Term in -/-- Term elaborator which uses the expected type to insert coercions. -/ -elab "mod_cast " e:term : term <= expectedType => do - if (← instantiateMVars expectedType).hasExprMVar then tryPostpone - let expectedType' ← derive expectedType - let e ← elabTerm e expectedType'.expr - synthesizeSyntheticMVars - let eTy ← instantiateMVars (← inferType e) - if eTy.hasExprMVar then tryPostpone - let eTy' ← derive eTy - unless ← isDefEq eTy'.expr expectedType'.expr do - throwTypeMismatchError "mod_cast" expectedType'.expr eTy'.expr e - let eTy_eq_expectedType ← eTy'.mkEqTrans (← mkEqSymm expectedType expectedType') - mkCast eTy_eq_expectedType e - -open Tactic Parser.Tactic Elab.Tactic - -/-- Implementation of the `norm_cast` tactic when operating on the main goal. -/ -def normCastTarget : TacticM Unit := - liftMetaTactic1 fun goal => do - let tgt ← instantiateMVars (← goal.getType) - let prf ← derive tgt - applySimpResultToTarget goal tgt prf - -/-- Implementation of the `norm_cast` tactic when operating on a hypothesis. -/ -def normCastHyp (fvarId : FVarId) : TacticM Unit := - liftMetaTactic1 fun goal => do - let hyp ← instantiateMVars (← fvarId.getDecl).type - let prf ← derive hyp - return (← applySimpResultToLocalDecl goal fvarId prf false).map (·.snd) - -/-- Implementation of `norm_cast` (the full `norm_cast` calls `trivial` afterwards). -/ -elab "norm_cast0" loc:((location)?) : tactic => - withMainContext do - match expandOptLocation loc with - | Location.targets hyps target => - if target then normCastTarget - (← getFVarIds hyps).forM normCastHyp - | Location.wildcard => - normCastTarget - (← (← getMainGoal).getNondepPropHyps).forM normCastHyp - -/-- `assumption_mod_cast` runs `norm_cast` on the goal. For each local hypothesis `h`, it also -normalizes `h` and tries to use that to close the goal. -/ -macro "assumption_mod_cast" : tactic => `(tactic| norm_cast0 at * <;> assumption) - -/-- -The `norm_cast` family of tactics is used to normalize casts inside expressions. -It is basically a simp tactic with a specific set of lemmas to move casts -upwards in the expression. -Therefore it can be used more safely as a non-terminating tactic. -It also has special handling of numerals. - -For instance, given an assumption -```lean -a b : ℤ -h : ↑a + ↑b < (10 : ℚ) -``` - -writing `norm_cast at h` will turn `h` into -```lean -h : a + b < 10 -``` - -You can also use `exact_mod_cast`, `apply_mod_cast`, `rw_mod_cast` -or `assumption_mod_cast`. -Writing `exact_mod_cast h` and `apply_mod_cast h` will normalize the goal and -`h` before using `exact h` or `apply h`. -Writing `assumption_mod_cast` will normalize the goal and for every -expression `h` in the context it will try to normalize `h` and use -`exact h`. -`rw_mod_cast` acts like the `rw` tactic but it applies `norm_cast` between steps. - -See also `push_cast`, for move casts inwards. - -The implementation and behavior of the `norm_cast` family is described in detail at -. --/ -macro "norm_cast" loc:(location)? : tactic => - `(tactic| norm_cast0 $[$loc]? <;> try trivial) - -/-- -Rewrite with the given rules and normalize casts between steps. --/ -syntax "rw_mod_cast" (config)? rwRuleSeq (location)? : tactic -macro_rules - | `(tactic| rw_mod_cast $[$config]? [$rules,*] $[$loc]?) => do - let tacs ← rules.getElems.mapM fun rule => - `(tactic| (norm_cast at *; rw $[$config]? [$rule] $[$loc]?)) - `(tactic| ($[$tacs]*)) - -/-- -Normalize the goal and the given expression, then close the goal with exact. --/ -macro "exact_mod_cast " e:term : tactic => `(tactic| exact mod_cast ($e : _)) - -/-- -Normalize the goal and the given expression, then apply the expression to the goal. --/ -macro "apply_mod_cast " e:term : tactic => `(tactic| apply mod_cast ($e : _)) - -/-- `norm_cast` tactic in `conv` mode. -/ -syntax (name := convNormCast) "norm_cast" : conv - -@[inherit_doc convNormCast, tactic convNormCast] def evalConvNormCast : Tactic := - open Elab.Tactic.Conv in fun _ => withMainContext do - applySimpResult (← derive (← getLhs)) - -/-- -`push_cast` rewrites the expression to move casts toward the leaf nodes. -This uses `norm_cast` lemmas in the forward direction. -For example, `↑(a + b)` will be written to `↑a + ↑b`. -It is equivalent to `simp only with push_cast`. -It can also be used at hypotheses with `push_cast at h` -and with extra simp lemmas with `push_cast [int.add_zero]`. - -```lean -example (a b : ℕ) (h1 : ((a + b : ℕ) : ℤ) = 10) (h2 : ((a + b + 0 : ℕ) : ℤ) = 10) : - ((a + b : ℕ) : ℤ) = 10 := -begin - push_cast, - push_cast at h1, - push_cast [int.add_zero] at h2, -end -``` - -The implementation and behavior of the `norm_cast` family is described in detail at -. --/ -syntax (name := pushCast) "push_cast" (config)? (discharger)? (&" only")? - (" [" (simpStar <|> simpErase <|> simpLemma),* "]")? (location)? : tactic - -@[inherit_doc pushCast, tactic pushCast] def evalPushCast : Tactic := fun stx => do - let { ctx, simprocs, dischargeWrapper } ← withMainContext do - mkSimpContext' (← pushCastExt.getTheorems) stx (eraseLocal := false) - let ctx := { ctx with config := { ctx.config with failIfUnchanged := false } } - dischargeWrapper.with fun discharge? => - discard <| simpLocation ctx simprocs discharge? (expandOptLocation stx[5]) diff --git a/Std/Tactic/NormCast/Ext.lean b/Std/Tactic/NormCast/Ext.lean deleted file mode 100644 index b43ae5bad2..0000000000 --- a/Std/Tactic/NormCast/Ext.lean +++ /dev/null @@ -1,219 +0,0 @@ -/- -Copyright (c) 2019 Paul-Nicolas Madelaine. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner --/ -import Lean.Meta.CoeAttr -import Lean.Meta.CongrTheorems -import Lean.Meta.Tactic.Simp.SimpTheorems - -open Lean Meta - -namespace Std.Tactic.NormCast - -/-- -`Label` is a type used to classify `norm_cast` lemmas. -* elim lemma: LHS has 0 head coes and ≥ 1 internal coe -* move lemma: LHS has 1 head coe and 0 internal coes, RHS has 0 head coes and ≥ 1 internal coes -* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes --/ -inductive Label - /-- elim lemma: LHS has 0 head coes and ≥ 1 internal coe -/ - | elim - /-- move lemma: LHS has 1 head coe and 0 internal coes, - RHS has 0 head coes and ≥ 1 internal coes -/ - | move - /-- squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes -/ - | squash - deriving DecidableEq, Repr, Inhabited - -/-- Assuming `e` is an application, returns the list of subterms that `simp` will rewrite in. -/ -def getSimpArgs (e : Expr) : MetaM (Array Expr) := do - match ← mkCongrSimp? e.getAppFn with - | none => return e.getAppArgs - | some {argKinds, ..} => - let mut args := #[] - for a in e.getAppArgs, k in argKinds do - if k matches .eq then - args := args.push a - return args - -/-- Count how many coercions are at the top of the expression. -/ -partial def countHeadCoes (e : Expr) : MetaM Nat := do - if let Expr.const fn .. := e.getAppFn then - if let some info ← getCoeFnInfo? fn then - if e.getAppNumArgs >= info.numArgs then - return (← countHeadCoes (e.getArg! info.coercee)) + 1 - return 0 - -/-- Count how many coercions are inside the expression, including the top ones. -/ -partial def countCoes (e : Expr) : MetaM Nat := - lambdaTelescope e fun _ e => do - if let Expr.const fn .. := e.getAppFn then - if let some info ← getCoeFnInfo? fn then - if e.getAppNumArgs >= info.numArgs then - let mut coes := (← countHeadCoes (e.getArg! info.coercee)) + 1 - for i in [info.numArgs:e.getAppNumArgs] do - coes := coes + (← countCoes (e.getArg! i)) - return coes - return (← (← getSimpArgs e).mapM countCoes).foldl (·+·) 0 - -/-- Count how many coercions are inside the expression, excluding the top ones. -/ -def countInternalCoes (e : Expr) : MetaM Nat := - return (← countCoes e) - (← countHeadCoes e) - -/-- Classifies a declaration of type `ty` as a `norm_cast` rule. -/ -def classifyType (ty : Expr) : MetaM Label := - forallTelescopeReducing ty fun _ ty => do - let ty ← whnf ty - let (lhs, rhs) ← - if ty.isAppOfArity ``Eq 3 then pure (ty.getArg! 1, ty.getArg! 2) - else if ty.isAppOfArity ``Iff 2 then pure (ty.getArg! 0, ty.getArg! 1) - else throwError "norm_cast: lemma must be = or ↔, but is{indentExpr ty}" - let lhsCoes ← countCoes lhs - if lhsCoes = 0 then - throwError "norm_cast: badly shaped lemma, lhs must contain at least one coe{indentExpr lhs}" - let lhsHeadCoes ← countHeadCoes lhs - let rhsHeadCoes ← countHeadCoes rhs - let rhsInternalCoes ← countInternalCoes rhs - if lhsHeadCoes = 0 then - return Label.elim - else if lhsHeadCoes = 1 then do - unless rhsHeadCoes = 0 do - throwError "norm_cast: badly shaped lemma, rhs can't start with coe{indentExpr rhs}" - if rhsInternalCoes = 0 then - return Label.squash - else - return Label.move - else if rhsHeadCoes < lhsHeadCoes then do - return Label.squash - else do - throwError "\ - norm_cast: badly shaped shaped squash lemma, \ - rhs must have fewer head coes than lhs{indentExpr ty}" - -/-- The `push_cast` simp attribute. -/ -initialize pushCastExt : SimpExtension ← - registerSimpAttr `push_cast "\ - The `push_cast` simp attribute uses `norm_cast` lemmas \ - to move casts toward the leaf nodes of the expression." - -/-- The `norm_cast` attribute stores three simp sets. -/ -structure NormCastExtension where - /-- A simp set which lifts coercion arrows to the top level. -/ - up : SimpExtension - /-- A simp set which pushes coercion arrows to the leaves. -/ - down : SimpExtension - /-- A simp set which simplifies transitive coercions. -/ - squash : SimpExtension - deriving Inhabited - -/-- The `norm_cast` extension data. -/ -initialize normCastExt : NormCastExtension ← pure { - up := ← mkSimpExt (decl_name% ++ `up) - down := ← mkSimpExt (decl_name% ++ `down) - squash := ← mkSimpExt (decl_name% ++ `squash) -} - -/-- `addElim decl` adds `decl` as an `elim` lemma to the cache. -/ -def addElim (decl : Name) - (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := - addSimpTheorem normCastExt.up decl (post := true) (inv := false) kind prio - -/-- `addMove decl` adds `decl` as a `move` lemma to the cache. -/ -def addMove (decl : Name) - (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := do - addSimpTheorem pushCastExt decl (post := true) (inv := false) kind prio - addSimpTheorem normCastExt.up decl (post := true) (inv := true) kind prio - addSimpTheorem normCastExt.down decl (post := true) (inv := false) kind prio - -/-- `addSquash decl` adds `decl` as a `squash` lemma to the cache. -/ -def addSquash (decl : Name) - (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := do - addSimpTheorem pushCastExt decl (post := true) (inv := false) kind prio - addSimpTheorem normCastExt.squash decl (post := true) (inv := false) kind prio - addSimpTheorem normCastExt.down decl (post := true) (inv := false) kind prio - -/-- `addInfer decl` infers the label of `decl` and adds it to the cache. - -* elim lemma: LHS has 0 head coes and ≥ 1 internal coe -* move lemma: LHS has 1 head coe and 0 internal coes, RHS has 0 head coes and ≥ 1 internal coes -* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes --/ -def addInfer (decl : Name) - (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := do - let ty := (← getConstInfo decl).type - match ← classifyType ty with - | Label.elim => addElim decl kind prio - | Label.squash => addSquash decl kind prio - | Label.move => addMove decl kind prio - -namespace Attr -/-- The possible `norm_cast` kinds: `elim`, `move`, or `squash`. -/ -syntax normCastLabel := &"elim" <|> &"move" <|> &"squash" - - -/-- -The `norm_cast` attribute should be given to lemmas that describe the -behaviour of a coercion in regard to an operator, a relation, or a particular -function. - -It only concerns equality or iff lemmas involving `↑`, `⇑` and `↥`, describing the behavior of -the coercion functions. -It does not apply to the explicit functions that define the coercions. - -Examples: -```lean -@[norm_cast] theorem coe_nat_inj' {m n : ℕ} : (↑m : ℤ) = ↑n ↔ m = n - -@[norm_cast] theorem coe_int_denom (n : ℤ) : (n : ℚ).denom = 1 - -@[norm_cast] theorem cast_id : ∀ n : ℚ, ↑n = n - -@[norm_cast] theorem coe_nat_add (m n : ℕ) : (↑(m + n) : ℤ) = ↑m + ↑n - -@[norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℤ) : α) = n - -@[norm_cast] theorem cast_one : ((1 : ℚ) : α) = 1 -``` - -Lemmas tagged with `@[norm_cast]` are classified into three categories: `move`, `elim`, and -`squash`. They are classified roughly as follows: - -* elim lemma: LHS has 0 head coes and ≥ 1 internal coe -* move lemma: LHS has 1 head coe and 0 internal coes, RHS has 0 head coes and ≥ 1 internal coes -* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes - -`norm_cast` uses `move` and `elim` lemmas to factor coercions toward the root of an expression -and to cancel them from both sides of an equation or relation. It uses `squash` lemmas to clean -up the result. - -Occasionally you may want to override the automatic classification. -You can do this by giving an optional `elim`, `move`, or `squash` parameter to the attribute. - -```lean -@[simp, norm_cast elim] lemma nat_cast_re (n : ℕ) : (n : ℂ).re = n := by - rw [← of_real_nat_cast, of_real_re] -``` - -Don't do this unless you understand what you are doing. - -A full description of the tactic, and the use of each lemma category, can be found at -. --/ -syntax (name := norm_cast) "norm_cast" (ppSpace normCastLabel)? (ppSpace num)? : attr -end Attr - -initialize registerBuiltinAttribute { - name := `norm_cast - descr := "attribute for norm_cast" - add := fun decl stx kind => MetaM.run' do - let `(attr| norm_cast $[$label:normCastLabel]? $[$prio]?) := stx | unreachable! - let prio := (prio.bind (·.1.isNatLit?)).getD (eval_prio default) - match label.bind (·.1.isStrLit?) with - | "elim" => addElim decl kind prio - | "move" => addMove decl kind prio - | "squash" => addSquash decl kind prio - | none => addInfer decl kind prio - | _ => unreachable! -} diff --git a/Std/Tactic/NormCast/Lemmas.lean b/Std/Tactic/NormCast/Lemmas.lean deleted file mode 100644 index 03bf033abf..0000000000 --- a/Std/Tactic/NormCast/Lemmas.lean +++ /dev/null @@ -1,18 +0,0 @@ -/- -Copyright (c) 2022 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ - -import Std.Tactic.NormCast.Ext -import Lean.Elab.ElabRules - -open Lean Meta -/-- `add_elim foo` registers `foo` as an elim-lemma in `norm_cast`. -/ -local elab "add_elim " id:ident : command => - Elab.Command.liftCoreM do MetaM.run' do - Std.Tactic.NormCast.addElim (← resolveGlobalConstNoOverload id) - -add_elim ne_eq - -attribute [coe] Fin.val Array.ofSubarray diff --git a/Std/Tactic/Simpa.lean b/Std/Tactic/Simpa.lean deleted file mode 100644 index b333ef73d5..0000000000 --- a/Std/Tactic/Simpa.lean +++ /dev/null @@ -1,117 +0,0 @@ -/- -Copyright (c) 2018 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Arthur Paulino, Gabriel Ebner, Mario Carneiro --/ -import Lean.Meta.Tactic.Assumption -import Lean.Meta.Tactic.TryThis -import Lean.Elab.Tactic.Simp -import Lean.Linter.Util -import Std.Lean.Parser -import Std.Tactic.OpenPrivate - -/-- -Enables the 'unnecessary `simpa`' linter. This will report if a use of -`simpa` could be proven using `simp` or `simp at h` instead. --/ -register_option linter.unnecessarySimpa : Bool := { - defValue := true - descr := "enable the 'unnecessary simpa' linter" -} - -namespace Std.Tactic.Simpa - -open Lean Parser.Tactic Elab Meta Term Tactic Simp Linter - -/-- The arguments to the `simpa` family tactics. -/ -syntax simpaArgsRest := (config)? (discharger)? &" only "? (simpArgs)? (" using " term)? - -/-- -This is a "finishing" tactic modification of `simp`. It has two forms. - -* `simpa [rules, ⋯] using e` will simplify the goal and the type of - `e` using `rules`, then try to close the goal using `e`. - - Simplifying the type of `e` makes it more likely to match the goal - (which has also been simplified). This construction also tends to be - more robust under changes to the simp lemma set. - -* `simpa [rules, ⋯]` will simplify the goal and the type of a - hypothesis `this` if present in the context, then try to close the goal using - the `assumption` tactic. - -#TODO: implement `?` --/ -syntax (name := simpa) "simpa" "?"? "!"? simpaArgsRest : tactic -@[inherit_doc simpa] macro "simpa!" rest:simpaArgsRest : tactic => - `(tactic| simpa ! $rest:simpaArgsRest) -@[inherit_doc simpa] macro "simpa?" rest:simpaArgsRest : tactic => - `(tactic| simpa ? $rest:simpaArgsRest) -@[inherit_doc simpa] macro "simpa?!" rest:simpaArgsRest : tactic => - `(tactic| simpa ?! $rest:simpaArgsRest) - -open private useImplicitLambda from Lean.Elab.Term - - -/-- Gets the value of the `linter.unnecessarySimpa` option. -/ -def getLinterUnnecessarySimpa (o : Options) : Bool := - getLinterValue linter.unnecessarySimpa o - -deriving instance Repr for UseImplicitLambdaResult - -elab_rules : tactic -| `(tactic| simpa%$tk $[?%$squeeze]? $[!%$unfold]? $(cfg)? $(disch)? $[only%$only]? - $[[$args,*]]? $[using $usingArg]?) => Elab.Tactic.focus do - let stx ← `(tactic| simp $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]?) - let { ctx, simprocs, dischargeWrapper } ← - withMainContext <| mkSimpContext stx (eraseLocal := false) - let ctx := if unfold.isSome then { ctx with config.autoUnfold := true } else ctx - -- TODO: have `simpa` fail if it doesn't use `simp`. - let ctx := { ctx with config := { ctx.config with failIfUnchanged := false } } - dischargeWrapper.with fun discharge? => do - let (some (_, g), usedSimps) ← simpGoal (← getMainGoal) ctx (simprocs := simprocs) - (simplifyTarget := true) (discharge? := discharge?) - | if getLinterUnnecessarySimpa (← getOptions) then - logLint linter.unnecessarySimpa (← getRef) "try 'simp' instead of 'simpa'" - g.withContext do - let usedSimps ← if let some stx := usingArg then - setGoals [g] - g.withContext do - let e ← Tactic.elabTerm stx none (mayPostpone := true) - let (h, g) ← if let .fvar h ← instantiateMVars e then - pure (h, g) - else - (← g.assert `h (← inferType e) e).intro1 - let (result?, usedSimps) ← simpGoal g ctx (simprocs := simprocs) (fvarIdsToSimp := #[h]) - (simplifyTarget := false) (usedSimps := usedSimps) (discharge? := discharge?) - match result? with - | some (xs, g) => - let h := match xs with | #[h] | #[] => h | _ => unreachable! - let name ← mkFreshBinderNameForTactic `h - let g ← g.rename h name - g.assign <|← g.withContext do - Tactic.elabTermEnsuringType (mkIdent name) (← g.getType) - | none => - if getLinterUnnecessarySimpa (← getOptions) then - if (← getLCtx).getRoundtrippingUserName? h |>.isSome then - logLint linter.unnecessarySimpa (← getRef) - m!"try 'simp at {Expr.fvar h}' instead of 'simpa using {Expr.fvar h}'" - pure usedSimps - else if let some ldecl := (← getLCtx).findFromUserName? `this then - if let (some (_, g), usedSimps) ← simpGoal g ctx (simprocs := simprocs) - (fvarIdsToSimp := #[ldecl.fvarId]) (simplifyTarget := false) (usedSimps := usedSimps) - (discharge? := discharge?) then - g.assumption; pure usedSimps - else - pure usedSimps - else - g.assumption; pure usedSimps - if tactic.simp.trace.get (← getOptions) || squeeze.isSome then - let stx ← match ← mkSimpOnly stx usedSimps with - | `(tactic| simp $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]?) => - if unfold.isSome then - `(tactic| simpa! $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]? $[using $usingArg]?) - else - `(tactic| simpa $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]? $[using $usingArg]?) - | _ => unreachable! - TryThis.addSuggestion tk stx (origSpan? := ← getRef) diff --git a/test/simpa.lean b/test/simpa.lean index 1c015b88dc..fe1b4e702d 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Arthur Paulino. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Gabriel Ebner -/ -import Std.Tactic.Simpa import Std.Tactic.ShowTerm import Std.Tactic.GuardMsgs From c939336e330a8d4b067d15db76bb66eacf40003c Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 20 Feb 2024 22:15:25 +1100 Subject: [PATCH 074/213] fixes --- test/ext.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/test/ext.lean b/test/ext.lean index e0799efb90..3e00798a7c 100644 --- a/test/ext.lean +++ b/test/ext.lean @@ -47,7 +47,6 @@ example (f g : Nat → Nat) (h : f = g) : f = g := by exact h ▸ rfl -- allow more specific ext theorems -declare_ext_theorems_for Fin @[ext high] theorem Fin.zero_ext (a b : Fin 0) : True → a = b := by cases a.isLt example (a b : Fin 0) : a = b := by ext; exact True.intro From 0b837b3e342e0857544d5680aacad4c64edf9192 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Wed, 21 Feb 2024 09:17:14 +0000 Subject: [PATCH 075/213] chore: bump to nightly-2024-02-21 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 0e72c49726..423cb48009 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-20 +leanprover/lean4:nightly-2024-02-21 From ef9605132091513a2efb23d45af5fe94d839730c Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 22 Feb 2024 13:00:14 +1100 Subject: [PATCH 076/213] fixes --- Std.lean | 5 - Std/Data/Fin/Lemmas.lean | 1 - Std/Data/List/Basic.lean | 15 - Std/Data/List/Lemmas.lean | 11 - Std/Data/Sum/Basic.lean | 10 - Std/Lean/Meta/Basic.lean | 122 ------ Std/Tactic/Basic.lean | 1 - Std/Tactic/LabelAttr.lean | 95 ----- Std/Tactic/LibrarySearch.lean | 6 +- Std/Tactic/Relation/Symm.lean | 119 ------ Std/Tactic/SimpTrace.lean | 123 ------ Std/Tactic/SolveByElim.lean | 564 -------------------------- Std/Tactic/SolveByElim/Backtrack.lean | 205 ---------- Std/Tactic/SqueezeScope.lean | 4 +- Std/Test/Internal/DummyLabelAttr.lean | 2 +- test/solve_by_elim.lean | 1 - test/symm.lean | 2 +- 17 files changed, 7 insertions(+), 1279 deletions(-) delete mode 100644 Std/Tactic/LabelAttr.lean delete mode 100644 Std/Tactic/Relation/Symm.lean delete mode 100644 Std/Tactic/SimpTrace.lean delete mode 100644 Std/Tactic/SolveByElim.lean delete mode 100644 Std/Tactic/SolveByElim/Backtrack.lean diff --git a/Std.lean b/Std.lean index f10aba2351..b0dbf9bbf9 100644 --- a/Std.lean +++ b/Std.lean @@ -86,7 +86,6 @@ import Std.Tactic.FalseOrByContra import Std.Tactic.GuardMsgs import Std.Tactic.Init import Std.Tactic.Instances -import Std.Tactic.LabelAttr import Std.Tactic.LibrarySearch import Std.Tactic.Lint import Std.Tactic.Lint.Basic @@ -101,12 +100,8 @@ import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix import Std.Tactic.Relation.Rfl -import Std.Tactic.Relation.Symm import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm -import Std.Tactic.SimpTrace -import Std.Tactic.SolveByElim -import Std.Tactic.SolveByElim.Backtrack import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable import Std.Tactic.Where diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index f49e30b2a2..015d8b66f9 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Fin.Basic -import Std.Tactic.SimpTrace namespace Fin diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index fae17b3a3b..3ae5866455 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -659,21 +659,6 @@ partitionMap (id : Nat ⊕ Nat → Nat ⊕ Nat) [inl 0, inr 1, inl 2] = ([0, 2], | .inl a => go xs (acc₁.push a) acc₂ | .inr b => go xs acc₁ (acc₂.push b) -/-- Monadic generalization of `List.partition`. -/ -@[inline] def partitionM [Monad m] (p : α → m Bool) (l : List α) : m (List α × List α) := - go l #[] #[] -where - /-- Auxiliary for `partitionM`: - `partitionM.go p l acc₁ acc₂` returns `(acc₁.toList ++ left, acc₂.toList ++ right)` - if `partitionM p l` returns `(left, right)`. -/ - @[specialize] go : List α → Array α → Array α → m (List α × List α) - | [], acc₁, acc₂ => pure (acc₁.toList, acc₂.toList) - | x :: xs, acc₁, acc₂ => do - if ← p x then - go xs (acc₁.push x) acc₂ - else - go xs acc₁ (acc₂.push x) - /-- Fold a list from left to right as with `foldl`, but the combining function also receives each element's index. diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index dca73ed145..25c2922bc4 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -793,11 +793,6 @@ theorem get_of_eq {l l' : List α} (h : l = l') (i : Fin l.length) : theorem get_zero : ∀ {l : List α} (h : 0 < l.length), l.get ⟨0, h⟩ = l.head? | _::_, _ => rfl -theorem get_append : ∀ {l₁ l₂ : List α} (n : Nat) (h : n < l₁.length), - (l₁ ++ l₂).get ⟨n, length_append .. ▸ Nat.lt_add_right _ h⟩ = l₁.get ⟨n, h⟩ -| a :: l, _, 0, h => rfl -| a :: l, _, n+1, h => by simp only [get, cons_append]; apply get_append - theorem get?_append_right : ∀ {l₁ l₂ : List α} {n : Nat}, l₁.length ≤ n → (l₁ ++ l₂).get? n = l₂.get? (n - l₁.length) | [], _, n, _ => rfl @@ -822,12 +817,6 @@ theorem get_of_append {l : List α} (eq : l = l₁ ++ a :: l₂) (h : l₁.lengt @[simp] theorem get_replicate (a : α) {n : Nat} (m : Fin _) : (replicate n a).get m = a := eq_of_mem_replicate (get_mem _ _ _) -theorem get?_append {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) : - (l₁ ++ l₂).get? n = l₁.get? n := by - have hn' : n < (l₁ ++ l₂).length := Nat.lt_of_lt_of_le hn <| - length_append .. ▸ Nat.le_add_right .. - rw [get?_eq_get hn, get?_eq_get hn', get_append] - @[simp] theorem getLastD_concat (a b l) : @getLastD α (l ++ [b]) a = b := by rw [getLastD_eq_getLast?, getLast?_concat]; rfl diff --git a/Std/Data/Sum/Basic.lean b/Std/Data/Sum/Basic.lean index c5e93ed8f3..9ec75129b8 100644 --- a/Std/Data/Sum/Basic.lean +++ b/Std/Data/Sum/Basic.lean @@ -63,16 +63,6 @@ def getLeft : (ab : α ⊕ β) → ab.isLeft → α 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 diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index 8bdaecf130..cb9a4bc166 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -99,133 +99,11 @@ Erase any assignment or delayed assignment of the given metavariable. def eraseAssignment [MonadMCtx m] (mvarId : MVarId) : m Unit := modifyMCtx (·.eraseExprMVarAssignment mvarId) -/-- -Collect the metavariables which `mvarId` depends on. These are the metavariables -which appear in the type and local context of `mvarId`, as well as the -metavariables which *those* metavariables depend on, etc. --/ -partial def getMVarDependencies (mvarId : MVarId) (includeDelayed := false) : - MetaM (HashSet MVarId) := - (·.snd) <$> (go mvarId).run {} -where - /-- Auxiliary definition for `getMVarDependencies`. -/ - addMVars (e : Expr) : StateRefT (HashSet MVarId) MetaM Unit := do - let mvars ← getMVars e - let mut s ← get - set ({} : HashSet MVarId) -- Ensure that `s` is not shared. - for mvarId in mvars do - if ← pure includeDelayed <||> notM (mvarId.isDelayedAssigned) then - s := s.insert mvarId - set s - mvars.forM go - - /-- Auxiliary definition for `getMVarDependencies`. -/ - go (mvarId : MVarId) : StateRefT (HashSet MVarId) MetaM Unit := - withIncRecDepth do - let mdecl ← mvarId.getDecl - addMVars mdecl.type - for ldecl in mdecl.lctx do - addMVars ldecl.type - if let (some val) := ldecl.value? then - addMVars val - if let (some ass) ← getDelayedMVarAssignment? mvarId then - let pendingMVarId := ass.mvarIdPending - if ← notM pendingMVarId.isAssignedOrDelayedAssigned then - modify (·.insert pendingMVarId) - go pendingMVarId - -/-- Check if a goal is of a subsingleton type. -/ -def isSubsingleton (g : MVarId) : MetaM Bool := do - try - discard <| synthInstance (← mkAppM ``Subsingleton #[← g.getType]) - return true - catch _ => - return false - -/-- -Check if a goal is "independent" of a list of other goals. -We say a goal is independent of other goals if assigning a value to it -can not change the assignability of the other goals. - -Examples: -* `?m_1 : Type` is not independent of `?m_2 : ?m_1`, - because we could assign `true : Bool` to `?m_2`, - but if we first assign `Nat` to `?m_1` then that is no longer possible. -* `?m_1 : Nat` is not independent of `?m_2 : Fin ?m_1`, - because we could assign `37 : Fin 42` to `?m_2`, - but if we first assign `2` to `?m_1` then that is no longer possible. -* `?m_1 : ?m_2` is not independent of `?m_2 : Type`, because we could assign `Bool` to ?m_2`, - but if we first assign `0 : Nat` to `?m_1` then that is no longer possible. -* Given `P : Prop` and `f : P → Type`, `?m_1 : P` is independent of `?m_2 : f ?m_1` - by proof irrelevance. -* Similarly given `f : Fin 0 → Type`, `?m_1 : Fin 0` is independent of `?m_2 : f ?m_1`, - because `Fin 0` is a subsingleton. -* Finally `?m_1 : Nat` is independent of `?m_2 : α`, - as long as `?m_1` does not appear in `Meta.getMVars α` - (note that `Meta.getMVars` follows delayed assignments). - -This function only calculates a conservative approximation of this condition. -That is, it may return `false` when it should return `true`. -(In particular it returns false whenever the type of `g` contains a metavariable, -regardless of whether this is related to the metavariables in `L`.) --/ -def isIndependentOf (L : List MVarId) (g : MVarId) : MetaM Bool := g.withContext do - let t ← instantiateMVars (← g.getType) - if t.hasExprMVar then - -- If the goal's type contains other meta-variables, - -- we conservatively say that `g` is not independent. - -- It would be possible to check if `L` depends on these meta-variables. - return false - if (← inferType t).isProp then - -- If the goal is propositional, - -- proof-irrelevance ensures it is independent of any other goals. - return true - if ← g.isSubsingleton then - -- If the goal is a subsingleton, it is independent of any other goals. - return true - -- Finally, we check if the goal `g` appears in the type of any of the goals `L`. - L.allM fun g' => do pure !((← getMVarDependencies g').contains g) - /-- Solve a goal by synthesizing an instance. -/ -- FIXME: probably can just be `g.inferInstance` once leanprover/lean4#2054 is fixed def synthInstance (g : MVarId) : MetaM Unit := do g.assign (← Lean.Meta.synthInstance (← g.getType)) -/-- -Replace hypothesis `hyp` in goal `g` with `proof : typeNew`. -The new hypothesis is given the same user name as the original, -it attempts to avoid reordering hypotheses, and the original is cleared if possible. --/ --- adapted from Lean.Meta.replaceLocalDeclCore -def replace (g : MVarId) (hyp : FVarId) (proof : Expr) (typeNew : Option Expr := none) : - MetaM AssertAfterResult := - g.withContext do - let typeNew ← match typeNew with - | some t => pure t - | none => inferType proof - let ldecl ← hyp.getDecl - -- `typeNew` may contain variables that occur after `hyp`. - -- Thus, we use the auxiliary function `findMaxFVar` to ensure `typeNew` is well-formed - -- at the position we are inserting it. - let (_, ldecl') ← findMaxFVar typeNew |>.run ldecl - let result ← g.assertAfter ldecl'.fvarId ldecl.userName typeNew proof - (return { result with mvarId := ← result.mvarId.clear hyp }) <|> pure result -where - /-- Finds the `LocalDecl` for the FVar in `e` with the highest index. -/ - findMaxFVar (e : Expr) : StateRefT LocalDecl MetaM Unit := - e.forEach' fun e => do - if e.isFVar then - let ldecl' ← e.fvarId!.getDecl - modify fun ldecl => if ldecl'.index > ldecl.index then ldecl' else ldecl - return false - else - return e.hasFVar - -/-- Add the hypothesis `h : t`, given `v : t`, and return the new `FVarId`. -/ -def note (g : MVarId) (h : Name) (v : Expr) (t? : Option Expr := .none) : - MetaM (FVarId × MVarId) := do - (← g.assert h (← match t? with | some t => pure t | none => inferType v) v).intro1P - /-- Get the type the given metavariable after instantiating metavariables and cleaning up annotations. -/ def getTypeCleanup (mvarId : MVarId) : MetaM Expr := diff --git a/Std/Tactic/Basic.lean b/Std/Tactic/Basic.lean index 0b21cf03f2..bda6786db5 100644 --- a/Std/Tactic/Basic.lean +++ b/Std/Tactic/Basic.lean @@ -3,7 +3,6 @@ import Std.Linter import Std.Tactic.Init import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm -import Std.Tactic.SimpTrace import Std.Util.ProofWanted -- This is an import only file for common tactics used throughout Std diff --git a/Std/Tactic/LabelAttr.lean b/Std/Tactic/LabelAttr.lean deleted file mode 100644 index c6b5fcba67..0000000000 --- a/Std/Tactic/LabelAttr.lean +++ /dev/null @@ -1,95 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Lean.ScopedEnvExtension -import Lean.DocString - -/-! -# "Label" attributes - -Allow creating attributes using `register_label_attr`, -and retrieving the array of `Name`s of declarations which have been tagged with such an attribute. - -These differ slightly from the built-in "tag attributes" which can be initialized with the syntax: -``` -initialize someName : TagAttribute ← registerTagAttribute `tagName "description" -``` -in that a "tag attribute" can only be put on a declaration at the moment it is declared, -and can not be modified by scoping commands. - -The "label attributes" constructed here support adding (or locally removing) the attribute -either at the moment of declaration, or later. - --/ - -namespace Std.Tactic.LabelAttr - -open Lean - -/-- An environment extension that just tracks an array of names. -/ -abbrev LabelExtension := SimpleScopedEnvExtension Name (Array Name) - -/-- The collection of all current `LabelExtension`s, indexed by name. -/ -abbrev LabelExtensionMap := HashMap Name LabelExtension - -/-- Store the current `LabelExtension`s. -/ -initialize labelExtensionMapRef : IO.Ref LabelExtensionMap ← IO.mkRef {} - -/-- Helper function for `registerLabelAttr`. -/ -def mkLabelExt (name : Name := by exact decl_name%) : IO LabelExtension := - registerSimpleScopedEnvExtension { - name := name - initial := #[] - addEntry := fun d e => if d.contains e then d else d.push e - } - -/-- Helper function for `registerLabelAttr`. -/ -def mkLabelAttr (attrName : Name) (attrDescr : String) (ext : LabelExtension) - (ref : Name := by exact decl_name%) : IO Unit := -registerBuiltinAttribute { - ref := ref - name := attrName - descr := attrDescr - applicationTime := AttributeApplicationTime.afterCompilation - add := fun declName _ _ => - ext.add declName - erase := fun declName => do - let s := ext.getState (← getEnv) - modifyEnv fun env => ext.modifyState env fun _ => s.erase declName -} - -/-- -Construct a new "label attribute", -which does nothing except keep track of the names of the declarations with that attribute. - -Users will generally use the `register_label_attr` macro defined below. --/ -def registerLabelAttr (attrName : Name) (attrDescr : String) - (ref : Name := by exact decl_name%) : IO LabelExtension := do - let ext ← mkLabelExt ref - mkLabelAttr attrName attrDescr ext ref - labelExtensionMapRef.modify fun map => map.insert attrName ext - return ext - -/-- -Initialize a new "label" attribute. -Declarations tagged with the attribute can be retrieved using `Std.Tactic.LabelAttr.labelled`. --/ -macro (name := _root_.Lean.Parser.Command.registerLabelAttr) doc:(docComment)? - "register_label_attr " id:ident : command => do - let str := id.getId.toString - let idParser := mkIdentFrom id (`Parser.Attr ++ id.getId) - let descr := quote (removeLeadingSpaces - (doc.map (·.getDocString) |>.getD s!"labelled declarations for {id.getId.toString}")) - `($[$doc:docComment]? initialize ext : LabelExtension ← - registerLabelAttr $(quote id.getId) $descr $(quote id.getId) - $[$doc:docComment]? syntax (name := $idParser:ident) $(quote str):str : attr) - -/-- When `attrName` is an attribute created using `register_labelled_attr`, -return the names of all declarations labelled using that attribute. -/ -def labelled (attrName : Name) : CoreM (Array Name) := do - match (← labelExtensionMapRef.get).find? attrName with - | none => throwError "No extension named {attrName}" - | some ext => pure <| ext.getState (← getEnv) diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean index 104c8c67f3..8ed339f932 100644 --- a/Std/Tactic/LibrarySearch.lean +++ b/Std/Tactic/LibrarySearch.lean @@ -9,7 +9,7 @@ import Std.Lean.Expr import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Parser -import Std.Tactic.SolveByElim +import Lean.Elab.Tactic.SolveByElim import Std.Util.Pickle /-! @@ -362,11 +362,13 @@ def mkHeartbeatCheck (leavePercent : Nat) : MetaM (MetaM Bool) := do else do return (← getRemainingHeartbeats) < hbThreshold +open SolveByElim + /-- Shortcut for calling `solveByElim`. -/ def solveByElim (required : List Expr) (exfalso : Bool) (goals : List MVarId) (maxDepth : Nat) := do -- There is only a marginal decrease in performance for using the `symm` option for `solveByElim`. -- (measured via `lake build && time lake env lean test/librarySearch.lean`). - let cfg : SolveByElim.Config := + let cfg : SolveByElimConfig := { maxDepth, exfalso := exfalso, symm := true, commitIndependentGoals := true, transparency := ← getTransparency, -- `constructor` has been observed to significantly slow down `exact?` in Mathlib. diff --git a/Std/Tactic/Relation/Symm.lean b/Std/Tactic/Relation/Symm.lean deleted file mode 100644 index 2369a4efd6..0000000000 --- a/Std/Tactic/Relation/Symm.lean +++ /dev/null @@ -1,119 +0,0 @@ -/- -Copyright (c) 2022 Siddhartha Gadgil. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Siddhartha Gadgil, Mario Carneiro, Scott Morrison --/ -import Lean.Meta.Reduce -import Lean.Elab.Tactic.Location -import Std.Lean.Meta.Basic - -/-! -# `symm` tactic - -This implements the `symm` tactic, which can apply symmetry theorems to either the goal or a -hypothesis. --/ - -set_option autoImplicit true - -open Lean Meta - -namespace Std.Tactic - -/-- Discrimation tree settings for the `symm` extension. -/ -def symmExt.config : WhnfCoreConfig := {} - -/-- Environment extensions for symm lemmas -/ -initialize symmExt : - SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ← - registerSimpleScopedEnvExtension { - addEntry := fun dt (n, ks) => dt.insertCore ks n - initial := {} - } - -initialize registerBuiltinAttribute { - name := `symm - descr := "symmetric relation" - add := fun decl _ kind => MetaM.run' do - let declTy := (← getConstInfo decl).type - let (xs, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy - let fail := throwError - "@[symm] attribute only applies to lemmas proving x ∼ y → y ∼ x, got {declTy}" - let some _ := xs.back? | fail - let targetTy ← reduce targetTy - let .app (.app rel _) _ := targetTy | fail - let key ← withReducible <| DiscrTree.mkPath rel symmExt.config - symmExt.add (decl, key) kind -} - -end Std.Tactic - -open Std.Tactic - -namespace Lean.Expr - -/-- Return the symmetry lemmas that match the target type. -/ -def getSymmLems (tgt : Expr) : MetaM (Array Name) := do - let .app (.app rel _) _ := tgt - | throwError "symmetry lemmas only apply to binary relations, not{indentExpr tgt}" - (symmExt.getState (← getEnv)).getMatch rel symmExt.config - -/-- Given a term `e : a ~ b`, construct a term in `b ~ a` using `@[symm]` lemmas. -/ -def applySymm (e : Expr) : MetaM Expr := do - let tgt <- instantiateMVars (← inferType e) - let lems ← getSymmLems tgt - let s ← saveState - let act lem := do - restoreState s - let lem ← mkConstWithFreshMVarLevels lem - let (args, _, body) ← withReducible <| forallMetaTelescopeReducing (← inferType lem) - let .true ← isDefEq args.back e | failure - mkExpectedTypeHint (mkAppN lem args) (← instantiateMVars body) - lems.toList.firstM act - <|> throwError m!"no applicable symmetry lemma found for {indentExpr tgt}" - -end Lean.Expr - - -namespace Lean.MVarId - -/-- -Apply a symmetry lemma (i.e. marked with `@[symm]`) to a metavariable. - -The type of `g` should be of the form `a ~ b`, and is used to index the symm lemmas. --/ -def applySymm (g : MVarId) : MetaM MVarId := do - let tgt <- g.getTypeCleanup - let lems ← Expr.getSymmLems tgt - let act lem : MetaM MVarId := do - let lem ← mkConstWithFreshMVarLevels lem - let (args, _, body) ← withReducible <| forallMetaTelescopeReducing (← inferType lem) - let .true ← isDefEq (← g.getType) body | failure - g.assign (mkAppN lem args) - let g' := args.back.mvarId! - g'.setTag (← g.getTag) - pure g' - lems.toList.firstM act - <|> throwError m!"no applicable symmetry lemma found for {indentExpr tgt}" - -/-- Use a symmetry lemma (i.e. marked with `@[symm]`) to replace a hypothesis in a goal. -/ -def applySymmAt (h : FVarId) (g : MVarId) : MetaM MVarId := do - let h' ← (Expr.fvar h).applySymm - pure (← g.replace h h').mvarId - -end Lean.MVarId - -namespace Std.Tactic - -open Lean.Elab.Tactic - -/-- -* `symm` applies to a goal whose target has the form `t ~ u` where `~` is a symmetric relation, - that is, a relation which has a symmetry lemma tagged with the attribute [symm]. - It replaces the target with `u ~ t`. -* `symm at h` will rewrite a hypothesis `h : t ~ u` to `h : u ~ t`. --/ -elab "symm" loc:((Parser.Tactic.location)?) : tactic => - let atHyp h := liftMetaTactic1 fun g => g.applySymmAt h - let atTarget := liftMetaTactic1 fun g => g.applySymm - withLocation (expandOptLocation loc) atHyp atTarget fun _ => throwError "symm made no progress" diff --git a/Std/Tactic/SimpTrace.lean b/Std/Tactic/SimpTrace.lean deleted file mode 100644 index 30f1edbea1..0000000000 --- a/Std/Tactic/SimpTrace.lean +++ /dev/null @@ -1,123 +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 --/ -import Lean.Elab.ElabRules -import Lean.Elab.Tactic.Simp -import Lean.Meta.Tactic.TryThis -import Std.Lean.Parser - -/-! -# `simp?` tactic - -The `simp?` tactic is a simple wrapper around the simp with trace behavior implemented in core. --/ -namespace Std.Tactic -open Lean Elab Parser Tactic Meta Simp Meta.Tactic - -/-- The common arguments of `simp?` and `simp?!`. -/ -syntax simpTraceArgsRest := (config)? (discharger)? (&" only")? (simpArgs)? (ppSpace location)? - -/-- -`simp?` takes the same arguments as `simp`, but reports an equivalent call to `simp only` -that would be sufficient to close the goal. This is useful for reducing the size of the simp -set in a local invocation to speed up processing. -``` -example (x : Nat) : (if True then x + 2 else 3) = x + 2 := by - simp? -- prints "Try this: simp only [ite_true]" -``` - -This command can also be used in `simp_all` and `dsimp`. --/ -syntax (name := simpTrace) "simp?" "!"? simpTraceArgsRest : tactic - -@[inherit_doc simpTrace] -macro tk:"simp?!" rest:simpTraceArgsRest : tactic => `(tactic| simp?%$tk ! $rest) - -open TSyntax.Compat in -/-- Constructs the syntax for a simp call, for use with `simp?`. -/ -def mkSimpCallStx (stx : Syntax) (usedSimps : UsedSimps) : MetaM (TSyntax `tactic) := do - let stx := stx.unsetTrailing - mkSimpOnly stx usedSimps - -elab_rules : tactic - | `(tactic| - simp?%$tk $[!%$bang]? $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) => do - let stx ← if bang.isSome then - `(tactic| simp!%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) - else - `(tactic| simp%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) - let { ctx, simprocs, dischargeWrapper } ← - withMainContext <| mkSimpContext stx (eraseLocal := false) - let usedSimps ← dischargeWrapper.with fun discharge? => - simpLocation ctx (simprocs := simprocs) discharge? <| - (loc.map expandLocation).getD (.targets #[] true) - let stx ← mkSimpCallStx stx usedSimps - TryThis.addSuggestion tk stx (origSpan? := ← getRef) - -/-- The common arguments of `simp_all?` and `simp_all?!`. -/ -syntax simpAllTraceArgsRest := (config)? (discharger)? (&" only")? (dsimpArgs)? - -@[inherit_doc simpTrace] -syntax (name := simpAllTrace) "simp_all?" "!"? simpAllTraceArgsRest : tactic - -@[inherit_doc simpTrace] -macro tk:"simp_all?!" rest:simpAllTraceArgsRest : tactic => `(tactic| simp_all?%$tk ! $rest) - -elab_rules : tactic - | `(tactic| simp_all?%$tk $[!%$bang]? $(config)? $(discharger)? $[only%$o]? $[[$args,*]]?) => do - let stx ← if bang.isSome then - `(tactic| simp_all!%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]?) - else - `(tactic| simp_all%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]?) - let { ctx, .. } ← mkSimpContext stx (eraseLocal := true) - (kind := .simpAll) (ignoreStarArg := true) - let (result?, usedSimps) ← simpAll (← getMainGoal) ctx - match result? with - | none => replaceMainGoal [] - | some mvarId => replaceMainGoal [mvarId] - let stx ← mkSimpCallStx stx usedSimps - TryThis.addSuggestion tk stx (origSpan? := ← getRef) - -/-- The common arguments of `dsimp?` and `dsimp?!`. -/ -syntax dsimpTraceArgsRest := (config)? (&" only")? (dsimpArgs)? (ppSpace location)? - --- TODO: move to core -/-- Implementation of `dsimp`. -/ -def dsimpLocation' (ctx : Simp.Context) (loc : Location) : TacticM Simp.UsedSimps := do - match loc with - | Location.targets hyps simplifyTarget => - withMainContext do - let fvarIds ← getFVarIds hyps - go fvarIds simplifyTarget - | Location.wildcard => - withMainContext do - go (← (← getMainGoal).getNondepPropHyps) (simplifyTarget := true) -where - /-- Implementation of `dsimp`. -/ - go (fvarIdsToSimp : Array FVarId) (simplifyTarget : Bool) : TacticM Simp.UsedSimps := do - let mvarId ← getMainGoal - let (result?, usedSimps) ← - dsimpGoal mvarId ctx (simplifyTarget := simplifyTarget) (fvarIdsToSimp := fvarIdsToSimp) - match result? with - | none => replaceMainGoal [] - | some mvarId => replaceMainGoal [mvarId] - pure usedSimps - -@[inherit_doc simpTrace] -syntax (name := dsimpTrace) "dsimp?" "!"? dsimpTraceArgsRest : tactic - -@[inherit_doc simpTrace] -macro tk:"dsimp?!" rest:dsimpTraceArgsRest : tactic => `(tactic| dsimp?%$tk ! $rest) - -elab_rules : tactic - | `(tactic| dsimp?%$tk $[!%$bang]? $(config)? $[only%$o]? $[[$args,*]]? $(loc)?) => do - let stx ← if bang.isSome then - `(tactic| dsimp!%$tk $(config)? $[only%$o]? $[[$args,*]]? $(loc)?) - else - `(tactic| dsimp%$tk $(config)? $[only%$o]? $[[$args,*]]? $(loc)?) - let { ctx, .. } ← withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp) - let usedSimps ← dsimpLocation' ctx <| (loc.map expandLocation).getD (.targets #[] true) - let stx ← mkSimpCallStx stx usedSimps - TryThis.addSuggestion tk stx (origSpan? := ← getRef) diff --git a/Std/Tactic/SolveByElim.lean b/Std/Tactic/SolveByElim.lean deleted file mode 100644 index f97fd74492..0000000000 --- a/Std/Tactic/SolveByElim.lean +++ /dev/null @@ -1,564 +0,0 @@ -/- -Copyright (c) 2021 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison, David Renshaw --/ -import Lean.Elab.Tactic.Config -import Lean.Meta.Tactic.Repeat -import Std.Data.Sum.Basic -import Std.Tactic.LabelAttr -import Std.Tactic.Relation.Symm -import Std.Tactic.SolveByElim.Backtrack - -/-! -# `solve_by_elim`, `apply_rules`, and `apply_assumption`. - -`solve_by_elim` takes a collection of facts from the local context or -supplied as arguments by the user, and performs a backtracking -depth-first search by attempting to `apply` these facts to the goal. - -It is a highly configurable tactic, with options to control the -backtracking, to solve multiple goals simultaneously (with backtracking -between goals), or to supply a discharging tactic for unprovable goals. - -`apply_rules` and `apply_assumption` are much simpler tactics which do -not perform backtracking, but are currently implemented in terms of -`solve_by_elim` with backtracking disabled, in order to be able to share -the front-end customisation and parsing of user options. It would be -reasonable to further separate these in future. --/ - -open Lean Meta Elab Tactic -open Std.Tactic - -namespace Lean.MVarId - -/-- For every hypothesis `h : a ~ b` where a `@[symm]` lemma is available, -add a hypothesis `h_symm : b ~ a`. -/ -def symmSaturate (g : MVarId) : MetaM MVarId := g.withContext do - let mut g' := g - let hyps ← getLocalHyps - let types ← hyps.mapM inferType - for h in hyps do try - let symm ← h.applySymm - let symmType ← inferType symm - if ¬ (← types.anyM (isDefEq symmType)) then - (_, g') ← g'.note ((← h.fvarId!.getUserName).appendAfter "_symm") symm - catch _ => g' ← pure g' - return g' - -end Lean.MVarId - -namespace Std.Tactic - -open Lean.Elab.Tactic - -/-- For every hypothesis `h : a ~ b` where a `@[symm]` lemma is available, -add a hypothesis `h_symm : b ~ a`. -/ -elab "symm_saturate" : tactic => liftMetaTactic1 fun g => g.symmSaturate - -initialize registerTraceClass `Meta.Tactic.solveByElim - -namespace SolveByElim - -/-- -`applyTactics lemmas goal` will return an iterator that applies the -lemmas to the goal `goal` and returns ones that succeed. - -Providing this to the `backtracking` tactic, -we can perform backtracking search based on applying a list of lemmas. - -``applyTactics (trace := `name)`` will construct trace nodes for ``name` indicating which -calls to `apply` succeeded or failed. --/ -def applyTactics (cfg : ApplyConfig := {}) (transparency : TransparencyMode := .default) - (lemmas : List Expr) (g : MVarId) : MetaM (Lean.Meta.Iterator (List Lean.MVarId)) := do - pure <| - (← Meta.Iterator.ofList lemmas).filterMapM (fun e => observing? do - withTraceNode `Meta.Tactic.solveByElim (return m!"{Except.emoji ·} trying to apply: {e}") do - let goals ← withTransparency transparency (g.apply e cfg) - -- When we call `apply` interactively, `Lean.Elab.Tactic.evalApplyLikeTactic` - -- deals with closing new typeclass goals by calling - -- `Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing`. - -- It seems we can't reuse that machinery down here in `MetaM`, - -- so we just settle for trying to close each subgoal using `inferInstance`. - goals.filterM fun g => try g.inferInstance; pure false catch _ => pure true) - - -/-- -`applyFirst lemmas goal` applies the first of the `lemmas` -which can be successfully applied to `goal`, and fails if none apply. - -We use this in `apply_rules` and `apply_assumption` where backtracking is not needed. --/ -def applyFirst (cfg : ApplyConfig := {}) (transparency : TransparencyMode := .default) - (lemmas : List Expr) (g : MVarId) : MetaM (List MVarId) := do - (←applyTactics cfg transparency lemmas g).head - -/-- The default `maxDepth` for `apply_rules` is higher. -/ -structure ApplyRulesConfig extends BacktrackConfig, ApplyConfig where - /-- Transparency mode for calls to `apply`. -/ - transparency : TransparencyMode := .default - /-- Also use symmetric versions (via `@[symm]`) of local hypotheses. -/ - symm : Bool := true - /-- Try proving the goal via `exfalso` if `solve_by_elim` otherwise fails. - This is only used when operating on a single goal. -/ - exfalso : Bool := true - maxDepth := 50 - -/-- -Configuration structure to control the behaviour of `solve_by_elim`: -* transparency mode for calls to `apply` -* whether to use `symm` on hypotheses and `exfalso` on the goal as needed, -* see also `BacktrackConfig` for hooks allowing flow control. --/ -structure Config extends ApplyRulesConfig where - /-- Enable backtracking search. -/ - backtracking : Bool := true - maxDepth := 6 - /-- Trying calling `intro` if no lemmas apply. -/ - intro : Bool := true - /-- Try calling `constructor` if no lemmas apply. -/ - constructor : Bool := true - -instance : Coe Config BacktrackConfig := ⟨(·.toApplyRulesConfig.toBacktrackConfig)⟩ - -/-- -Allow elaboration of `Config` arguments to tactics. --/ -declare_config_elab elabConfig Config - -/-- -Allow elaboration of `ApplyRulesConfig` arguments to tactics. --/ -declare_config_elab elabApplyRulesConfig ApplyRulesConfig - -/-! -These functions could be lifted up to `BacktrackConfig`, -but we'd still need to keep copies here. --/ -namespace Config - -/-- Create or modify a `Config` which allows a class of goals to be returned as subgoals. -/ -def accept (cfg : Config := {}) (test : MVarId → MetaM Bool) : Config := - { cfg with - discharge := fun g => do - if (← test g) then - pure none - else - cfg.discharge g } - -/-- -Create or modify a `Config` which runs a tactic on the main goal. -If that tactic fails, fall back to the `proc` behaviour of `cfg`. --/ -def mainGoalProc (cfg : Config := {}) (proc : MVarId → MetaM (List MVarId)) : Config := - { cfg with - proc := fun orig goals => match goals with - | [] => cfg.proc orig [] - | g :: gs => try - return (← proc g) ++ gs - catch _ => cfg.proc orig goals } - -/-- Create or modify a `Config` which calls `intro` on each goal before applying lemmas. -/ --- Because `SolveByElim` works on each goal in sequence, even though --- `mainGoalProc` only applies this operation on the main goal, --- it is applied to every goal before lemmas are applied. -def intros (cfg : Config := {}) : Config := - cfg.mainGoalProc fun g => do pure [(← g.intro1P).2] - -/-- Attempt typeclass inference on each goal, before applying lemmas. -/ --- Because `SolveByElim` works on each goal in sequence, even though --- `mainGoalProc` only applies this operation on the main goal, --- it is applied to every goal before lemmas are applied. -def synthInstance (cfg : Config := {}) : Config := - cfg.mainGoalProc fun g => do g.synthInstance; pure [] - -/-- Add a discharging tactic, falling back to the original discharging tactic if it fails. -Return `none` to return the goal as a new subgoal, or `some goals` to replace it. -/ -def withDischarge (cfg : Config := {}) (discharge : MVarId → MetaM (Option (List MVarId))) : - Config := - { cfg with - discharge := fun g => try discharge g - catch _ => cfg.discharge g } - -/-- Create or modify a `Config` which calls `intro` on any goal for which no lemma applies. -/ -def introsAfter (cfg : Config := {}) : Config := - cfg.withDischarge fun g => do pure [(← g.intro1P).2] - -/-- Call `constructor` when no lemmas apply. -/ -def constructorAfter (cfg : Config := {}) : Config := - cfg.withDischarge fun g => g.constructor {newGoals := .all} - -/-- Create or modify a `Config` which -calls `synthInstance` on any goal for which no lemma applies. -/ -def synthInstanceAfter (cfg : Config := {}) : Config := - cfg.withDischarge fun g => do g.synthInstance; pure (some []) - -/-- -Create or modify a `Config` which rejects branches for which `test`, -applied to the instantiations of the original goals, fails or returns `false`. --/ -def testPartialSolutions (cfg : Config := {}) (test : List Expr → MetaM Bool) : Config := - { cfg with - proc := fun orig goals => do - let .true ← test (← orig.mapM fun m => m.withContext do instantiateMVars (.mvar m)) | failure - cfg.proc orig goals } - -/-- -Create or modify a `Config` which rejects complete solutions for which `test`, -applied to the instantiations of the original goals, fails or returns `false`. --/ -def testSolutions (cfg : Config := {}) (test : List Expr → MetaM Bool) : Config := - cfg.testPartialSolutions fun sols => do - if sols.any Expr.hasMVar then - pure true - else - test sols - -/-- -Create or modify a `Config` which only accept solutions -for which every expression in `use` appears as a subexpression. --/ -def requireUsingAll (cfg : Config := {}) (use : List Expr) : Config := - cfg.testSolutions fun sols => do - pure <| use.all fun e => sols.any fun s => e.occurs s - -/-- -Process the `intro` and `constructor` options by implementing the `discharger` tactic. --/ -def processOptions (cfg : Config) : Config := - let cfg := if cfg.intro then introsAfter { cfg with intro := false } else cfg - let cfg := if cfg.constructor then constructorAfter { cfg with constructor := false } else cfg - cfg - -end Config - -/-- -Elaborate a list of lemmas and local context. -See `mkAssumptionSet` for an explanation of why this is needed. --/ -def elabContextLemmas (g : MVarId) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr)) : - MetaM (List Expr) := do - g.withContext (Elab.Term.TermElabM.run' do pure ((← ctx) ++ (← lemmas.mapM id))) - -/-- Returns the list of tactics corresponding to applying the available lemmas to the goal. -/ -def applyLemmas (cfg : Config) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr)) - (g : MVarId) - : MetaM (Meta.Iterator (List MVarId)) := do - let es ← elabContextLemmas g lemmas ctx - applyTactics cfg.toApplyConfig cfg.transparency es g - -/-- Applies the first possible lemma to the goal. -/ -def applyFirstLemma (cfg : Config) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr)) - (g : MVarId) : MetaM (List MVarId) := do -let es ← elabContextLemmas g lemmas ctx -applyFirst cfg.toApplyConfig cfg.transparency es g - -/-- -Solve a collection of goals by repeatedly applying lemmas, backtracking as necessary. - -Arguments: -* `cfg : Config` additional configuration options - (options for `apply`, maximum depth, and custom flow control) -* `lemmas : List (TermElabM Expr)` lemmas to apply. - These are thunks in `TermElabM` to avoid stuck metavariables. -* `ctx : TermElabM (List Expr)` monadic function returning the local hypotheses to use. -* `goals : List MVarId` the initial list of goals for `solveByElim` - -Returns a list of suspended goals, if it succeeded on all other subgoals. -By default `cfg.suspend` is `false,` `cfg.discharge` fails, and `cfg.failAtMaxDepth` is `true`, -and so the returned list is always empty. -Custom wrappers (e.g. `apply_assumption` and `apply_rules`) may modify this behaviour. --/ -def solveByElim (cfg : Config) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr)) - (goals : List MVarId) : MetaM (List MVarId) := do - let cfg := cfg.processOptions - -- We handle `cfg.symm` by saturating hypotheses of all goals using `symm`. - -- This has better performance that the mathlib3 approach. - let preprocessedGoals ← if cfg.symm then - goals.mapM fun g => g.symmSaturate - else - pure goals - try - run cfg preprocessedGoals - catch e => do - -- Implementation note: as with `cfg.symm`, this is different from the mathlib3 approach, - -- for (not as severe) performance reasons. - match preprocessedGoals, cfg.exfalso with - | [g], true => - withTraceNode `Meta.Tactic.solveByElim - (fun _ => return m!"⏮️ starting over using `exfalso`") do - run cfg [← g.exfalso] - | _, _ => throw e -where - /-- Run either backtracking search, or repeated application, on the list of goals. -/ - run (cfg : Config) : List MVarId → MetaM (List MVarId) := - if cfg.backtracking then - backtrack cfg `Meta.Tactic.solveByElim (applyLemmas cfg lemmas ctx) - else - Lean.Meta.repeat1' (maxIters := cfg.maxDepth) (applyFirstLemma cfg lemmas ctx) - -/-- -A `MetaM` analogue of the `apply_rules` user tactic. - -We pass the lemmas as `TermElabM Expr` rather than just `Expr`, -so they can be generated fresh for each application, to avoid stuck metavariables. - -By default it uses all local hypotheses, but you can disable this with `only := true`. -If you need to remove particular local hypotheses, call `solveByElim` directly. --/ -def _root_.Lean.MVarId.applyRules (cfg : Config) (lemmas : List (TermElabM Expr)) - (only : Bool := false) (g : MVarId) : MetaM (List MVarId) := do - let ctx : TermElabM (List Expr) := if only then pure [] else do pure (← getLocalHyps).toList - solveByElim { cfg with backtracking := false } lemmas ctx [g] - -open Lean.Parser.Tactic -open Std.Tactic.LabelAttr (labelled) - -/-- -`mkAssumptionSet` builds a collection of lemmas for use in -the backtracking search in `solve_by_elim`. - -* By default, it includes all local hypotheses, along with `rfl`, `trivial`, `congrFun` - and `congrArg`. -* The flag `noDefaults` removes these. -* The flag `star` includes all local hypotheses, but not `rfl`, `trivial`, `congrFun`, - or `congrArg`. (It doesn't make sense to use `star` without `noDefaults`.) -* The argument `add` is the list of terms inside the square brackets that did not have `-` - and can be used to add expressions or local hypotheses -* The argument `remove` is the list of terms inside the square brackets that had a `-`, - and can be used to remove local hypotheses. - (It doesn't make sense to remove expressions which are not local hypotheses, - to remove local hypotheses unless `!noDefaults || star`, - and it does not make sense to use `star` unless you remove at least one local hypothesis.) - -`mkAssumptionSet` returns not a `List expr`, but a `List (TermElabM Expr) × TermElabM (List Expr)`. -There are two separate problems that need to be solved. - -### Stuck metavariables - -Lemmas with implicit arguments would be filled in with metavariables if we created the -`Expr` objects immediately, so instead we return thunks that generate the expressions -on demand. This is the first component, with type `List (TermElabM expr)`. - -As an example, we have `def rfl : ∀ {α : Sort u} {a : α}, a = a`, which on elaboration will become -`@rfl ?m_1 ?m_2`. - -Because `solve_by_elim` works by repeated application of lemmas against subgoals, -the first time such a lemma is successfully applied, -those metavariables will be unified, and thereafter have fixed values. -This would make it impossible to apply the lemma -a second time with different values of the metavariables. - -See https://github.com/leanprover-community/mathlib/issues/2269 - -### Relevant local hypotheses - -`solve_by_elim*` works with multiple goals, -and we need to use separate sets of local hypotheses for each goal. -The second component of the returned value provides these local hypotheses. -(Essentially using `local_context`, along with some filtering to remove hypotheses -that have been explicitly removed via `only` or `[-h]`.) - --/ --- These `TermElabM`s must be run inside a suitable `g.withContext`, --- usually using `elabContextLemmas`. -def mkAssumptionSet (noDefaults star : Bool) (add remove : List Term) (use : Array Ident) : - MetaM (List (TermElabM Expr) × TermElabM (List Expr)) := do - if star && !noDefaults then - throwError "It doesn't make sense to use `*` without `only`." - - let defaults : List (TermElabM Expr) := - [← `(rfl), ← `(trivial), ← `(congrFun), ← `(congrArg)].map elab' - let labelledLemmas := (← use.mapM (labelled ·.raw.getId)).flatten.toList - |>.map (liftM <| mkConstWithFreshMVarLevels ·) - let lemmas := if noDefaults then - add.map elab' ++ labelledLemmas - else - add.map elab' ++ labelledLemmas ++ defaults - - if !remove.isEmpty && noDefaults && !star then - throwError "It doesn't make sense to remove local hypotheses when using `only` without `*`." - let locals : TermElabM (List Expr) := if noDefaults && !star then do - pure [] - else do - pure <| (← getLocalHyps).toList.removeAll (← remove.mapM elab') - - return (lemmas, locals) - where - /-- Run `elabTerm`. -/ - elab' (t : Term) : TermElabM Expr := Elab.Term.elabTerm t.raw none - -/-- Syntax for omitting a local hypothesis in `solve_by_elim`. -/ -syntax erase := "-" term:max -/-- Syntax for including all local hypotheses in `solve_by_elim`. -/ -syntax star := "*" -/-- Syntax for adding or removing a term, or `*`, in `solve_by_elim`. -/ -syntax arg := star <|> erase <|> term -/-- Syntax for adding and removing terms in `solve_by_elim`. -/ -syntax args := " [" SolveByElim.arg,* "]" -/-- Syntax for using all lemmas labelled with an attribute in `solve_by_elim`. -/ -syntax using_ := " using " ident,* - -open Syntax - -/-- -Parse the lemma argument of a call to `solve_by_elim`. -The first component should be true if `*` appears at least once. -The second component should contain each term `t`in the arguments. -The third component should contain `t` for each `-t` in the arguments. --/ -def parseArgs (s : Option (TSyntax ``args)) : - Bool × List Term × List Term := - let args : Array (TSyntax ``arg) := match s with - | some s => match s with - | `(args| [$args,*]) => args.getElems - | _ => #[] - | none => #[] - let args : Array (Option (Term ⊕ Term)) := args.map fun t => match t with - | `(arg| $_:star) => none - | `(arg| - $t:term) => some (Sum.inr t) - | `(arg| $t:term) => some (Sum.inl t) - | _ => panic! "Unreachable parse of solve_by_elim arguments." - let args := args.toList - (args.contains none, - args.filterMap fun o => o.bind Sum.getLeft?, - args.filterMap fun o => o.bind Sum.getRight?) - -/-- Parse the `using ...` argument for `solve_by_elim`. -/ -def parseUsing (s : Option (TSyntax ``using_)) : Array Ident := - match s with - | some s => match s with - | `(using_ | using $ids,*) => ids.getElems - | _ => #[] - | none => #[] - -/-- -`solve_by_elim` calls `apply` on the main goal to find an assumption whose head matches -and then repeatedly calls `apply` on the generated subgoals until no subgoals remain, -performing at most `maxDepth` (defaults to 6) recursive steps. - -`solve_by_elim` discharges the current goal or fails. - -`solve_by_elim` performs backtracking if subgoals can not be solved. - -By default, the assumptions passed to `apply` are the local context, `rfl`, `trivial`, -`congrFun` and `congrArg`. - -The assumptions can be modified with similar syntax as for `simp`: -* `solve_by_elim [h₁, h₂, ..., hᵣ]` also applies the given expressions. -* `solve_by_elim only [h₁, h₂, ..., hᵣ]` does not include the local context, - `rfl`, `trivial`, `congrFun`, or `congrArg` unless they are explicitly included. -* `solve_by_elim [-h₁, ... -hₙ]` removes the given local hypotheses. -* `solve_by_elim using [a₁, ...]` uses all lemmas which have been labelled - with the attributes `aᵢ` (these attributes must be created using `register_label_attr`). - -`solve_by_elim*` tries to solve all goals together, using backtracking if a solution for one goal -makes other goals impossible. -(Adding or removing local hypotheses may not be well-behaved when starting with multiple goals.) - -Optional arguments passed via a configuration argument as `solve_by_elim (config := { ... })` -- `maxDepth`: number of attempts at discharging generated subgoals -- `symm`: adds all hypotheses derived by `symm` (defaults to `true`). -- `exfalso`: allow calling `exfalso` and trying again if `solve_by_elim` fails - (defaults to `true`). -- `transparency`: change the transparency mode when calling `apply`. Defaults to `.default`, - but it is often useful to change to `.reducible`, - so semireducible definitions will not be unfolded when trying to apply a lemma. - -See also the doc-comment for `Std.Tactic.BacktrackConfig` for the options -`proc`, `suspend`, and `discharge` which allow further customization of `solve_by_elim`. -Both `apply_assumption` and `apply_rules` are implemented via these hooks. --/ -syntax (name := solveByElimSyntax) - "solve_by_elim" "*"? (config)? (&" only")? (args)? (using_)? : tactic - -/-- Wrapper for `solveByElim` that processes a list of `Term`s -that specify the lemmas to use. -/ -def solveByElim.processSyntax (cfg : Config := {}) (only star : Bool) (add remove : List Term) - (use : Array Ident) (goals : List MVarId) : MetaM (List MVarId) := do - if !remove.isEmpty && goals.length > 1 then - throwError "Removing local hypotheses is not supported when operating on multiple goals." - let ⟨lemmas, ctx⟩ ← mkAssumptionSet only star add remove use - solveByElim cfg lemmas ctx goals - -elab_rules : tactic | - `(tactic| solve_by_elim $[*%$s]? $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do - let (star, add, remove) := parseArgs t - let use := parseUsing use - let goals ← if s.isSome then - getGoals - else - pure [← getMainGoal] - let cfg ← elabConfig (mkOptionalNode cfg) - let [] ← solveByElim.processSyntax cfg o.isSome star add remove use goals | - throwError "solve_by_elim unexpectedly returned subgoals" - pure () - -/-- -`apply_assumption` looks for an assumption of the form `... → ∀ _, ... → head` -where `head` matches the current goal. - -You can specify additional rules to apply using `apply_assumption [...]`. -By default `apply_assumption` will also try `rfl`, `trivial`, `congrFun`, and `congrArg`. -If you don't want these, or don't want to use all hypotheses, use `apply_assumption only [...]`. -You can use `apply_assumption [-h]` to omit a local hypothesis. -You can use `apply_assumption using [a₁, ...]` to use all lemmas which have been labelled -with the attributes `aᵢ` (these attributes must be created using `register_label_attr`). - -`apply_assumption` will use consequences of local hypotheses obtained via `symm`. - -If `apply_assumption` fails, it will call `exfalso` and try again. -Thus if there is an assumption of the form `P → ¬ Q`, the new tactic state -will have two goals, `P` and `Q`. - -You can pass a further configuration via the syntax `apply_rules (config := {...}) lemmas`. -The options supported are the same as for `solve_by_elim` (and include all the options for `apply`). --/ -syntax (name := applyAssumptionSyntax) - "apply_assumption" (config)? (&" only")? (args)? (using_)? : tactic - -elab_rules : tactic | - `(tactic| apply_assumption $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do - let (star, add, remove) := parseArgs t - let use := parseUsing use - let cfg ← elabConfig (mkOptionalNode cfg) - let cfg := { cfg with - backtracking := false - maxDepth := 1 } - replaceMainGoal (← solveByElim.processSyntax cfg o.isSome star add remove use [← getMainGoal]) - -/-- -`apply_rules [l₁, l₂, ...]` tries to solve the main goal by iteratively -applying the list of lemmas `[l₁, l₂, ...]` or by applying a local hypothesis. -If `apply` generates new goals, `apply_rules` iteratively tries to solve those goals. -You can use `apply_rules [-h]` to omit a local hypothesis. - -`apply_rules` will also use `rfl`, `trivial`, `congrFun` and `congrArg`. -These can be disabled, as can local hypotheses, by using `apply_rules only [...]`. - -You can use `apply_rules using [a₁, ...]` to use all lemmas which have been labelled -with the attributes `aᵢ` (these attributes must be created using `register_label_attr`). - -You can pass a further configuration via the syntax `apply_rules (config := {...})`. -The options supported are the same as for `solve_by_elim` (and include all the options for `apply`). - -`apply_rules` will try calling `symm` on hypotheses and `exfalso` on the goal as needed. -This can be disabled with `apply_rules (config := {symm := false, exfalso := false})`. - -You can bound the iteration depth using the syntax `apply_rules (config := {maxDepth := n})`. - -Unlike `solve_by_elim`, `apply_rules` does not perform backtracking, and greedily applies -a lemma from the list until it gets stuck. --/ -syntax (name := applyRulesSyntax) "apply_rules" (config)? (&" only")? (args)? (using_)? : tactic - --- See also `Lean.MVarId.applyRules` for a `MetaM` level analogue of this tactic. -elab_rules : tactic | - `(tactic| apply_rules $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do - let (star, add, remove) := parseArgs t - let use := parseUsing use - let cfg ← elabApplyRulesConfig (mkOptionalNode cfg) - let cfg := { cfg with backtracking := false } - liftMetaTactic fun g => solveByElim.processSyntax cfg o.isSome star add remove use [g] diff --git a/Std/Tactic/SolveByElim/Backtrack.lean b/Std/Tactic/SolveByElim/Backtrack.lean deleted file mode 100644 index 93b03ed4e8..0000000000 --- a/Std/Tactic/SolveByElim/Backtrack.lean +++ /dev/null @@ -1,205 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Data.List.Basic -import Std.Lean.Except -import Std.Lean.Meta.Basic -import Std.Lean.Meta.Iterator - -/-! -# `backtrack` - -A meta-tactic for running backtracking search, given a non-deterministic tactic -`alternatives : MVarId → Nondet MetaM (List MVarId)`. - -`backtrack alternatives goals` will recursively try to solve all goals in `goals`, -and the subgoals generated, backtracking as necessary. - -In its default behaviour, it will either solve all goals, or fail. -A customisable `suspend` hook in `BacktrackConfig` allows suspend a goal (or subgoal), -so that it will be returned instead of processed further. -Other hooks `proc` and `discharge` (described in `BacktrackConfig`) allow running other -tactics before `alternatives`, or if all search branches from a given goal fail. - -Currently only `solveByElim` is implemented in terms of `backtrack`. --/ - -namespace Std.Tactic - -open Lean Meta - -/-- -Configuration structure to control the behaviour of `backtrack`: -* control the maximum depth and behaviour (fail or return subgoals) at the maximum depth, -* and hooks allowing - * modifying intermediate goals before running the external tactic, - * 'suspending' goals, returning them in the result, and - * discharging subgoals if the external tactic fails. --/ -structure BacktrackConfig where - /-- Maximum recursion depth. -/ - maxDepth : Nat := 6 - /-- An arbitrary procedure which can be used to modify the list of goals - before each attempt to generate alternatives. - Called as `proc goals curr`, where `goals` are the original goals for `backtracking`, - and `curr` are the current goals. - Returning `some l` will replace the current goals with `l` and recurse - (consuming one step of maximum depth). - Returning `none` will proceed to generating alternative without changing goals. - Failure will cause backtracking. - (defaults to `none`) -/ - proc : List MVarId → List MVarId → MetaM (Option (List MVarId)) := fun _ _ => pure none - /-- If `suspend g`, then we do not consider alternatives for `g`, - but return `g` as a new subgoal. (defaults to `false`) -/ - suspend : MVarId → MetaM Bool := fun _ => pure false - /-- `discharge g` is called on goals for which there were no alternatives. - If `none` we return `g` as a new subgoal. - If `some l`, we replace `g` by `l` in the list of active goals, and recurse. - If failure, we backtrack. (defaults to failure) -/ - discharge : MVarId → MetaM (Option (List MVarId)) := fun _ => failure - /-- - If we solve any "independent" goals, don't fail. - See `Lean.MVarId.independent?` for the definition of independence. - -/ - commitIndependentGoals : Bool := false - -namespace Backtrack - -/-- -Pretty print a list of goals. --/ -private def ppMVarId (g : MVarId) : MetaM Format := ppExpr =<< g.getType - -/-- -Pretty print a list of goals. --/ -private def ppMVarIds (gs : List MVarId) : MetaM (List Format) := gs.mapM ppMVarId - -/-- Run a monadic function on every element of a list, -returning the list of elements on which the function fails, and the list of successful results. -/ -def tryAllM [Monad m] [Alternative m] (L : List α) (f : α → m β) : m (List α × List β) := do - let R ← L.mapM (fun a => (Sum.inr <$> f a) <|> (pure (Sum.inl a))) - return (R.filterMap (fun s => match s with | .inl a => a | _ => none), - R.filterMap (fun s => match s with | .inr b => b | _ => none)) - -variable (cfg : BacktrackConfig) -variable (trace : Name := .anonymous) -variable (next : MVarId → (List MVarId -> MetaM (Option (List MVarId))) -> MetaM (List MVarId)) - -/-- -* `n : Nat` steps remaining. -* `curr : List MVarId` the current list of unsolved goals. -* `acc : List MVarId` a list of "suspended" goals, which will be returned as subgoals. --/ - -- `acc` is intentionally a `List` rather than an `Array` so we can share across branches. -private def run (goals : List MVarId) (n : Nat) (curr acc : List MVarId) : MetaM (List MVarId) := do - match n with - | 0 => do - -- We're out of fuel. - throwError "backtrack exceeded the recursion limit" - | n + 1 => do - -- First, run `cfg.proc`, to see if it wants to modify the goals. - let procResult? ← try - cfg.proc goals curr - catch e => - withTraceNode trace - (return m!"{Except.emoji ·} BacktrackConfig.proc failed: {e.toMessageData}") do - throw e - match procResult? with - | some curr' => run goals n curr' acc - | none => - match curr with - -- If there are no active goals, return the accumulated goals. - | [] => withTraceNode trace (return m!"{Except.emoji ·} success!") do - return acc.reverse - | g :: gs => - -- Discard any goals which have already been assigned. - if ← g.isAssigned then - withTraceNode trace (return m!"{Except.emoji ·} discarding already assigned goal {g}") do - run goals (n+1) gs acc - else - withTraceNode trace - -- Note: the `addMessageContextFull` ensures we show the goal using the mvar context before - -- the `do` block below runs, potentially unifying mvars in the goal. - (return m!"{Except.emoji ·} working on: {← addMessageContextFull g}") - do - -- Check if we should suspend the search here: - if (← cfg.suspend g) then - withTraceNode trace - (fun _ => return m!"⏸️ suspending search and returning as subgoal") do - run goals (n+1) gs (g :: acc) - else - try - -- We attempt to find an alternative, - -- for which all resulting sub-goals can be discharged using `run n`. - next g (fun r => observing? do run goals n (r ++ gs) acc) - catch _ => - -- No lemmas could be applied: - match (← cfg.discharge g) with - | none => (withTraceNode trace - (fun _ => return m!"⏭️ deemed acceptable, returning as subgoal") do - run goals (n+1) gs (g :: acc)) - | some l => (withTraceNode trace - (fun _ => return m!"⏬ discharger generated new subgoals") do - run goals n (l ++ gs) acc) - -/-- -A wrapper around `run`, which works on "independent" goals separately first, -to reduce backtracking. --/ -private partial def processIndependentGoals (orig : List MVarId) (goals remaining : List MVarId) : - MetaM (List MVarId) := do - -- Partition the remaining goals into "independent" goals - -- (which should be solvable without affecting the solvability of other goals) - -- and all the others. - let (igs, ogs) ← remaining.partitionM (MVarId.isIndependentOf goals) - if igs.isEmpty then - -- If there are no independent goals, we solve all the goals together via backtracking search. - return (← run cfg trace next orig cfg.maxDepth remaining []) - else - withTraceNode trace - (fun _ => return m!"independent goals {← ppMVarIds igs}," - ++ m!" working on them before {← ppMVarIds ogs}") do - -- Invoke `run` on each of the independent goals separately, - -- gathering the subgoals on which `run` fails, - -- and the new subgoals generated from goals on which it is successful. - let (failed, newSubgoals') ← tryAllM igs fun g => - run cfg trace next orig cfg.maxDepth [g] [] - let newSubgoals := newSubgoals'.join - withTraceNode trace - (fun _ => return m!"failed: {← ppMVarIds failed}, new: {← ppMVarIds newSubgoals}") do - -- Update the list of goals with respect to which we need to check independence. - let goals' := (← goals.filterM (fun g => do pure !(← g.isAssigned))) ++ newSubgoals - -- If `commitIndependentGoals` is `true`, we will return the new goals - -- regardless of whether we can make further progress on the other goals. - if cfg.commitIndependentGoals && !newSubgoals.isEmpty then - return newSubgoals ++ failed ++ (← (processIndependentGoals orig goals' ogs <|> pure ogs)) - else if !failed.isEmpty then - -- If `commitIndependentGoals` is `false`, and we failed on any of the independent goals, - -- then overall failure is inevitable so we can stop here. - failure - else - -- Finally, having solved this batch of independent goals, - -- recurse (potentially now finding new independent goals). - return newSubgoals ++ (← processIndependentGoals orig goals' ogs) - -end Backtrack - - -/-- -Attempts to solve the `goals`, by recursively calling `next` on each -subgoal that appears with a callback to reenter backtracking search. - -Further flow control options are available via the `Config` argument. - -Returns a list of subgoals which were "suspended" via the `suspend` or -`discharge` hooks in `Config`. In the default configuration, `backtrack` -will either return an empty list or fail. --/ -def backtrack (cfg : BacktrackConfig := {}) (trace : Name := .anonymous) - (next : MVarId → MetaM (Meta.Iterator (List MVarId))) - (goals : List MVarId) : MetaM (List MVarId) := do - let resolve g f := do (←next g).firstM f - Backtrack.processIndependentGoals cfg trace resolve goals goals goals diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 49b8853680..820618d84a 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -3,9 +3,7 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Lean.Elab.Tactic.Simp -import Lean.Meta.Tactic.TryThis -import Std.Tactic.SimpTrace +import Lean.Elab.Tactic.SimpTrace /-! # `squeeze_scope` tactic diff --git a/Std/Test/Internal/DummyLabelAttr.lean b/Std/Test/Internal/DummyLabelAttr.lean index 2104976c00..9b746b6bd7 100644 --- a/Std/Test/Internal/DummyLabelAttr.lean +++ b/Std/Test/Internal/DummyLabelAttr.lean @@ -3,7 +3,7 @@ Copyright (c) 2023 Lean FRO, LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Std.Tactic.LabelAttr +import Lean.LabelAttribute /-- A dummy label attribute, which can be used for testing. -/ -- This can't live in `Std.Tactic.LabelAttr` diff --git a/test/solve_by_elim.lean b/test/solve_by_elim.lean index 545218077c..05becc76bb 100644 --- a/test/solve_by_elim.lean +++ b/test/solve_by_elim.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Std.Tactic.SolveByElim import Std.Tactic.PermuteGoals import Std.Test.Internal.DummyLabelAttr diff --git a/test/symm.lean b/test/symm.lean index 653630d209..33f2146617 100644 --- a/test/symm.lean +++ b/test/symm.lean @@ -1,4 +1,4 @@ -import Std.Tactic.Relation.Symm +import Init.Tactics set_option autoImplicit true set_option linter.missingDocs false From 292f8f2fa6bb2de7588b0dad080b377e2080317d Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 22 Feb 2024 13:13:14 +1100 Subject: [PATCH 077/213] . --- Std.lean | 3 -- Std/Lean/Meta/Iterator.lean | 69 ----------------------------------- Std/Lean/Parser.lean | 16 -------- Std/Tactic/LibrarySearch.lean | 1 - 4 files changed, 89 deletions(-) delete mode 100644 Std/Lean/Meta/Iterator.lean delete mode 100644 Std/Lean/Parser.lean diff --git a/Std.lean b/Std.lean index b0dbf9bbf9..fcc2360a34 100644 --- a/Std.lean +++ b/Std.lean @@ -53,7 +53,6 @@ import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.Expr import Std.Lean.Meta.Inaccessible import Std.Lean.Meta.InstantiateMVars -import Std.Lean.Meta.Iterator import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Meta.SavedState import Std.Lean.Meta.Simp @@ -62,7 +61,6 @@ import Std.Lean.MonadBacktrack import Std.Lean.Name import Std.Lean.NameMap import Std.Lean.NameMapAttribute -import Std.Lean.Parser import Std.Lean.PersistentHashMap import Std.Lean.PersistentHashSet import Std.Lean.Position @@ -105,7 +103,6 @@ import Std.Tactic.ShowTerm import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable import Std.Tactic.Where -import Std.Test.Internal.DummyLabelAttr import Std.Util.Cache import Std.Util.CheckTactic import Std.Util.ExtendedBinder diff --git a/Std/Lean/Meta/Iterator.lean b/Std/Lean/Meta/Iterator.lean deleted file mode 100644 index cbfa5aac08..0000000000 --- a/Std/Lean/Meta/Iterator.lean +++ /dev/null @@ -1,69 +0,0 @@ -import Lean.Meta.Basic - -namespace Lean.Meta - -/-- -Provides an iterface for iterating over values that are bundled with the `Meta` state -they are valid in. --/ -protected structure Iterator (α : Type) where - /-- Function for getting next value and state pair. -/ - next : MetaM (Option (α × Meta.SavedState)) - -namespace Iterator - -/-- -Convert a list into an iterator with the current state. --/ -def ofList (l : List α) : MetaM (Meta.Iterator α) := do - let s ← saveState - let ref ← IO.mkRef l - let next := do - restoreState s - match ← ref.get with - | [] => - pure none - | r :: l => - ref.set l - pure <| some (r, ←saveState) - pure { next } - -/-- -Map and filter results of iterator and returning only those values returned -by `f`. --/ -partial def filterMapM (f : α → MetaM (Option β)) (L : Meta.Iterator α) : Meta.Iterator β := - { next := _next } - where _next := do - match ← L.next with - | none => - pure none - | some (v, s) => - restoreState s - let r ← f v - match r with - | none => - _next - | some r => - pure <| some (r, ←saveState) - -/-- -Find the first value in the iterator while resetting state or call `failure` -if empty. --/ -def head (L : Meta.Iterator α) : MetaM α := do - match ← L.next with - | none => - failure - | some (x, s) => - restoreState s - pure x - -/-- -Return the first value returned by the iterator that `f` succeeds on. --/ -def firstM (L : Meta.Iterator α) (f : α → MetaM (Option β)) : MetaM β := L.filterMapM f |>.head - -end Iterator - -end Lean.Meta diff --git a/Std/Lean/Parser.lean b/Std/Lean/Parser.lean deleted file mode 100644 index c93657a739..0000000000 --- a/Std/Lean/Parser.lean +++ /dev/null @@ -1,16 +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 --/ - -namespace Lean.Parser.Tactic -/-- Extract the arguments from a `simpArgs` syntax as an array of syntaxes -/ -def getSimpArgs? : Syntax → Option (Array Syntax) - | `(simpArgs| [$args,*]) => pure args.getElems - | _ => none - -/-- Extract the arguments from a `dsimpArgs` syntax as an array of syntaxes -/ -def getDSimpArgs? : Syntax → Option (Array Syntax) - | `(dsimpArgs| [$args,*]) => pure args.getElems - | _ => none diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean index 8ed339f932..ff33412e0b 100644 --- a/Std/Tactic/LibrarySearch.lean +++ b/Std/Tactic/LibrarySearch.lean @@ -8,7 +8,6 @@ import Std.Lean.CoreM import Std.Lean.Expr import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.LazyDiscrTree -import Std.Lean.Parser import Lean.Elab.Tactic.SolveByElim import Std.Util.Pickle From b997f3fdd8442d17a1a8cc2e6ddcd8dcb03ce3bb Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 22 Feb 2024 13:32:31 +1100 Subject: [PATCH 078/213] . --- Std.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Std.lean b/Std.lean index fcc2360a34..38ac463ceb 100644 --- a/Std.lean +++ b/Std.lean @@ -103,6 +103,7 @@ import Std.Tactic.ShowTerm import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable import Std.Tactic.Where +import Std.Test.Internal.DummyLabelAttr import Std.Util.Cache import Std.Util.CheckTactic import Std.Util.ExtendedBinder From cad2a505a441ee6e0613754740ebce49e201feae Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 22 Feb 2024 13:41:40 +1100 Subject: [PATCH 079/213] fixes --- test/isIndependentOf.lean | 1 + test/omega/benchmark.lean | 2 -- test/register_label_attr.lean | 3 ++- test/solve_by_elim.lean | 3 +++ 4 files changed, 6 insertions(+), 3 deletions(-) diff --git a/test/isIndependentOf.lean b/test/isIndependentOf.lean index 59e9363ad7..7d0bff1c89 100644 --- a/test/isIndependentOf.lean +++ b/test/isIndependentOf.lean @@ -1,6 +1,7 @@ import Std.Lean.Meta.Basic import Std.Tactic.PermuteGoals import Std.Tactic.GuardMsgs +import Lean.Meta.Tactic.IndependentOf open Lean Meta Elab.Tactic diff --git a/test/omega/benchmark.lean b/test/omega/benchmark.lean index 78a1a6fdc8..8df5b77417 100644 --- a/test/omega/benchmark.lean +++ b/test/omega/benchmark.lean @@ -57,8 +57,6 @@ Benchmark 1: lake env lean test/omega/benchmark.lean -/ -open Std.Tactic.Omega - example : True := by fail_if_success omega trivial diff --git a/test/register_label_attr.lean b/test/register_label_attr.lean index 2322284938..9b0e66c846 100644 --- a/test/register_label_attr.lean +++ b/test/register_label_attr.lean @@ -1,9 +1,10 @@ import Std.Test.Internal.DummyLabelAttr import Std.Tactic.GuardMsgs +import Lean.LabelAttribute set_option linter.missingDocs false -open Std.Tactic.LabelAttr +open Lean def f := 0 diff --git a/test/solve_by_elim.lean b/test/solve_by_elim.lean index 05becc76bb..fbe6abba90 100644 --- a/test/solve_by_elim.lean +++ b/test/solve_by_elim.lean @@ -5,6 +5,9 @@ Authors: Scott Morrison -/ import Std.Tactic.PermuteGoals import Std.Test.Internal.DummyLabelAttr +import Lean.Meta.Tactic.Constructor +import Lean.Elab.SyntheticMVars +import Lean.Elab.Tactic.SolveByElim -- FIXME we need to make SolveByElimConfig builtin set_option autoImplicit true From f1f0b58274774ff501d612ac63997b18e4f1d6b2 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Thu, 22 Feb 2024 09:15:41 +0000 Subject: [PATCH 080/213] chore: bump to nightly-2024-02-22 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 423cb48009..63d320d43a 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-21 +leanprover/lean4:nightly-2024-02-22 From a178ab58c07c37d919079ac3a5e4514fd85b791b Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 22 Feb 2024 20:52:43 +1100 Subject: [PATCH 081/213] fix --- Std/Data/List/Lemmas.lean | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 25c2922bc4..03d1fc1788 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -793,11 +793,6 @@ theorem get_of_eq {l l' : List α} (h : l = l') (i : Fin l.length) : theorem get_zero : ∀ {l : List α} (h : 0 < l.length), l.get ⟨0, h⟩ = l.head? | _::_, _ => rfl -theorem get?_append_right : ∀ {l₁ l₂ : List α} {n : Nat}, l₁.length ≤ n → - (l₁ ++ l₂).get? n = l₂.get? (n - l₁.length) -| [], _, n, _ => rfl -| a :: l, _, n+1, h₁ => by rw [cons_append]; simp [get?_append_right (Nat.lt_succ.1 h₁)] - theorem get_append_right_aux {l₁ l₂ : List α} {n : Nat} (h₁ : l₁.length ≤ n) (h₂ : n < (l₁ ++ l₂).length) : n - l₁.length < l₂.length := by rw [length_append] at h₂ @@ -841,30 +836,10 @@ theorem ext_get {l₁ l₂ : List α} (hl : length l₁ = length l₂) have h₁ := Nat.le_of_not_lt h₁ rw [get?_len_le h₁, get?_len_le]; rwa [← hl] -theorem get?_reverse' : ∀ {l : List α} (i j), i + j + 1 = length l → - get? l.reverse i = get? l j - | [], _, _, _ => rfl - | a::l, i, 0, h => by simp at h; simp [h, get?_append_right] - | a::l, i, j+1, h => by - have := Nat.succ.inj h; simp at this ⊢ - rw [get?_append, get?_reverse' _ j this] - rw [length_reverse, ← this]; apply Nat.lt_add_of_pos_right (Nat.succ_pos _) - -theorem get?_reverse {l : List α} (i) (h : i < length l) : - get? l.reverse i = get? l (l.length - 1 - i) := - get?_reverse' _ _ <| by - rw [Nat.add_sub_of_le (Nat.le_sub_one_of_lt h), - Nat.sub_add_cancel (Nat.lt_of_le_of_lt (Nat.zero_le _) h)] - theorem get!_of_get? [Inhabited α] : ∀ {l : List α} {n}, get? l n = some a → get! l n = a | _a::_, 0, rfl => rfl | _::l, _+1, e => get!_of_get? (l := l) e -theorem getD_eq_get? : ∀ l n (a : α), getD l n a = (get? l n).getD a - | [], _, _ => rfl - | _a::_, 0, _ => rfl - | _::l, _+1, _ => getD_eq_get? (l := l) .. - @[simp] theorem get!_eq_getD [Inhabited α] : ∀ (l : List α) n, l.get! n = l.getD n default | [], _ => rfl | _a::_, 0 => rfl From 327fee2d07ea74b453d3269b40d49462753d90f4 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 23 Feb 2024 09:14:18 +0000 Subject: [PATCH 082/213] chore: bump to nightly-2024-02-23 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 63d320d43a..a9ea4c3843 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-22 +leanprover/lean4:nightly-2024-02-23 From d7451c6312166406e5d95f1c0d823f75d51e0c40 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 24 Feb 2024 08:59:21 +1100 Subject: [PATCH 083/213] chore: adaptations for nightly-2024-02-19 (#666) --- Std.lean | 16 - Std/Classes/Cast.lean | 40 -- Std/Classes/Order.lean | 13 - Std/Control/Lemmas.lean | 1 - Std/Data/Array/Basic.lean | 1 - Std/Data/Array/Init/Lemmas.lean | 1 - Std/Data/Array/Merge.lean | 1 - Std/Data/BinomialHeap/Basic.lean | 2 +- Std/Data/BitVec/Basic.lean | 2 - Std/Data/BitVec/Folds.lean | 1 - Std/Data/BitVec/Lemmas.lean | 3 - Std/Data/Bool.lean | 215 ------ Std/Data/ByteArray.lean | 1 - Std/Data/Char.lean | 1 - Std/Data/Fin.lean | 1 - Std/Data/Fin/Basic.lean | 39 - Std/Data/Fin/Iterate.lean | 93 --- Std/Data/Fin/Lemmas.lean | 3 - Std/Data/HashMap/Basic.lean | 2 +- Std/Data/HashMap/WF.lean | 15 +- Std/Data/Int.lean | 4 - Std/Data/Int/Basic.lean | 173 ----- Std/Data/Int/DivMod.lean | 7 - Std/Data/Int/Init/DivMod.lean | 340 --------- Std/Data/Int/Init/Lemmas.lean | 506 ------------- Std/Data/Int/Init/Order.lean | 434 ----------- Std/Data/Int/Lemmas.lean | 1 - Std/Data/Int/Order.lean | 4 - Std/Data/List.lean | 1 - Std/Data/List/Basic.lean | 37 +- Std/Data/List/Count.lean | 1 - Std/Data/List/Init/Attach.lean | 1 - Std/Data/List/Init/Lemmas.lean | 27 - Std/Data/List/Lemmas.lean | 1 - Std/Data/Nat/Bitwise.lean | 6 +- Std/Data/Nat/Lemmas.lean | 1000 -------------------------- Std/Data/Option.lean | 2 - Std/Data/Option/Basic.lean | 187 ----- Std/Data/Option/Init/Lemmas.lean | 23 - Std/Data/Option/Lemmas.lean | 231 +----- Std/Data/Ord.lean | 134 ---- Std/Data/PairingHeap.lean | 2 +- Std/Data/RBMap/Alter.lean | 2 +- Std/Data/Range/Lemmas.lean | 4 +- Std/Data/Rat/Basic.lean | 3 +- Std/Data/Rat/Lemmas.lean | 2 +- Std/Data/String/Lemmas.lean | 1 - Std/Data/Sum/Lemmas.lean | 1 - Std/Data/UInt.lean | 1 - Std/Lean/Elab/Tactic.lean | 18 - Std/Lean/Expr.lean | 33 - Std/Lean/HashSet.lean | 8 - Std/Lean/Meta/Basic.lean | 11 - Std/Lean/Meta/DiscrTree.lean | 1 - Std/Lean/Position.lean | 2 + Std/Tactic/Congr.lean | 2 +- Std/Tactic/Ext.lean | 234 ------ Std/Tactic/Ext/Attr.lean | 109 --- Std/Tactic/FalseOrByContra.lean | 10 +- Std/Tactic/GuardMsgs.lean | 4 +- Std/Tactic/LibrarySearch.lean | 1 - Std/Tactic/NormCast.lean | 18 + Std/Tactic/Omega.lean | 192 ----- Std/Tactic/Omega/Coeffs/IntList.lean | 108 --- Std/Tactic/Omega/Config.lean | 44 -- Std/Tactic/Omega/Constraint.lean | 253 ------- Std/Tactic/Omega/Core.lean | 691 ------------------ Std/Tactic/Omega/Frontend.lean | 570 --------------- Std/Tactic/Omega/Int.lean | 155 ---- Std/Tactic/Omega/IntList.lean | 408 ----------- Std/Tactic/Omega/LinearCombo.lean | 183 ----- Std/Tactic/Omega/Logic.lean | 31 - Std/Tactic/Omega/MinNatAbs.lean | 135 ---- Std/Tactic/Omega/OmegaM.lean | 218 ------ Std/Tactic/Relation/Rfl.lean | 2 +- lean-toolchain | 2 +- test/congr.lean | 2 +- test/ext.lean | 2 - test/int.lean | 1 - test/omega/benchmark.lean | 3 - test/omega/examples.lean | 1 - test/omega/test.lean | 3 - 82 files changed, 63 insertions(+), 6979 deletions(-) delete mode 100644 Std/Data/Fin/Iterate.lean delete mode 100644 Std/Data/Int/Basic.lean delete mode 100644 Std/Data/Int/Init/DivMod.lean delete mode 100644 Std/Data/Int/Init/Lemmas.lean delete mode 100644 Std/Data/Int/Init/Order.lean delete mode 100644 Std/Data/List/Init/Lemmas.lean delete mode 100644 Std/Data/Option/Basic.lean delete mode 100644 Std/Data/Option/Init/Lemmas.lean delete mode 100644 Std/Data/Ord.lean delete mode 100644 Std/Lean/Elab/Tactic.lean delete mode 100644 Std/Tactic/Ext.lean delete mode 100644 Std/Tactic/Ext/Attr.lean delete mode 100644 Std/Tactic/Omega.lean delete mode 100644 Std/Tactic/Omega/Coeffs/IntList.lean delete mode 100644 Std/Tactic/Omega/Config.lean delete mode 100644 Std/Tactic/Omega/Constraint.lean delete mode 100644 Std/Tactic/Omega/Core.lean delete mode 100644 Std/Tactic/Omega/Frontend.lean delete mode 100644 Std/Tactic/Omega/Int.lean delete mode 100644 Std/Tactic/Omega/IntList.lean delete mode 100644 Std/Tactic/Omega/LinearCombo.lean delete mode 100644 Std/Tactic/Omega/Logic.lean delete mode 100644 Std/Tactic/Omega/MinNatAbs.lean delete mode 100644 Std/Tactic/Omega/OmegaM.lean diff --git a/Std.lean b/Std.lean index 89bcb00f8f..1b2cb1e4d1 100644 --- a/Std.lean +++ b/Std.lean @@ -30,7 +30,6 @@ import Std.Data.List import Std.Data.MLList import Std.Data.Nat import Std.Data.Option -import Std.Data.Ord import Std.Data.PairingHeap import Std.Data.RBMap import Std.Data.Range @@ -41,7 +40,6 @@ import Std.Data.UInt import Std.Lean.AttributeExtra import Std.Lean.CoreM import Std.Lean.Delaborator -import Std.Lean.Elab.Tactic import Std.Lean.Except import Std.Lean.Expr import Std.Lean.Float @@ -85,8 +83,6 @@ import Std.Tactic.Case import Std.Tactic.Classical import Std.Tactic.Congr import Std.Tactic.Exact -import Std.Tactic.Ext -import Std.Tactic.Ext.Attr import Std.Tactic.FalseOrByContra import Std.Tactic.GuardMsgs import Std.Tactic.Init @@ -103,18 +99,6 @@ import Std.Tactic.NoMatch import Std.Tactic.NormCast import Std.Tactic.NormCast.Ext import Std.Tactic.NormCast.Lemmas -import Std.Tactic.Omega -import Std.Tactic.Omega.Coeffs.IntList -import Std.Tactic.Omega.Config -import Std.Tactic.Omega.Constraint -import Std.Tactic.Omega.Core -import Std.Tactic.Omega.Frontend -import Std.Tactic.Omega.Int -import Std.Tactic.Omega.IntList -import Std.Tactic.Omega.LinearCombo -import Std.Tactic.Omega.Logic -import Std.Tactic.Omega.MinNatAbs -import Std.Tactic.Omega.OmegaM import Std.Tactic.OpenPrivate import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents diff --git a/Std/Classes/Cast.lean b/Std/Classes/Cast.lean index 9adeb6ebe0..9030568e99 100644 --- a/Std/Classes/Cast.lean +++ b/Std/Classes/Cast.lean @@ -5,46 +5,6 @@ Authors: Mario Carneiro, Gabriel Ebner -/ import Std.Util.LibraryNote -/-- Type class for the canonical homomorphism `Nat → R`. -/ -class NatCast (R : Type u) where - /-- The canonical map `Nat → R`. -/ - protected natCast : Nat → R - -instance : NatCast Nat where natCast n := n -instance : NatCast Int where natCast n := Int.ofNat n - -/-- Canonical homomorphism from `Nat` to a additive monoid `R` with a `1`. -This is just the bare function in order to aid in creating instances of `AddMonoidWithOne`. -/ -@[coe, reducible, match_pattern] protected def Nat.cast {R : Type u} [NatCast R] : Nat → R := - NatCast.natCast - --- see note [coercion into rings] -instance [NatCast R] : CoeTail Nat R where coe := Nat.cast - --- see note [coercion into rings] -instance [NatCast R] : CoeHTCT Nat R where coe := Nat.cast - -/-- This instance is needed to ensure that `instCoeNatInt` from core is not used. -/ -instance : Coe Nat Int where coe := Nat.cast - -/-- Type class for the canonical homomorphism `Int → R`. -/ -class IntCast (R : Type u) where - /-- The canonical map `Int → R`. -/ - protected intCast : Int → R - -instance : IntCast Int where intCast n := n - -/-- Canonical homomorphism from `Int` to a additive group `R` with a `1`. -This is just the bare function in order to aid in creating instances of `AddGroupWithOne`. -/ -@[coe, reducible, match_pattern] protected def Int.cast {R : Type u} [IntCast R] : Int → R := - IntCast.intCast - --- see note [coercion into rings] -instance [IntCast R] : CoeTail Int R where coe := Int.cast - --- see note [coercion into rings] -instance [IntCast R] : CoeHTCT Int R where coe := Int.cast - library_note "coercion into rings" /-- Coercions such as `Nat.castCoe` that go from a concrete structure such as diff --git a/Std/Classes/Order.lean b/Std/Classes/Order.lean index c5f70db253..f92e96c0dd 100644 --- a/Std/Classes/Order.lean +++ b/Std/Classes/Order.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Data.Ord import Std.Tactic.Simpa /-! ## Ordering -/ @@ -109,15 +108,3 @@ instance (f : α → β) (cmp : β → β → Ordering) [TransCmp cmp] : TransCm le_trans h₁ h₂ := TransCmp.le_trans (α := β) h₁ h₂ end Ordering - -@[simp] theorem ge_iff_le [LE α] {x y : α} : x ≥ y ↔ y ≤ x := Iff.rfl - -@[simp] theorem gt_iff_lt [LT α] {x y : α} : x > y ↔ y < x := Iff.rfl - -theorem le_of_eq_of_le {a b c : α} [LE α] (h₁ : a = b) (h₂ : b ≤ c) : a ≤ c := by subst h₁; exact h₂ - -theorem le_of_le_of_eq {a b c : α} [LE α] (h₁ : a ≤ b) (h₂ : b = c) : a ≤ c := by subst h₂; exact h₁ - -theorem lt_of_eq_of_lt {a b c : α} [LT α] (h₁ : a = b) (h₂ : b < c) : a < c := by subst h₁; exact h₂ - -theorem lt_of_lt_of_eq {a b c : α} [LT α] (h₁ : a < b) (h₂ : b = c) : a < c := by subst h₂; exact h₁ diff --git a/Std/Control/Lemmas.lean b/Std/Control/Lemmas.lean index 1a5e388bce..a874ac2473 100644 --- a/Std/Control/Lemmas.lean +++ b/Std/Control/Lemmas.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 François G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ -import Std.Tactic.Ext namespace ReaderT diff --git a/Std/Data/Array/Basic.lean b/Std/Data/Array/Basic.lean index c52d77d949..c000df3524 100644 --- a/Std/Data/Array/Basic.lean +++ b/Std/Data/Array/Basic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Floris van Doorn, Jannis Limperg -/ import Std.Data.List.Init.Attach -import Std.Data.Ord /-! ## Definitions on Arrays diff --git a/Std/Data/Array/Init/Lemmas.lean b/Std/Data/Array/Init/Lemmas.lean index 4fc2cbd60c..8d0ed724e4 100644 --- a/Std/Data/Array/Init/Lemmas.lean +++ b/Std/Data/Array/Init/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Bool -import Std.Data.List.Init.Lemmas import Std.Classes.SatisfiesM /-! diff --git a/Std/Data/Array/Merge.lean b/Std/Data/Array/Merge.lean index fc7727be02..35c5f4b4b0 100644 --- a/Std/Data/Array/Merge.lean +++ b/Std/Data/Array/Merge.lean @@ -5,7 +5,6 @@ Authors: Jannis Limperg -/ import Std.Data.Nat.Lemmas -import Std.Data.Ord namespace Array diff --git a/Std/Data/BinomialHeap/Basic.lean b/Std/Data/BinomialHeap/Basic.lean index 8f2ed693bb..1756167cf8 100644 --- a/Std/Data/BinomialHeap/Basic.lean +++ b/Std/Data/BinomialHeap/Basic.lean @@ -267,7 +267,7 @@ theorem Heap.realSize_tail (le) (s : Heap α) : (s.tail le).realSize = s.realSiz simp only [Heap.tail] match eq : s.tail? le with | none => cases s with cases eq | nil => rfl - | some tl => simp [Heap.realSize_tail? eq]; rfl + | some tl => simp [Heap.realSize_tail? eq] /-- `O(n log n)`. Monadic fold over the elements of a heap in increasing order, diff --git a/Std/Data/BitVec/Basic.lean b/Std/Data/BitVec/Basic.lean index f048c5819a..6c8d2f2944 100644 --- a/Std/Data/BitVec/Basic.lean +++ b/Std/Data/BitVec/Basic.lean @@ -4,8 +4,6 @@ institutional affiliations. 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 -/ -import Std.Data.Fin.Basic -import Std.Data.Int.Basic import Std.Data.Nat.Bitwise import Std.Tactic.Alias diff --git a/Std/Data/BitVec/Folds.lean b/Std/Data/BitVec/Folds.lean index ee9ecd079e..952b930006 100644 --- a/Std/Data/BitVec/Folds.lean +++ b/Std/Data/BitVec/Folds.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joe Hendrix -/ import Std.Data.BitVec.Lemmas -import Std.Data.Fin.Iterate import Std.Data.Nat.Lemmas namespace Std.BitVec diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index e2466ce19c..3a23fa3e04 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -7,10 +7,7 @@ import Std.Data.Bool import Std.Data.BitVec.Basic import Std.Data.Fin.Lemmas import Std.Data.Nat.Lemmas - -import Std.Tactic.Ext import Std.Tactic.Simpa -import Std.Tactic.Omega import Std.Util.ProofWanted namespace Std.BitVec diff --git a/Std/Data/Bool.lean b/Std/Data/Bool.lean index eb463d5d76..cc031a0484 100644 --- a/Std/Data/Bool.lean +++ b/Std/Data/Bool.lean @@ -6,229 +6,14 @@ Authors: F. G. Dorais import Std.Tactic.Alias -/-- Boolean exclusive or -/ -abbrev xor : Bool → Bool → Bool := bne - namespace Bool -/- Namespaced versions that can be used instead of prefixing `_root_` -/ -@[inherit_doc not] protected abbrev not := not -@[inherit_doc or] protected abbrev or := or -@[inherit_doc and] protected abbrev and := and -@[inherit_doc xor] protected abbrev xor := xor - -instance (p : Bool → Prop) [inst : DecidablePred p] : Decidable (∀ x, p x) := - match inst true, inst false with - | isFalse ht, _ => isFalse fun h => absurd (h _) ht - | _, isFalse hf => isFalse fun h => absurd (h _) hf - | isTrue ht, isTrue hf => isTrue fun | true => ht | false => hf - -instance (p : Bool → Prop) [inst : DecidablePred p] : Decidable (∃ x, p x) := - match inst true, inst false with - | isTrue ht, _ => isTrue ⟨_, ht⟩ - | _, isTrue hf => isTrue ⟨_, hf⟩ - | isFalse ht, isFalse hf => isFalse fun | ⟨true, h⟩ => absurd h ht | ⟨false, h⟩ => absurd h hf - -instance : LE Bool := ⟨(. → .)⟩ -instance : LT Bool := ⟨(!. && .)⟩ - -instance (x y : Bool) : Decidable (x ≤ y) := inferInstanceAs (Decidable (x → y)) -instance (x y : Bool) : Decidable (x < y) := inferInstanceAs (Decidable (!x && y)) - -instance : Max Bool := ⟨or⟩ -instance : Min Bool := ⟨and⟩ - -theorem false_ne_true : false ≠ true := Bool.noConfusion - -theorem eq_false_or_eq_true : (b : Bool) → b = true ∨ b = false := by decide - -theorem eq_false_iff : {b : Bool} → b = false ↔ b ≠ true := by decide - -theorem ne_false_iff : {b : Bool} → b ≠ false ↔ b = true := by decide - -theorem eq_iff_iff {a b : Bool} : a = b ↔ (a ↔ b) := by cases b <;> simp - -/-! ### and -/ - -@[simp] theorem not_and_self : ∀ (x : Bool), (!x && x) = false := by decide - -@[simp] theorem and_not_self : ∀ (x : Bool), (x && !x) = false := by decide - -theorem and_comm : ∀ (x y : Bool), (x && y) = (y && x) := by decide - -theorem and_left_comm : ∀ (x y z : Bool), (x && (y && z)) = (y && (x && z)) := by decide - -theorem and_right_comm : ∀ (x y z : Bool), ((x && y) && z) = ((x && z) && y) := by decide - -theorem and_or_distrib_left : ∀ (x y z : Bool), (x && (y || z)) = ((x && y) || (x && z)) := by - decide - -theorem and_or_distrib_right : ∀ (x y z : Bool), ((x || y) && z) = ((x && z) || (y && z)) := by - decide - -theorem and_xor_distrib_left : ∀ (x y z : Bool), (x && xor y z) = xor (x && y) (x && z) := by decide - -theorem and_xor_distrib_right : ∀ (x y z : Bool), (xor x y && z) = xor (x && z) (y && z) := by - decide - -/-- De Morgan's law for boolean and -/ -theorem not_and : ∀ (x y : Bool), (!(x && y)) = (!x || !y) := by decide - -theorem and_eq_true_iff : ∀ (x y : Bool), (x && y) = true ↔ x = true ∧ y = true := by decide - -theorem and_eq_false_iff : ∀ (x y : Bool), (x && y) = false ↔ x = false ∨ y = false := by decide - -/-! ### or -/ - -@[simp] theorem not_or_self : ∀ (x : Bool), (!x || x) = true := by decide - -@[simp] theorem or_not_self : ∀ (x : Bool), (x || !x) = true := by decide - -theorem or_comm : ∀ (x y : Bool), (x || y) = (y || x) := by decide - -theorem or_left_comm : ∀ (x y z : Bool), (x || (y || z)) = (y || (x || z)) := by decide - -theorem or_right_comm : ∀ (x y z : Bool), ((x || y) || z) = ((x || z) || y) := by decide - -theorem or_and_distrib_left : ∀ (x y z : Bool), (x || (y && z)) = ((x || y) && (x || z)) := by - decide - -theorem or_and_distrib_right : ∀ (x y z : Bool), ((x && y) || z) = ((x || z) && (y || z)) := by - decide - -/-- De Morgan's law for boolean or -/ -theorem not_or : ∀ (x y : Bool), (!(x || y)) = (!x && !y) := by decide - -theorem or_eq_true_iff : ∀ (x y : Bool), (x || y) = true ↔ x = true ∨ y = true := by decide - -theorem or_eq_false_iff : ∀ (x y : Bool), (x || y) = false ↔ x = false ∧ y = false := by decide - -/-! ### xor -/ - -@[simp] theorem false_xor : ∀ (x : Bool), xor false x = x := by decide - -@[simp] theorem xor_false : ∀ (x : Bool), xor x false = x := by decide - -@[simp] theorem true_xor : ∀ (x : Bool), xor true x = !x := by decide - -@[simp] theorem xor_true : ∀ (x : Bool), xor x true = !x := by decide - -@[simp] theorem not_xor_self : ∀ (x : Bool), xor (!x) x = true := by decide - -@[simp] theorem xor_not_self : ∀ (x : Bool), xor x (!x) = true := by decide - -theorem not_xor : ∀ (x y : Bool), xor (!x) y = !(xor x y) := by decide - -theorem xor_not : ∀ (x y : Bool), xor x (!y) = !(xor x y) := by decide - -@[simp] theorem not_xor_not : ∀ (x y : Bool), xor (!x) (!y) = (xor x y) := by decide - -theorem xor_self : ∀ (x : Bool), xor x x = false := by decide - -theorem xor_comm : ∀ (x y : Bool), xor x y = xor y x := by decide - -theorem xor_left_comm : ∀ (x y z : Bool), xor x (xor y z) = xor y (xor x z) := by decide - -theorem xor_right_comm : ∀ (x y z : Bool), xor (xor x y) z = xor (xor x z) y := by decide - -theorem xor_assoc : ∀ (x y z : Bool), xor (xor x y) z = xor x (xor y z) := by decide - -@[simp] -theorem xor_left_inj : ∀ (x y z : Bool), xor x y = xor x z ↔ y = z := by decide - -@[simp] -theorem xor_right_inj : ∀ (x y z : Bool), xor x z = xor y z ↔ x = y := by decide - -/-! ### le/lt -/ - -@[simp] protected theorem le_true : ∀ (x : Bool), x ≤ true := by decide - -@[simp] protected theorem false_le : ∀ (x : Bool), false ≤ x := by decide - -@[simp] protected theorem le_refl : ∀ (x : Bool), x ≤ x := by decide - -@[simp] protected theorem lt_irrefl : ∀ (x : Bool), ¬ x < x := by decide - -protected theorem le_trans : ∀ {x y z : Bool}, x ≤ y → y ≤ z → x ≤ z := by decide - -protected theorem le_antisymm : ∀ {x y : Bool}, x ≤ y → y ≤ x → x = y := by decide - -protected theorem le_total : ∀ (x y : Bool), x ≤ y ∨ y ≤ x := by decide - -protected theorem lt_asymm : ∀ {x y : Bool}, x < y → ¬ y < x := by decide - -protected theorem lt_trans : ∀ {x y z : Bool}, x < y → y < z → x < z := by decide - -protected theorem lt_iff_le_not_le : ∀ {x y : Bool}, x < y ↔ x ≤ y ∧ ¬ y ≤ x := by decide - -protected theorem lt_of_le_of_lt : ∀ {x y z : Bool}, x ≤ y → y < z → x < z := by decide - -protected theorem lt_of_lt_of_le : ∀ {x y z : Bool}, x < y → y ≤ z → x < z := by decide - -protected theorem le_of_lt : ∀ {x y : Bool}, x < y → x ≤ y := by decide - -protected theorem le_of_eq : ∀ {x y : Bool}, x = y → x ≤ y := by decide - -protected theorem ne_of_lt : ∀ {x y : Bool}, x < y → x ≠ y := by decide - -protected theorem lt_of_le_of_ne : ∀ {x y : Bool}, x ≤ y → x ≠ y → x < y := by decide - -protected theorem le_of_lt_or_eq : ∀ {x y : Bool}, x < y ∨ x = y → x ≤ y := by decide - -protected theorem eq_true_of_true_le : ∀ {x : Bool}, true ≤ x → x = true := by decide - -protected theorem eq_false_of_le_false : ∀ {x : Bool}, x ≤ false → x = false := by decide - -/-! ### min/max -/ - -@[simp] protected theorem max_eq_or : max = or := rfl - -@[simp] protected theorem min_eq_and : min = and := rfl - /-! ### injectivity lemmas -/ -theorem not_inj : ∀ {x y : Bool}, (!x) = (!y) → x = y := by decide - -theorem not_inj_iff : ∀ {x y : Bool}, (!x) = (!y) ↔ x = y := by decide @[deprecated] alias not_inj' := not_inj_iff -theorem and_or_inj_right : ∀ {m x y : Bool}, (x && m) = (y && m) → (x || m) = (y || m) → x = y := by - decide - -theorem and_or_inj_right_iff : - ∀ {m x y : Bool}, (x && m) = (y && m) ∧ (x || m) = (y || m) ↔ x = y := by decide @[deprecated] alias and_or_inj_right' := and_or_inj_right_iff -theorem and_or_inj_left : ∀ {m x y : Bool}, (m && x) = (m && y) → (m || x) = (m || y) → x = y := by - decide - -theorem and_or_inj_left_iff : - ∀ {m x y : Bool}, (m && x) = (m && y) ∧ (m || x) = (m || y) ↔ x = y := by decide @[deprecated] alias and_or_inj_left' := and_or_inj_left_iff -/-! ## toNat -/ - -/-- convert a `Bool` to a `Nat`, `false -> 0`, `true -> 1` -/ -def toNat (b:Bool) : Nat := cond b 1 0 - -@[simp] theorem toNat_false : false.toNat = 0 := rfl - -@[simp] theorem toNat_true : true.toNat = 1 := rfl - -theorem toNat_le_one (c:Bool) : c.toNat ≤ 1 := by - cases c <;> trivial - end Bool - -/-! ### cond -/ - -theorem cond_eq_if : (bif b then x else y) = (if b then x else y) := by - cases b <;> simp - -/-! ### decide -/ - -@[simp] theorem false_eq_decide_iff {p : Prop} [h : Decidable p] : false = decide p ↔ ¬p := by - cases h with | _ q => simp [q] - -@[simp] theorem true_eq_decide_iff {p : Prop} [h : Decidable p] : true = decide p ↔ p := by - cases h with | _ q => simp [q] diff --git a/Std/Data/ByteArray.lean b/Std/Data/ByteArray.lean index 4652153d5c..1a6d6b5df2 100644 --- a/Std/Data/ByteArray.lean +++ b/Std/Data/ByteArray.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ import Std.Data.Array.Lemmas -import Std.Tactic.Ext.Attr namespace ByteArray diff --git a/Std/Data/Char.lean b/Std/Data/Char.lean index 2c3be7cd13..5ee22c51b4 100644 --- a/Std/Data/Char.lean +++ b/Std/Data/Char.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Std.Tactic.Ext.Attr @[ext] theorem Char.ext : {a b : Char} → a.val = b.val → a = b | ⟨_,_⟩, ⟨_,_⟩, rfl => rfl diff --git a/Std/Data/Fin.lean b/Std/Data/Fin.lean index 0b79375e25..b3a51cf303 100644 --- a/Std/Data/Fin.lean +++ b/Std/Data/Fin.lean @@ -1,3 +1,2 @@ import Std.Data.Fin.Basic -import Std.Data.Fin.Iterate import Std.Data.Fin.Lemmas diff --git a/Std/Data/Fin/Basic.lean b/Std/Data/Fin/Basic.lean index b3f65ed516..9512f4019c 100644 --- a/Std/Data/Fin/Basic.lean +++ b/Std/Data/Fin/Basic.lean @@ -6,45 +6,6 @@ Authors: Robert Y. Lewis, Keeley Hoek, Mario Carneiro namespace Fin -protected theorem pos (i : Fin n) : 0 < n := - Nat.lt_of_le_of_lt (Nat.zero_le _) i.2 - -/-- The greatest value of `Fin (n+1)`. -/ -@[inline] def last (n : Nat) : Fin (n + 1) := ⟨n, n.lt_succ_self⟩ - -/-- `castLT i h` embeds `i` into a `Fin` where `h` proves it belongs into. -/ -@[inline] def castLT (i : Fin m) (h : i.1 < n) : Fin n := ⟨i.1, h⟩ - -/-- `castLE h i` embeds `i` into a larger `Fin` type. -/ -@[inline] def castLE (h : n ≤ m) (i : Fin n) : Fin m := ⟨i, Nat.lt_of_lt_of_le i.2 h⟩ - -/-- `cast eq i` embeds `i` into an equal `Fin` type. -/ -@[inline] def cast (eq : n = m) (i : Fin n) : Fin m := ⟨i, eq ▸ i.2⟩ - -/-- `castAdd m i` embeds `i : Fin n` in `Fin (n+m)`. See also `Fin.natAdd` and `Fin.addNat`. -/ -@[inline] def castAdd (m) : Fin n → Fin (n + m) := - castLE <| Nat.le_add_right n m - -/-- `castSucc i` embeds `i : Fin n` in `Fin (n+1)`. -/ -@[inline] def castSucc : Fin n → Fin (n + 1) := castAdd 1 - -/-- `addNat m i` adds `m` to `i`, generalizes `Fin.succ`. -/ -def addNat (i : Fin n) (m) : Fin (n + m) := ⟨i + m, Nat.add_lt_add_right i.2 _⟩ - -/-- `natAdd n i` adds `n` to `i` "on the left". -/ -def natAdd (n) (i : Fin m) : Fin (n + m) := ⟨n + i, Nat.add_lt_add_left i.2 _⟩ - -/-- Maps `0` to `n-1`, `1` to `n-2`, ..., `n-1` to `0`. -/ -@[inline] def rev (i : Fin n) : Fin n := ⟨n - (i + 1), Nat.sub_lt i.pos (Nat.succ_pos _)⟩ - -/-- `subNat i h` subtracts `m` from `i`, generalizes `Fin.pred`. -/ -@[inline] def subNat (m) (i : Fin (n + m)) (h : m ≤ i) : Fin n := - ⟨i - m, Nat.sub_lt_right_of_lt_add h i.2⟩ - -/-- Predecessor of a nonzero element of `Fin (n+1)`. -/ -@[inline] def pred {n : Nat} (i : Fin (n + 1)) (h : i ≠ 0) : Fin n := - subNat 1 i <| Nat.pos_of_ne_zero <| mt (Fin.eq_of_val_eq (j := 0)) h - /-- `min n m` as an element of `Fin (m + 1)` -/ def clamp (n m : Nat) : Fin (m + 1) := ⟨min n m, Nat.lt_succ_of_le (Nat.min_le_right ..)⟩ diff --git a/Std/Data/Fin/Iterate.lean b/Std/Data/Fin/Iterate.lean deleted file mode 100644 index 73a03a7998..0000000000 --- a/Std/Data/Fin/Iterate.lean +++ /dev/null @@ -1,93 +0,0 @@ -/- -Copyright (c) 2023 by the authors listed in the file AUTHORS and their -institutional affiliations. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix --/ - -namespace Fin - -/-- -`hIterateFrom f i bnd a` applies `f` over indices `[i:n]` to compute `P n` -from `P i`. - -See `hIterate` below for more details. --/ -def hIterateFrom (P : Nat → Sort _) {n} (f : ∀(i : Fin n), P i.val → P (i.val+1)) - (i : Nat) (ubnd : i ≤ n) (a : P i) : P n := - if g : i < n then - hIterateFrom P f (i+1) g (f ⟨i, g⟩ a) - else - have p : i = n := (or_iff_left g).mp (Nat.eq_or_lt_of_le ubnd) - cast (congrArg P p) a - termination_by n - i - -/-- -`hIterate` is a heterogenous iterative operation that applies a -index-dependent function `f` to a value `init : P start` a total of -`stop - start` times to produce a value of type `P stop`. - -Concretely, `hIterate start stop f init` is equal to -```lean - init |> f start _ |> f (start+1) _ ... |> f (end-1) _ -``` - -Because it is heterogenous and must return a value of type `P stop`, -`hIterate` requires proof that `start ≤ stop`. - -One can prove properties of `hIterate` using the general theorem -`hIterate_elim` or other more specialized theorems. - -/ -def hIterate (P : Nat → Sort _) {n : Nat} (init : P 0) (f : ∀(i : Fin n), P i.val → P (i.val+1)) : - P n := - hIterateFrom P f 0 (Nat.zero_le n) init - -private theorem hIterateFrom_elim {P : Nat → Sort _}(Q : ∀(i : Nat), P i → Prop) - {n : Nat} - (f : ∀(i : Fin n), P i.val → P (i.val+1)) - {i : Nat} (ubnd : i ≤ n) - (s : P i) - (init : Q i s) - (step : ∀(k : Fin n) (s : P k.val), Q k.val s → Q (k.val+1) (f k s)) : - Q n (hIterateFrom P f i ubnd s) := by - let ⟨j, p⟩ := Nat.le.dest ubnd - induction j generalizing i ubnd init with - | zero => - unfold hIterateFrom - have g : ¬ (i < n) := by simp at p; simp [p] - have r : Q n (cast (congrArg P p) s) := - @Eq.rec Nat i (fun k eq => Q k (cast (congrArg P eq) s)) init n p - simp only [g, r, dite_false] - | succ j inv => - unfold hIterateFrom - have d : Nat.succ i + j = n := by simp [Nat.succ_add]; exact p - have g : i < n := Nat.le.intro d - simp only [g] - exact inv _ _ (step ⟨i,g⟩ s init) d - -/- -`hIterate_elim` provides a mechanism for showing that the result of -`hIterate` satisifies a property `Q stop` by showing that the states -at the intermediate indices `i : start ≤ i < stop` satisfy `Q i`. --/ -theorem hIterate_elim {P : Nat → Sort _} (Q : ∀(i : Nat), P i → Prop) - {n : Nat} (f : ∀(i : Fin n), P i.val → P (i.val+1)) (s : P 0) (init : Q 0 s) - (step : ∀(k : Fin n) (s : P k.val), Q k.val s → Q (k.val+1) (f k s)) : - Q n (hIterate P s f) := by - exact hIterateFrom_elim _ _ _ _ init step - -/- -`hIterate_eq`provides a mechanism for replacing `hIterate P s f` with a -function `state` showing that matches the steps performed by `hIterate`. - -This allows rewriting incremental code using `hIterate` with a -non-incremental state function. --/ -theorem hIterate_eq {P : Nat → Sort _} (state : ∀(i : Nat), P i) - {n : Nat} (f : ∀(i : Fin n), P i.val → P (i.val+1)) (s : P 0) - (init : s = state 0) - (step : ∀(i : Fin n), f i (state i) = state (i+1)) : - hIterate P s f = state n := by - apply hIterate_elim (fun i s => s = state i) f s init - intro i s s_eq - simp only [s_eq, step] diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 59e1d2d12f..6fd2666be0 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -4,11 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Fin.Basic -import Std.Data.Nat.Lemmas -import Std.Tactic.Ext import Std.Tactic.Simpa import Std.Tactic.NormCast.Lemmas -import Std.Tactic.Omega import Std.Tactic.SimpTrace namespace Fin diff --git a/Std/Data/HashMap/Basic.lean b/Std/Data/HashMap/Basic.lean index 5a41196e0f..4f9317d128 100644 --- a/Std/Data/HashMap/Basic.lean +++ b/Std/Data/HashMap/Basic.lean @@ -203,7 +203,7 @@ Applies `f` to each key-value pair `a, b` in the map. If it returns `some c` the have : m'.1.size > 0 := by have := Array.size_mapM (m := StateT (ULift Nat) Id) (go .nil) m.buckets.1 simp [SatisfiesM_StateT_eq, SatisfiesM_Id_eq] at this - simp [this, Id.run, StateT.run, m.2.2] + simp [this, Id.run, StateT.run, m.2.2, m'] ⟨m'.2.1, m'.1, this⟩ where /-- Inner loop of `filterMap`. Note that this reverses the bucket lists, diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index 06378b19da..0688ad3417 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -311,7 +311,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable let g₁ (l : AssocList α β) := l.toList.filterMap (fun x => (f x.1 x.2).map (x.1, ·)) have H1 (l n acc) : filterMap.go f acc l n = (((g₁ l).reverse ++ acc.toList).toAssocList, ⟨n.1 + (g₁ l).length⟩) := by - induction l generalizing n acc with simp [filterMap.go, *] + induction l generalizing n acc with simp [filterMap.go, g₁, *] | cons a b l => match f a b with | none => rfl | some c => simp; rw [Nat.add_right_comm]; rfl @@ -322,7 +322,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable (l.map g, ⟨n.1 + .sum ((l.map g).map (·.toList.length))⟩) := by induction l generalizing n with | nil => rfl - | cons l L IH => simp [bind, StateT.bind, IH, H1, Nat.add_assoc]; rfl + | cons l L IH => simp [bind, StateT.bind, IH, H1, Nat.add_assoc, g]; rfl have H3 (l : List _) : (l.filterMap (fun (a, b) => (f a b).map (a, ·))).map (fun a => a.fst) |>.Sublist (l.map (·.1)) := by @@ -335,7 +335,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable suffices ∀ bk sz (h : 0 < bk.length), m.buckets.val.mapM (m := M) (filterMap.go f .nil) ⟨0⟩ = (⟨bk⟩, ⟨sz⟩) → WF ⟨sz, ⟨bk⟩, h⟩ from this _ _ _ rfl - simp [Array.mapM_eq_mapM_data, bind, StateT.bind, H2] + simp [Array.mapM_eq_mapM_data, bind, StateT.bind, H2, g] intro bk sz h e'; cases e' refine .mk (by simp [Buckets.size]) ⟨?_, fun i h => ?_⟩ · simp only [List.forall_mem_map_iff, List.toList_toAssocList] @@ -343,9 +343,12 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable have := H.out.2.1 _ h rw [← List.pairwise_map (R := (¬ · == ·))] at this ⊢ exact this.sublist (H3 l.toList) - · simp [Array.getElem_eq_data_get] at h ⊢ - have := H.out.2.2 _ h; simp [AssocList.All] at this ⊢ - rintro _ _ h' _ _ rfl; exact this _ h' + · simp only [Array.size_mk, List.length_map, Array.data_length, Array.getElem_eq_data_get, + List.get_map] at h ⊢ + have := H.out.2.2 _ h + simp [AssocList.All, g₁] at this ⊢ + rintro _ _ h' _ _ rfl + exact this _ h' end Imp diff --git a/Std/Data/Int.lean b/Std/Data/Int.lean index e3f10da0b6..9f2f799da1 100644 --- a/Std/Data/Int.lean +++ b/Std/Data/Int.lean @@ -1,8 +1,4 @@ -import Std.Data.Int.Basic import Std.Data.Int.DivMod import Std.Data.Int.Gcd -import Std.Data.Int.Init.DivMod -import Std.Data.Int.Init.Lemmas -import Std.Data.Int.Init.Order import Std.Data.Int.Lemmas import Std.Data.Int.Order diff --git a/Std/Data/Int/Basic.lean b/Std/Data/Int/Basic.lean deleted file mode 100644 index c483dd63c6..0000000000 --- a/Std/Data/Int/Basic.lean +++ /dev/null @@ -1,173 +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 --/ -import Lean.ToExpr - -open Nat - -namespace Int - -/-- -`-[n+1]` is suggestive notation for `negSucc n`, which is the second constructor of -`Int` for making strictly negative numbers by mapping `n : Nat` to `-(n + 1)`. --/ -scoped notation "-[" n "+1]" => negSucc n - -/- ## sign -/ - -/-- -Returns the "sign" of the integer as another integer: `1` for positive numbers, -`-1` for negative numbers, and `0` for `0`. --/ -def sign : Int → Int - | succ _ => 1 - | 0 => 0 - | -[_+1] => -1 - -/-! ## toNat' -/ - -/-- -* If `n : Nat`, then `int.toNat' n = some n` -* If `n : Int` is negative, then `int.toNat' n = none`. --/ -def toNat' : Int → Option Nat - | (n : Nat) => some n - | -[_+1] => none - -/-! ## Quotient and remainder - -There are three main conventions for integer division, -referred here as the E, F, T rounding conventions. -All three pairs satisfy the identity `x % y + (x / y) * y = x` unconditionally, -and satisfy `x / 0 = 0` and `x % 0 = x`. --/ - -/-! ### E-rounding division - -This pair satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0`. --/ - -/-- -Integer division. This version of `Int.div` uses the E-rounding convention -(euclidean division), in which `Int.emod x y` satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0` -and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`. --/ -def ediv : Int → Int → Int - | ofNat m, ofNat n => ofNat (m / n) - | ofNat m, -[n+1] => -ofNat (m / succ n) - | -[_+1], 0 => 0 - | -[m+1], succ n => -[m / succ n +1] - | -[m+1], -[n+1] => ofNat (succ (m / succ n)) - -/-- -Integer modulus. This version of `Int.mod` uses the E-rounding convention -(euclidean division), in which `Int.emod x y` satisfies `0 ≤ emod x y < natAbs y` for `y ≠ 0` -and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`. --/ -def emod : Int → Int → Int - | ofNat m, n => ofNat (m % natAbs n) - | -[m+1], n => subNatNat (natAbs n) (succ (m % natAbs n)) - - -/-! ### F-rounding division - -This pair satisfies `fdiv x y = floor (x / y)`. --/ - -/-- -Integer division. This version of `Int.div` uses the F-rounding convention -(flooring division), in which `Int.fdiv x y` satisfies `fdiv x y = floor (x / y)` -and `Int.fmod` is the unique function satisfying `fmod x y + (fdiv x y) * y = x`. --/ -def fdiv : Int → Int → Int - | 0, _ => 0 - | ofNat m, ofNat n => ofNat (m / n) - | succ m, -[n+1] => -[m / succ n +1] - | -[_+1], 0 => 0 - | -[m+1], succ n => -[m / succ n +1] - | -[m+1], -[n+1] => ofNat (succ m / succ n) - -/-- -Integer modulus. This version of `Int.mod` uses the F-rounding convention -(flooring division), in which `Int.fdiv x y` satisfies `fdiv x y = floor (x / y)` -and `Int.fmod` is the unique function satisfying `fmod x y + (fdiv x y) * y = x`. --/ -def fmod : Int → Int → Int - | 0, _ => 0 - | ofNat m, ofNat n => ofNat (m % n) - | succ m, -[n+1] => subNatNat (m % succ n) n - | -[m+1], ofNat n => subNatNat n (succ (m % n)) - | -[m+1], -[n+1] => -ofNat (succ m % succ n) - -/-! ### T-rounding division - -This pair satisfies `div x y = round_to_zero (x / y)`. -`Int.div` and `Int.mod` are defined in core lean. --/ - -/-- -Core Lean provides instances using T-rounding division, i.e. `Int.div` and `Int.mod`. -We override these here. --/ -instance : Div Int := ⟨Int.ediv⟩ -instance : Mod Int := ⟨Int.emod⟩ - -/-! ## gcd -/ - -/-- Computes the greatest common divisor of two integers, as a `Nat`. -/ -def gcd (m n : Int) : Nat := m.natAbs.gcd n.natAbs - -/-! ## divisibility -/ - -/-- -Divisibility of integers. `a ∣ b` (typed as `\|`) says that -there is some `c` such that `b = a * c`. --/ -instance : Dvd Int := ⟨fun a b => ∃ c, b = a * c⟩ - -/-! ## bit operations -/ - -/-- -Bitwise not - -Interprets the integer as an infinite sequence of bits in two's complement -and complements each bit. -``` -~~~(0:Int) = -1 -~~~(1:Int) = -2 -~~~(-1:Int) = 0 -``` --/ -protected def not : Int -> Int - | Int.ofNat n => Int.negSucc n - | Int.negSucc n => Int.ofNat n - -instance : Complement Int := ⟨.not⟩ - -/-- -Bitwise shift right. - -Conceptually, this treats the integer as an infinite sequence of bits in two's -complement and shifts the value to the right. - -```lean -( 0b0111:Int) >>> 1 = 0b0011 -( 0b1000:Int) >>> 1 = 0b0100 -(-0b1000:Int) >>> 1 = -0b0100 -(-0b0111:Int) >>> 1 = -0b0100 -``` --/ -protected def shiftRight : Int → Nat → Int - | Int.ofNat n, s => Int.ofNat (n >>> s) - | Int.negSucc n, s => Int.negSucc (n >>> s) - -instance : HShiftRight Int Nat Int := ⟨.shiftRight⟩ - -open Lean in -instance : ToExpr Int where - toTypeExpr := .const ``Int [] - toExpr i := match i with - | .ofNat n => mkApp (.const ``Int.ofNat []) (toExpr n) - | .negSucc n => mkApp (.const ``Int.negSucc []) (toExpr n) diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 4a12871d10..383a6c2088 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -5,7 +5,6 @@ Authors: Jeremy Avigad, Mario Carneiro -/ import Std.Data.Nat.Lemmas import Std.Data.Int.Order -import Std.Data.Int.Init.DivMod /-! # Lemmas about integer division @@ -59,12 +58,6 @@ theorem fdiv_eq_div {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = div a | ofNat m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm | ofNat m, succ n | -[m+1], 0 | -[m+1], -[n+1] => rfl --- Lean 4 core provides an instance for `Div Int` using `Int.div`. --- Even though we provide a higher priority instance in `Std.Data.Int.Basic`, --- we provide a `simp` lemma here to unfold usages of that instance back to `Int.div`. -@[simp] theorem div_def' (a b : Int) : - @HDiv.hDiv Int Int Int (@instHDiv Int Int.instDivInt) a b = Int.div a b := rfl - @[simp] protected theorem neg_div : ∀ a b : Int, (-a).div b = -(a.div b) | 0, n => by simp [Int.neg_zero] | succ m, (n:Nat) | -[m+1], 0 | -[m+1], -[n+1] => rfl diff --git a/Std/Data/Int/Init/DivMod.lean b/Std/Data/Int/Init/DivMod.lean deleted file mode 100644 index a0eeb55ae8..0000000000 --- a/Std/Data/Int/Init/DivMod.lean +++ /dev/null @@ -1,340 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Mario Carneiro --/ -import Std.Data.Int.Init.Order - -/-! -# Lemmas about integer division needed to bootstrap `omega`. --/ - - -open Nat - -namespace Int - -/-! ### `/` -/ - -@[simp, norm_cast] theorem ofNat_ediv (m n : Nat) : (↑(m / n) : Int) = ↑m / ↑n := rfl - -@[simp] theorem zero_ediv : ∀ b : Int, 0 / b = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => show -ofNat _ = _ by simp - -@[simp] protected theorem ediv_zero : ∀ a : Int, a / 0 = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => rfl - -@[simp] protected theorem ediv_neg : ∀ a b : Int, a / (-b) = -(a / b) - | ofNat m, 0 => show ofNat (m / 0) = -↑(m / 0) by rw [Nat.div_zero]; rfl - | ofNat m, -[n+1] => (Int.neg_neg _).symm - | ofNat m, succ n | -[m+1], 0 | -[m+1], succ n | -[m+1], -[n+1] => rfl - -protected theorem div_def (a b : Int) : a / b = Int.ediv a b := rfl - -theorem add_mul_ediv_right (a b : Int) {c : Int} (H : c ≠ 0) : (a + b * c) / c = a / c + b := - suffices ∀ {{a b c : Int}}, 0 < c → (a + b * c).ediv c = a.ediv c + b from - match Int.lt_trichotomy c 0 with - | Or.inl hlt => by - rw [← Int.neg_inj, ← Int.ediv_neg, Int.neg_add, ← Int.ediv_neg, ← Int.neg_mul_neg] - exact this (Int.neg_pos_of_neg hlt) - | Or.inr (Or.inl HEq) => absurd HEq H - | Or.inr (Or.inr hgt) => this hgt - suffices ∀ {k n : Nat} {a : Int}, (a + n * k.succ).ediv k.succ = a.ediv k.succ + n from - fun a b c H => match c, eq_succ_of_zero_lt H, b with - | _, ⟨_, rfl⟩, ofNat _ => this - | _, ⟨k, rfl⟩, -[n+1] => show (a - n.succ * k.succ).ediv k.succ = a.ediv k.succ - n.succ by - rw [← Int.add_sub_cancel (ediv ..), ← this, Int.sub_add_cancel] - fun {k n} => @fun - | ofNat m => congrArg ofNat <| Nat.add_mul_div_right _ _ k.succ_pos - | -[m+1] => by - show ((n * k.succ : Nat) - m.succ : Int).ediv k.succ = n - (m / k.succ + 1 : Nat) - if h : m < n * k.succ then - rw [← Int.ofNat_sub h, ← Int.ofNat_sub ((Nat.div_lt_iff_lt_mul k.succ_pos).2 h)] - apply congrArg ofNat - rw [Nat.mul_comm, Nat.mul_sub_div]; rwa [Nat.mul_comm] - else - have h := Nat.not_lt.1 h - have H {a b : Nat} (h : a ≤ b) : (a : Int) + -((b : Int) + 1) = -[b - a +1] := by - rw [negSucc_eq, Int.ofNat_sub h] - simp only [Int.sub_eq_add_neg, Int.neg_add, Int.neg_neg, Int.add_left_comm, Int.add_assoc] - show ediv (↑(n * succ k) + -((m : Int) + 1)) (succ k) = n + -(↑(m / succ k) + 1 : Int) - rw [H h, H ((Nat.le_div_iff_mul_le k.succ_pos).2 h)] - apply congrArg negSucc - rw [Nat.mul_comm, Nat.sub_mul_div]; rwa [Nat.mul_comm] - -theorem add_ediv_of_dvd_right {a b c : Int} (H : c ∣ b) : (a + b) / c = a / c + b / c := - if h : c = 0 then by simp [h] else by - let ⟨k, hk⟩ := H - rw [hk, Int.mul_comm c k, Int.add_mul_ediv_right _ _ h, - ← Int.zero_add (k * c), Int.add_mul_ediv_right _ _ h, Int.zero_ediv, Int.zero_add] - -theorem add_ediv_of_dvd_left {a b c : Int} (H : c ∣ a) : (a + b) / c = a / c + b / c := by - rw [Int.add_comm, Int.add_ediv_of_dvd_right H, Int.add_comm] - -@[simp] theorem mul_ediv_cancel (a : Int) {b : Int} (H : b ≠ 0) : (a * b) / b = a := by - have := Int.add_mul_ediv_right 0 a H - rwa [Int.zero_add, Int.zero_ediv, Int.zero_add] at this - -@[simp] theorem mul_ediv_cancel_left (b : Int) (H : a ≠ 0) : (a * b) / a = b := - Int.mul_comm .. ▸ Int.mul_ediv_cancel _ H - -theorem div_nonneg_iff_of_pos {a b : Int} (h : 0 < b) : a / b ≥ 0 ↔ a ≥ 0 := by - rw [Int.div_def] - match b, h with - | Int.ofNat (b+1), _ => - rcases a with ⟨a⟩ <;> simp [Int.ediv] - exact decide_eq_decide.mp rfl - -/-! ### mod -/ - -theorem mod_def' (m n : Int) : m % n = emod m n := rfl - -theorem ofNat_mod (m n : Nat) : (↑(m % n) : Int) = mod m n := rfl - -theorem ofNat_mod_ofNat (m n : Nat) : (m % n : Int) = ↑(m % n) := rfl - -@[simp, norm_cast] theorem ofNat_emod (m n : Nat) : (↑(m % n) : Int) = m % n := rfl - -@[simp] theorem zero_emod (b : Int) : 0 % b = 0 := by simp [mod_def', emod] - -@[simp] theorem emod_zero : ∀ a : Int, a % 0 = a - | ofNat _ => congrArg ofNat <| Nat.mod_zero _ - | -[_+1] => congrArg negSucc <| Nat.mod_zero _ - -theorem emod_add_ediv : ∀ a b : Int, a % b + b * (a / b) = a - | ofNat _, ofNat _ => congrArg ofNat <| Nat.mod_add_div .. - | ofNat m, -[n+1] => by - show (m % succ n + -↑(succ n) * -↑(m / succ n) : Int) = m - rw [Int.neg_mul_neg]; exact congrArg ofNat <| Nat.mod_add_div .. - | -[_+1], 0 => by rw [emod_zero]; rfl - | -[m+1], succ n => aux m n.succ - | -[m+1], -[n+1] => aux m n.succ -where - aux (m n : Nat) : n - (m % n + 1) - (n * (m / n) + n) = -[m+1] := by - rw [← ofNat_emod, ← ofNat_ediv, ← Int.sub_sub, negSucc_eq, Int.sub_sub n, - ← Int.neg_neg (_-_), Int.neg_sub, Int.sub_sub_self, Int.add_right_comm] - exact congrArg (fun x => -(ofNat x + 1)) (Nat.mod_add_div ..) - -theorem ediv_add_emod (a b : Int) : b * (a / b) + a % b = a := - (Int.add_comm ..).trans (emod_add_ediv ..) - -theorem emod_def (a b : Int) : a % b = a - b * (a / b) := by - rw [← Int.add_sub_cancel (a % b), emod_add_ediv] - -theorem emod_nonneg : ∀ (a : Int) {b : Int}, b ≠ 0 → 0 ≤ a % b - | ofNat _, _, _ => ofNat_zero_le _ - | -[_+1], _, H => Int.sub_nonneg_of_le <| ofNat_le.2 <| Nat.mod_lt _ (natAbs_pos.2 H) - -theorem emod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : a % b < b := - match a, b, eq_succ_of_zero_lt H with - | ofNat _, _, ⟨_, rfl⟩ => ofNat_lt.2 (Nat.mod_lt _ (Nat.succ_pos _)) - | -[_+1], _, ⟨_, rfl⟩ => Int.sub_lt_self _ (ofNat_lt.2 <| Nat.succ_pos _) - -theorem mul_ediv_self_le {x k : Int} (h : k ≠ 0) : k * (x / k) ≤ x := - calc k * (x / k) - _ ≤ k * (x / k) + x % k := Int.le_add_of_nonneg_right (emod_nonneg x h) - _ = x := ediv_add_emod _ _ - -theorem lt_mul_ediv_self_add {x k : Int} (h : 0 < k) : x < k * (x / k) + k := - calc x - _ = k * (x / k) + x % k := (ediv_add_emod _ _).symm - _ < k * (x / k) + k := Int.add_lt_add_left (emod_lt_of_pos x h) _ - -theorem emod_add_ediv' (m k : Int) : m % k + m / k * k = m := by - rw [Int.mul_comm]; apply emod_add_ediv - -@[simp] theorem add_mul_emod_self {a b c : Int} : (a + b * c) % c = a % c := - if cz : c = 0 then by - rw [cz, Int.mul_zero, Int.add_zero] - else by - rw [Int.emod_def, Int.emod_def, Int.add_mul_ediv_right _ _ cz, Int.add_comm _ b, - Int.mul_add, Int.mul_comm, ← Int.sub_sub, Int.add_sub_cancel] - -@[simp] theorem add_mul_emod_self_left (a b c : Int) : (a + b * c) % b = a % b := by - rw [Int.mul_comm, Int.add_mul_emod_self] - -@[simp] theorem add_emod_self {a b : Int} : (a + b) % b = a % b := by - have := add_mul_emod_self_left a b 1; rwa [Int.mul_one] at this - -@[simp] theorem add_emod_self_left {a b : Int} : (a + b) % a = b % a := by - rw [Int.add_comm, Int.add_emod_self] - -theorem neg_emod {a b : Int} : -a % b = (b - a) % b := by - rw [← add_emod_self_left]; rfl - -@[simp] theorem emod_add_emod (m n k : Int) : (m % n + k) % n = (m + k) % n := by - have := (add_mul_emod_self_left (m % n + k) n (m / n)).symm - rwa [Int.add_right_comm, emod_add_ediv] at this - -@[simp] theorem add_emod_emod (m n k : Int) : (m + n % k) % k = (m + n) % k := by - rw [Int.add_comm, emod_add_emod, Int.add_comm] - -theorem add_emod (a b n : Int) : (a + b) % n = (a % n + b % n) % n := by - rw [add_emod_emod, emod_add_emod] - -theorem add_emod_eq_add_emod_right {m n k : Int} (i : Int) - (H : m % n = k % n) : (m + i) % n = (k + i) % n := by - rw [← emod_add_emod, ← emod_add_emod k, H] - -theorem emod_add_cancel_right {m n k : Int} (i) : (m + i) % n = (k + i) % n ↔ m % n = k % n := - ⟨fun H => by - have := add_emod_eq_add_emod_right (-i) H - rwa [Int.add_neg_cancel_right, Int.add_neg_cancel_right] at this, - add_emod_eq_add_emod_right _⟩ - -@[simp] theorem mul_emod_left (a b : Int) : (a * b) % b = 0 := by - rw [← Int.zero_add (a * b), Int.add_mul_emod_self, Int.zero_emod] - -@[simp] theorem mul_emod_right (a b : Int) : (a * b) % a = 0 := by - rw [Int.mul_comm, mul_emod_left] - -theorem mul_emod (a b n : Int) : (a * b) % n = (a % n) * (b % n) % n := by - conv => lhs; rw [ - ← emod_add_ediv a n, ← emod_add_ediv' b n, Int.add_mul, Int.mul_add, Int.mul_add, - Int.mul_assoc, Int.mul_assoc, ← Int.mul_add n _ _, add_mul_emod_self_left, - ← Int.mul_assoc, add_mul_emod_self] - -@[local simp] theorem emod_self {a : Int} : a % a = 0 := by - have := mul_emod_left 1 a; rwa [Int.one_mul] at this - -@[simp] theorem emod_emod_of_dvd (n : Int) {m k : Int} - (h : m ∣ k) : (n % k) % m = n % m := by - conv => rhs; rw [← emod_add_ediv n k] - match k, h with - | _, ⟨t, rfl⟩ => rw [Int.mul_assoc, add_mul_emod_self_left] - -@[simp] theorem emod_emod (a b : Int) : (a % b) % b = a % b := by - conv => rhs; rw [← emod_add_ediv a b, add_mul_emod_self_left] - -theorem sub_emod (a b n : Int) : (a - b) % n = (a % n - b % n) % n := by - apply (emod_add_cancel_right b).mp - rw [Int.sub_add_cancel, ← Int.add_emod_emod, Int.sub_add_cancel, emod_emod] - -/-! ### properties of `/` and `%` -/ - -theorem mul_ediv_cancel_of_emod_eq_zero {a b : Int} (H : a % b = 0) : b * (a / b) = a := by - have := emod_add_ediv a b; rwa [H, Int.zero_add] at this - -theorem ediv_mul_cancel_of_emod_eq_zero {a b : Int} (H : a % b = 0) : a / b * b = a := by - rw [Int.mul_comm, mul_ediv_cancel_of_emod_eq_zero H] - -/-! ### dvd -/ - -protected theorem dvd_zero (n : Int) : n ∣ 0 := ⟨0, (Int.mul_zero _).symm⟩ - -protected theorem dvd_refl (n : Int) : n ∣ n := ⟨1, (Int.mul_one _).symm⟩ - -protected theorem one_dvd (n : Int) : 1 ∣ n := ⟨n, (Int.one_mul n).symm⟩ - -protected theorem dvd_trans : ∀ {a b c : Int}, a ∣ b → b ∣ c → a ∣ c - | _, _, _, ⟨d, rfl⟩, ⟨e, rfl⟩ => ⟨d * e, by rw [Int.mul_assoc]⟩ - -@[simp] protected theorem zero_dvd {n : Int} : 0 ∣ n ↔ n = 0 := - ⟨fun ⟨k, e⟩ => by rw [e, Int.zero_mul], fun h => h.symm ▸ Int.dvd_refl _⟩ - -protected theorem neg_dvd {a b : Int} : -a ∣ b ↔ a ∣ b := by - constructor <;> exact fun ⟨k, e⟩ => - ⟨-k, by simp [e, Int.neg_mul, Int.mul_neg, Int.neg_neg]⟩ - -protected theorem dvd_neg {a b : Int} : a ∣ -b ↔ a ∣ b := by - constructor <;> exact fun ⟨k, e⟩ => - ⟨-k, by simp [← e, Int.neg_mul, Int.mul_neg, Int.neg_neg]⟩ - -protected theorem dvd_mul_right (a b : Int) : a ∣ a * b := ⟨_, rfl⟩ - -protected theorem dvd_mul_left (a b : Int) : b ∣ a * b := ⟨_, Int.mul_comm ..⟩ - -protected theorem dvd_add : ∀ {a b c : Int}, a ∣ b → a ∣ c → a ∣ b + c - | _, _, _, ⟨d, rfl⟩, ⟨e, rfl⟩ => ⟨d + e, by rw [Int.mul_add]⟩ - -protected theorem dvd_sub : ∀ {a b c : Int}, a ∣ b → a ∣ c → a ∣ b - c - | _, _, _, ⟨d, rfl⟩, ⟨e, rfl⟩ => ⟨d - e, by rw [Int.mul_sub]⟩ - - -@[norm_cast] theorem ofNat_dvd {m n : Nat} : (↑m : Int) ∣ ↑n ↔ m ∣ n := by - refine ⟨fun ⟨a, ae⟩ => ?_, fun ⟨k, e⟩ => ⟨k, by rw [e, Int.ofNat_mul]⟩⟩ - match Int.le_total a 0 with - | .inl h => - have := ae.symm ▸ Int.mul_nonpos_of_nonneg_of_nonpos (ofNat_zero_le _) h - rw [Nat.le_antisymm (ofNat_le.1 this) (Nat.zero_le _)] - apply Nat.dvd_zero - | .inr h => match a, eq_ofNat_of_zero_le h with - | _, ⟨k, rfl⟩ => exact ⟨k, Int.ofNat.inj ae⟩ - -@[simp] theorem natAbs_dvd_natAbs {a b : Int} : natAbs a ∣ natAbs b ↔ a ∣ b := by - refine ⟨fun ⟨k, hk⟩ => ?_, fun ⟨k, hk⟩ => ⟨natAbs k, hk.symm ▸ natAbs_mul a k⟩⟩ - rw [← natAbs_ofNat k, ← natAbs_mul, natAbs_eq_natAbs_iff] at hk - cases hk <;> subst b - · apply Int.dvd_mul_right - · rw [← Int.mul_neg]; apply Int.dvd_mul_right - -theorem ofNat_dvd_left {n : Nat} {z : Int} : (↑n : Int) ∣ z ↔ n ∣ z.natAbs := by - rw [← natAbs_dvd_natAbs, natAbs_ofNat] - -theorem dvd_of_emod_eq_zero {a b : Int} (H : b % a = 0) : a ∣ b := - ⟨b / a, (mul_ediv_cancel_of_emod_eq_zero H).symm⟩ - -theorem dvd_emod_sub_self {x : Int} {m : Nat} : (m : Int) ∣ x % m - x := by - apply dvd_of_emod_eq_zero - simp [sub_emod] - -theorem emod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → b % a = 0 - | _, _, ⟨_, rfl⟩ => mul_emod_right .. - -theorem dvd_iff_emod_eq_zero (a b : Int) : a ∣ b ↔ b % a = 0 := - ⟨emod_eq_zero_of_dvd, dvd_of_emod_eq_zero⟩ - -theorem emod_pos_of_not_dvd {a b : Int} (h : ¬ a ∣ b) : a = 0 ∨ 0 < b % a := by - rw [dvd_iff_emod_eq_zero] at h - if w : a = 0 then simp_all - else exact Or.inr (Int.lt_iff_le_and_ne.mpr ⟨emod_nonneg b w, Ne.symm h⟩) - -instance decidableDvd : DecidableRel (α := Int) (· ∣ ·) := fun _ _ => - decidable_of_decidable_of_iff (dvd_iff_emod_eq_zero ..).symm - -protected theorem ediv_mul_cancel {a b : Int} (H : b ∣ a) : a / b * b = a := - ediv_mul_cancel_of_emod_eq_zero (emod_eq_zero_of_dvd H) - -protected theorem mul_ediv_cancel' {a b : Int} (H : a ∣ b) : a * (b / a) = b := by - rw [Int.mul_comm, Int.ediv_mul_cancel H] - -protected theorem mul_ediv_assoc (a : Int) : ∀ {b c : Int}, c ∣ b → (a * b) / c = a * (b / c) - | _, c, ⟨d, rfl⟩ => - if cz : c = 0 then by simp [cz, Int.mul_zero] else by - rw [Int.mul_left_comm, Int.mul_ediv_cancel_left _ cz, Int.mul_ediv_cancel_left _ cz] - -protected theorem mul_ediv_assoc' (b : Int) {a c : Int} - (h : c ∣ a) : (a * b) / c = a / c * b := by - rw [Int.mul_comm, Int.mul_ediv_assoc _ h, Int.mul_comm] - -theorem neg_ediv_of_dvd : ∀ {a b : Int}, b ∣ a → (-a) / b = -(a / b) - | _, b, ⟨c, rfl⟩ => by if bz : b = 0 then simp [bz] else - rw [Int.neg_mul_eq_mul_neg, Int.mul_ediv_cancel_left _ bz, Int.mul_ediv_cancel_left _ bz] - -theorem sub_ediv_of_dvd (a : Int) {b c : Int} - (hcb : c ∣ b) : (a - b) / c = a / c - b / c := by - rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_ediv_of_dvd_right (Int.dvd_neg.2 hcb)] - congr; exact Int.neg_ediv_of_dvd hcb - -/-! -# `bmod` ("balanced" mod) - -We use balanced mod in the omega algorithm, -to make ±1 coefficients appear in equations without them. --/ - -/-- -Balanced mod, taking values in the range [- m/2, (m - 1)/2]. --/ -def bmod (x : Int) (m : Nat) : Int := - let r := x % m - if r < (m + 1) / 2 then - r - else - r - m - -@[simp] theorem bmod_emod : bmod x m % m = x % m := by - dsimp [bmod] - split <;> simp [Int.sub_emod] diff --git a/Std/Data/Int/Init/Lemmas.lean b/Std/Data/Int/Init/Lemmas.lean deleted file mode 100644 index 8ea82a6871..0000000000 --- a/Std/Data/Int/Init/Lemmas.lean +++ /dev/null @@ -1,506 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro --/ -import Std.Classes.Cast -import Std.Data.Int.Basic -import Std.Tactic.NormCast.Lemmas - -open Nat - -namespace Int - -@[simp] theorem ofNat_eq_coe : ofNat n = Nat.cast n := rfl - -@[simp] theorem ofNat_zero : ((0 : Nat) : Int) = 0 := rfl - -@[simp] theorem ofNat_one : ((1 : Nat) : Int) = 1 := rfl - -theorem ofNat_two : ((2 : Nat) : Int) = 2 := rfl - -@[simp] theorem default_eq_zero : default = (0 : Int) := rfl - -protected theorem zero_ne_one : (0 : Int) ≠ 1 := nofun - -/- ## Definitions of basic functions -/ - -theorem subNatNat_of_sub_eq_zero {m n : Nat} (h : n - m = 0) : subNatNat m n = ↑(m - n) := by - rw [subNatNat, h, ofNat_eq_coe] - -theorem subNatNat_of_sub_eq_succ {m n k : Nat} (h : n - m = succ k) : subNatNat m n = -[k+1] := by - rw [subNatNat, h] - -@[simp] protected theorem neg_zero : -(0:Int) = 0 := rfl - -@[norm_cast] theorem ofNat_add (n m : Nat) : (↑(n + m) : Int) = n + m := rfl -@[norm_cast] theorem ofNat_mul (n m : Nat) : (↑(n * m) : Int) = n * m := rfl -theorem ofNat_succ (n : Nat) : (succ n : Int) = n + 1 := rfl - -@[local simp] theorem neg_ofNat_zero : -((0 : Nat) : Int) = 0 := rfl -@[local simp] theorem neg_ofNat_succ (n : Nat) : -(succ n : Int) = -[n+1] := rfl -@[local simp] theorem neg_negSucc (n : Nat) : -(-[n+1]) = succ n := rfl - -theorem negSucc_coe (n : Nat) : -[n+1] = -↑(n + 1) := rfl - -theorem negOfNat_eq : negOfNat n = -ofNat n := rfl - -/- ## These are only for internal use -/ - -@[simp] theorem add_def {a b : Int} : Int.add a b = a + b := rfl - -@[local simp] theorem ofNat_add_ofNat (m n : Nat) : (↑m + ↑n : Int) = ↑(m + n) := rfl -@[local simp] theorem ofNat_add_negSucc (m n : Nat) : ↑m + -[n+1] = subNatNat m (succ n) := rfl -@[local simp] theorem negSucc_add_ofNat (m n : Nat) : -[m+1] + ↑n = subNatNat n (succ m) := rfl -@[local simp] theorem negSucc_add_negSucc (m n : Nat) : -[m+1] + -[n+1] = -[succ (m + n) +1] := rfl - -@[simp] theorem mul_def {a b : Int} : Int.mul a b = a * b := rfl - -@[local simp] theorem ofNat_mul_ofNat (m n : Nat) : (↑m * ↑n : Int) = ↑(m * n) := rfl -@[local simp] theorem ofNat_mul_negSucc' (m n : Nat) : ↑m * -[n+1] = negOfNat (m * succ n) := rfl -@[local simp] theorem negSucc_mul_ofNat' (m n : Nat) : -[m+1] * ↑n = negOfNat (succ m * n) := rfl -@[local simp] theorem negSucc_mul_negSucc' (m n : Nat) : - -[m+1] * -[n+1] = ofNat (succ m * succ n) := rfl - -/- ## some basic functions and properties -/ - -@[norm_cast] theorem ofNat_inj : ((m : Nat) : Int) = (n : Nat) ↔ m = n := ⟨ofNat.inj, congrArg _⟩ - -theorem ofNat_eq_zero : ((n : Nat) : Int) = 0 ↔ n = 0 := ofNat_inj - -theorem ofNat_ne_zero : ((n : Nat) : Int) ≠ 0 ↔ n ≠ 0 := not_congr ofNat_eq_zero - -theorem negSucc_inj : negSucc m = negSucc n ↔ m = n := ⟨negSucc.inj, fun H => by simp [H]⟩ - -theorem negSucc_eq (n : Nat) : -[n+1] = -((n : Int) + 1) := rfl - -@[simp] theorem negSucc_ne_zero (n : Nat) : -[n+1] ≠ 0 := nofun - -@[simp] theorem zero_ne_negSucc (n : Nat) : 0 ≠ -[n+1] := nofun - -@[simp, norm_cast] theorem Nat.cast_ofNat_Int : - (Nat.cast (no_index (OfNat.ofNat n)) : Int) = OfNat.ofNat n := rfl - -/- ## neg -/ - -@[simp] protected theorem neg_neg : ∀ a : Int, -(-a) = a - | 0 => rfl - | succ _ => rfl - | -[_+1] => rfl - -protected theorem neg_inj {a b : Int} : -a = -b ↔ a = b := - ⟨fun h => by rw [← Int.neg_neg a, ← Int.neg_neg b, h], congrArg _⟩ - -@[simp] protected theorem neg_eq_zero : -a = 0 ↔ a = 0 := Int.neg_inj (b := 0) - -protected theorem neg_ne_zero : -a ≠ 0 ↔ a ≠ 0 := not_congr Int.neg_eq_zero - -protected theorem sub_eq_add_neg {a b : Int} : a - b = a + -b := rfl - -theorem add_neg_one (i : Int) : i + -1 = i - 1 := rfl - -/- ## basic properties of subNatNat -/ - --- @[elabAsElim] -- TODO(Mario): unexpected eliminator resulting type -theorem subNatNat_elim (m n : Nat) (motive : Nat → Nat → Int → Prop) - (hp : ∀ i n, motive (n + i) n i) - (hn : ∀ i m, motive m (m + i + 1) -[i+1]) : - motive m n (subNatNat m n) := by - unfold subNatNat - match h : n - m with - | 0 => - have ⟨k, h⟩ := Nat.le.dest (Nat.le_of_sub_eq_zero h) - rw [h.symm, Nat.add_sub_cancel_left]; apply hp - | succ k => - rw [Nat.sub_eq_iff_eq_add (Nat.le_of_lt (Nat.lt_of_sub_eq_succ h))] at h - rw [h, Nat.add_comm]; apply hn - -theorem subNatNat_add_left : subNatNat (m + n) m = n := by - unfold subNatNat - rw [Nat.sub_eq_zero_of_le (Nat.le_add_right ..), Nat.add_sub_cancel_left, ofNat_eq_coe] - -theorem subNatNat_add_right : subNatNat m (m + n + 1) = negSucc n := by - simp [subNatNat, Nat.add_assoc, Nat.add_sub_cancel_left] - -theorem subNatNat_add_add (m n k : Nat) : subNatNat (m + k) (n + k) = subNatNat m n := by - apply subNatNat_elim m n (fun m n i => subNatNat (m + k) (n + k) = i) - · intro i j - rw [Nat.add_assoc, Nat.add_comm i k, ← Nat.add_assoc] - exact subNatNat_add_left - · intro i j - rw [Nat.add_assoc j i 1, Nat.add_comm j (i+1), Nat.add_assoc, Nat.add_comm (i+1) (j+k)] - exact subNatNat_add_right - -theorem subNatNat_of_le {m n : Nat} (h : n ≤ m) : subNatNat m n = ↑(m - n) := - subNatNat_of_sub_eq_zero (Nat.sub_eq_zero_of_le h) - -theorem subNatNat_of_lt {m n : Nat} (h : m < n) : subNatNat m n = -[pred (n - m) +1] := - subNatNat_of_sub_eq_succ <| (Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)).symm - - -/- # Additive group properties -/ - -/- addition -/ - -protected theorem add_comm : ∀ a b : Int, a + b = b + a - | ofNat n, ofNat m => by simp [Nat.add_comm] - | ofNat _, -[_+1] => rfl - | -[_+1], ofNat _ => rfl - | -[_+1], -[_+1] => by simp [Nat.add_comm] - -@[simp] protected theorem add_zero : ∀ a : Int, a + 0 = a - | ofNat _ => rfl - | -[_+1] => rfl - -@[simp] protected theorem zero_add (a : Int) : 0 + a = a := Int.add_comm .. ▸ a.add_zero - -theorem ofNat_add_negSucc_of_lt (h : m < n.succ) : ofNat m + -[n+1] = -[n - m+1] := - show subNatNat .. = _ by simp [succ_sub (le_of_lt_succ h), subNatNat] - -theorem subNatNat_sub (h : n ≤ m) (k : Nat) : subNatNat (m - n) k = subNatNat m (k + n) := by - rwa [← subNatNat_add_add _ _ n, Nat.sub_add_cancel] - -theorem subNatNat_add (m n k : Nat) : subNatNat (m + n) k = m + subNatNat n k := by - cases n.lt_or_ge k with - | inl h' => - simp [subNatNat_of_lt h', succ_pred_eq_of_pos (Nat.sub_pos_of_lt h')] - conv => lhs; rw [← Nat.sub_add_cancel (Nat.le_of_lt h')] - apply subNatNat_add_add - | inr h' => simp [subNatNat_of_le h', - subNatNat_of_le (Nat.le_trans h' (le_add_left ..)), Nat.add_sub_assoc h'] - -theorem subNatNat_add_negSucc (m n k : Nat) : - subNatNat m n + -[k+1] = subNatNat m (n + succ k) := by - have h := Nat.lt_or_ge m n - cases h with - | inr h' => - rw [subNatNat_of_le h'] - simp - rw [subNatNat_sub h', Nat.add_comm] - | inl h' => - have h₂ : m < n + succ k := Nat.lt_of_lt_of_le h' (le_add_right _ _) - have h₃ : m ≤ n + k := le_of_succ_le_succ h₂ - rw [subNatNat_of_lt h', subNatNat_of_lt h₂] - simp [Nat.add_comm] - rw [← add_succ, succ_pred_eq_of_pos (Nat.sub_pos_of_lt h'), add_succ, succ_sub h₃, - Nat.pred_succ] - rw [Nat.add_comm n, Nat.add_sub_assoc (Nat.le_of_lt h')] - -protected theorem add_assoc : ∀ a b c : Int, a + b + c = a + (b + c) - | (m:Nat), (n:Nat), c => aux1 .. - | Nat.cast m, b, Nat.cast k => by - rw [Int.add_comm, ← aux1, Int.add_comm k, aux1, Int.add_comm b] - | a, (n:Nat), (k:Nat) => by - rw [Int.add_comm, Int.add_comm a, ← aux1, Int.add_comm a, Int.add_comm k] - | -[m+1], -[n+1], (k:Nat) => aux2 .. - | -[m+1], (n:Nat), -[k+1] => by - rw [Int.add_comm, ← aux2, Int.add_comm n, ← aux2, Int.add_comm -[m+1]] - | (m:Nat), -[n+1], -[k+1] => by - rw [Int.add_comm, Int.add_comm m, Int.add_comm m, ← aux2, Int.add_comm -[k+1]] - | -[m+1], -[n+1], -[k+1] => by - simp [add_succ, Nat.add_comm, Nat.add_left_comm, neg_ofNat_succ] -where - aux1 (m n : Nat) : ∀ c : Int, m + n + c = m + (n + c) - | (k:Nat) => by simp [Nat.add_assoc] - | -[k+1] => by simp [subNatNat_add] - aux2 (m n k : Nat) : -[m+1] + -[n+1] + k = -[m+1] + (-[n+1] + k) := by - simp [add_succ] - rw [Int.add_comm, subNatNat_add_negSucc] - simp [add_succ, succ_add, Nat.add_comm] - -protected theorem add_left_comm (a b c : Int) : a + (b + c) = b + (a + c) := by - rw [← Int.add_assoc, Int.add_comm a, Int.add_assoc] - -protected theorem add_right_comm (a b c : Int) : a + b + c = a + c + b := by - rw [Int.add_assoc, Int.add_comm b, ← Int.add_assoc] - -/- ## negation -/ - -theorem subNatNat_self : ∀ n, subNatNat n n = 0 - | 0 => rfl - | succ m => by rw [subNatNat_of_sub_eq_zero (Nat.sub_self ..), Nat.sub_self, ofNat_zero] - -attribute [local simp] subNatNat_self - -@[local simp] protected theorem add_left_neg : ∀ a : Int, -a + a = 0 - | 0 => rfl - | succ m => by simp - | -[m+1] => by simp - -@[local simp] protected theorem add_right_neg (a : Int) : a + -a = 0 := by - rw [Int.add_comm, Int.add_left_neg] - -@[simp] protected theorem neg_eq_of_add_eq_zero {a b : Int} (h : a + b = 0) : -a = b := by - rw [← Int.add_zero (-a), ← h, ← Int.add_assoc, Int.add_left_neg, Int.zero_add] - -protected theorem eq_neg_of_eq_neg {a b : Int} (h : a = -b) : b = -a := by - rw [h, Int.neg_neg] - -protected theorem eq_neg_comm {a b : Int} : a = -b ↔ b = -a := - ⟨Int.eq_neg_of_eq_neg, Int.eq_neg_of_eq_neg⟩ - -protected theorem neg_eq_comm {a b : Int} : -a = b ↔ -b = a := by - rw [eq_comm, Int.eq_neg_comm, eq_comm] - -protected theorem neg_add_cancel_left (a b : Int) : -a + (a + b) = b := by - rw [← Int.add_assoc, Int.add_left_neg, Int.zero_add] - -protected theorem add_neg_cancel_left (a b : Int) : a + (-a + b) = b := by - rw [← Int.add_assoc, Int.add_right_neg, Int.zero_add] - -protected theorem add_neg_cancel_right (a b : Int) : a + b + -b = a := by - rw [Int.add_assoc, Int.add_right_neg, Int.add_zero] - -protected theorem neg_add_cancel_right (a b : Int) : a + -b + b = a := by - rw [Int.add_assoc, Int.add_left_neg, Int.add_zero] - -protected theorem add_left_cancel {a b c : Int} (h : a + b = a + c) : b = c := by - have h₁ : -a + (a + b) = -a + (a + c) := by rw [h] - simp [← Int.add_assoc, Int.add_left_neg, Int.zero_add] at h₁; exact h₁ - -@[local simp] protected theorem neg_add {a b : Int} : -(a + b) = -a + -b := by - apply Int.add_left_cancel (a := a + b) - rw [Int.add_right_neg, Int.add_comm a, ← Int.add_assoc, Int.add_assoc b, - Int.add_right_neg, Int.add_zero, Int.add_right_neg] - -/- ## subtraction -/ - -@[simp] theorem negSucc_sub_one (n : Nat) : -[n+1] - 1 = -[n + 1 +1] := rfl - -@[simp] protected theorem sub_self (a : Int) : a - a = 0 := by - rw [Int.sub_eq_add_neg, Int.add_right_neg] - -@[simp] protected theorem sub_zero (a : Int) : a - 0 = a := by simp [Int.sub_eq_add_neg] - -@[simp] protected theorem zero_sub (a : Int) : 0 - a = -a := by simp [Int.sub_eq_add_neg] - -protected theorem sub_eq_zero_of_eq {a b : Int} (h : a = b) : a - b = 0 := by - rw [h, Int.sub_self] - -protected theorem eq_of_sub_eq_zero {a b : Int} (h : a - b = 0) : a = b := by - have : 0 + b = b := by rw [Int.zero_add] - have : a - b + b = b := by rwa [h] - rwa [Int.sub_eq_add_neg, Int.neg_add_cancel_right] at this - -protected theorem sub_eq_zero {a b : Int} : a - b = 0 ↔ a = b := - ⟨Int.eq_of_sub_eq_zero, Int.sub_eq_zero_of_eq⟩ - -protected theorem sub_sub (a b c : Int) : a - b - c = a - (b + c) := by - simp [Int.sub_eq_add_neg, Int.add_assoc] - -protected theorem neg_sub (a b : Int) : -(a - b) = b - a := by - simp [Int.sub_eq_add_neg, Int.add_comm] - -protected theorem sub_sub_self (a b : Int) : a - (a - b) = b := by - simp [Int.sub_eq_add_neg, ← Int.add_assoc] - -protected theorem sub_neg (a b : Int) : a - -b = a + b := by simp [Int.sub_eq_add_neg] - -@[simp] protected theorem sub_add_cancel (a b : Int) : a - b + b = a := - Int.neg_add_cancel_right a b - -@[simp] protected theorem add_sub_cancel (a b : Int) : a + b - b = a := - Int.add_neg_cancel_right a b - -protected theorem add_sub_assoc (a b c : Int) : a + b - c = a + (b - c) := by - rw [Int.sub_eq_add_neg, Int.add_assoc, ← Int.sub_eq_add_neg] - -@[norm_cast] theorem ofNat_sub (h : m ≤ n) : ((n - m : Nat) : Int) = n - m := by - match m with - | 0 => rfl - | succ m => - show ofNat (n - succ m) = subNatNat n (succ m) - rw [subNatNat, Nat.sub_eq_zero_of_le h] - -theorem negSucc_coe' (n : Nat) : -[n+1] = -↑n - 1 := by - rw [Int.sub_eq_add_neg, ← Int.neg_add]; rfl - -protected theorem subNatNat_eq_coe {m n : Nat} : subNatNat m n = ↑m - ↑n := by - apply subNatNat_elim m n fun m n i => i = m - n - · intros i n - rw [Int.ofNat_add, Int.sub_eq_add_neg, Int.add_assoc, Int.add_left_comm, - Int.add_right_neg, Int.add_zero] - · intros i n - simp only [negSucc_coe, ofNat_add, Int.sub_eq_add_neg, Int.neg_add, ← Int.add_assoc] - rw [← @Int.sub_eq_add_neg n, ← ofNat_sub, Nat.sub_self, ofNat_zero, Int.zero_add] - apply Nat.le_refl - -theorem toNat_sub (m n : Nat) : toNat (m - n) = m - n := by - rw [← Int.subNatNat_eq_coe] - refine subNatNat_elim m n (fun m n i => toNat i = m - n) (fun i n => ?_) (fun i n => ?_) - · exact (Nat.add_sub_cancel_left ..).symm - · dsimp; rw [Nat.add_assoc, Nat.sub_eq_zero_of_le (Nat.le_add_right ..)]; rfl - -/- ## Ring properties -/ - -@[simp] theorem ofNat_mul_negSucc (m n : Nat) : (m : Int) * -[n+1] = -↑(m * succ n) := rfl - -@[simp] theorem negSucc_mul_ofNat (m n : Nat) : -[m+1] * n = -↑(succ m * n) := rfl - -@[simp] theorem negSucc_mul_negSucc (m n : Nat) : -[m+1] * -[n+1] = succ m * succ n := rfl - -protected theorem mul_comm (a b : Int) : a * b = b * a := by - cases a <;> cases b <;> simp [Nat.mul_comm] - -theorem ofNat_mul_negOfNat (m n : Nat) : (m : Nat) * negOfNat n = negOfNat (m * n) := by - cases n <;> rfl - -theorem negOfNat_mul_ofNat (m n : Nat) : negOfNat m * (n : Nat) = negOfNat (m * n) := by - rw [Int.mul_comm]; simp [ofNat_mul_negOfNat, Nat.mul_comm] - -theorem negSucc_mul_negOfNat (m n : Nat) : -[m+1] * negOfNat n = ofNat (succ m * n) := by - cases n <;> rfl - -theorem negOfNat_mul_negSucc (m n : Nat) : negOfNat n * -[m+1] = ofNat (n * succ m) := by - rw [Int.mul_comm, negSucc_mul_negOfNat, Nat.mul_comm] - -attribute [local simp] ofNat_mul_negOfNat negOfNat_mul_ofNat - negSucc_mul_negOfNat negOfNat_mul_negSucc - -protected theorem mul_assoc (a b c : Int) : a * b * c = a * (b * c) := by - cases a <;> cases b <;> cases c <;> simp [Nat.mul_assoc] - -protected theorem mul_left_comm (a b c : Int) : a * (b * c) = b * (a * c) := by - rw [← Int.mul_assoc, ← Int.mul_assoc, Int.mul_comm a] - -protected theorem mul_right_comm (a b c : Int) : a * b * c = a * c * b := by - rw [Int.mul_assoc, Int.mul_assoc, Int.mul_comm b] - -@[simp] protected theorem mul_zero (a : Int) : a * 0 = 0 := by cases a <;> rfl - -@[simp] protected theorem zero_mul (a : Int) : 0 * a = 0 := Int.mul_comm .. ▸ a.mul_zero - -theorem negOfNat_eq_subNatNat_zero (n) : negOfNat n = subNatNat 0 n := by cases n <;> rfl - -theorem ofNat_mul_subNatNat (m n k : Nat) : - m * subNatNat n k = subNatNat (m * n) (m * k) := by - cases m with - | zero => simp [ofNat_zero, Int.zero_mul, Nat.zero_mul] - | succ m => cases n.lt_or_ge k with - | inl h => - have h' : succ m * n < succ m * k := Nat.mul_lt_mul_of_pos_left h (Nat.succ_pos m) - simp [subNatNat_of_lt h, subNatNat_of_lt h'] - rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h), ← neg_ofNat_succ, Nat.mul_sub_left_distrib, - ← succ_pred_eq_of_pos (Nat.sub_pos_of_lt h')]; rfl - | inr h => - have h' : succ m * k ≤ succ m * n := Nat.mul_le_mul_left _ h - simp [subNatNat_of_le h, subNatNat_of_le h', Nat.mul_sub_left_distrib] - -theorem negOfNat_add (m n : Nat) : negOfNat m + negOfNat n = negOfNat (m + n) := by - cases m <;> cases n <;> simp [Nat.succ_add] <;> rfl - -theorem negSucc_mul_subNatNat (m n k : Nat) : - -[m+1] * subNatNat n k = subNatNat (succ m * k) (succ m * n) := by - cases n.lt_or_ge k with - | inl h => - have h' : succ m * n < succ m * k := Nat.mul_lt_mul_of_pos_left h (Nat.succ_pos m) - rw [subNatNat_of_lt h, subNatNat_of_le (Nat.le_of_lt h')] - simp [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h), Nat.mul_sub_left_distrib] - | inr h => cases Nat.lt_or_ge k n with - | inl h' => - have h₁ : succ m * n > succ m * k := Nat.mul_lt_mul_of_pos_left h' (Nat.succ_pos m) - rw [subNatNat_of_le h, subNatNat_of_lt h₁, negSucc_mul_ofNat, - Nat.mul_sub_left_distrib, ← succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁)]; rfl - | inr h' => rw [Nat.le_antisymm h h', subNatNat_self, subNatNat_self, Int.mul_zero] - -attribute [local simp] ofNat_mul_subNatNat negOfNat_add negSucc_mul_subNatNat - -protected theorem mul_add : ∀ a b c : Int, a * (b + c) = a * b + a * c - | (m:Nat), (n:Nat), (k:Nat) => by simp [Nat.left_distrib] - | (m:Nat), (n:Nat), -[k+1] => by - simp [negOfNat_eq_subNatNat_zero]; rw [← subNatNat_add]; rfl - | (m:Nat), -[n+1], (k:Nat) => by - simp [negOfNat_eq_subNatNat_zero]; rw [Int.add_comm, ← subNatNat_add]; rfl - | (m:Nat), -[n+1], -[k+1] => by simp; rw [← Nat.left_distrib, succ_add]; rfl - | -[m+1], (n:Nat), (k:Nat) => by simp [Nat.mul_comm]; rw [← Nat.right_distrib, Nat.mul_comm] - | -[m+1], (n:Nat), -[k+1] => by - simp [negOfNat_eq_subNatNat_zero]; rw [Int.add_comm, ← subNatNat_add]; rfl - | -[m+1], -[n+1], (k:Nat) => by simp [negOfNat_eq_subNatNat_zero]; rw [← subNatNat_add]; rfl - | -[m+1], -[n+1], -[k+1] => by simp; rw [← Nat.left_distrib, succ_add]; rfl - -protected theorem add_mul (a b c : Int) : (a + b) * c = a * c + b * c := by - simp [Int.mul_comm, Int.mul_add] - -protected theorem neg_mul_eq_neg_mul (a b : Int) : -(a * b) = -a * b := - Int.neg_eq_of_add_eq_zero <| by rw [← Int.add_mul, Int.add_right_neg, Int.zero_mul] - -protected theorem neg_mul_eq_mul_neg (a b : Int) : -(a * b) = a * -b := - Int.neg_eq_of_add_eq_zero <| by rw [← Int.mul_add, Int.add_right_neg, Int.mul_zero] - -@[local simp] protected theorem neg_mul (a b : Int) : -a * b = -(a * b) := - (Int.neg_mul_eq_neg_mul a b).symm - -@[local simp] protected theorem mul_neg (a b : Int) : a * -b = -(a * b) := - (Int.neg_mul_eq_mul_neg a b).symm - -protected theorem neg_mul_neg (a b : Int) : -a * -b = a * b := by simp - -protected theorem neg_mul_comm (a b : Int) : -a * b = a * -b := by simp - -protected theorem mul_sub (a b c : Int) : a * (b - c) = a * b - a * c := by - simp [Int.sub_eq_add_neg, Int.mul_add] - -protected theorem sub_mul (a b c : Int) : (a - b) * c = a * c - b * c := by - simp [Int.sub_eq_add_neg, Int.add_mul] - -@[simp] protected theorem one_mul : ∀ a : Int, 1 * a = a - | ofNat n => show ofNat (1 * n) = ofNat n by rw [Nat.one_mul] - | -[n+1] => show -[1 * n +1] = -[n+1] by rw [Nat.one_mul] - -@[simp] protected theorem mul_one (a : Int) : a * 1 = a := by rw [Int.mul_comm, Int.one_mul] - -protected theorem mul_neg_one (a : Int) : a * -1 = -a := by rw [Int.mul_neg, Int.mul_one] - -protected theorem neg_eq_neg_one_mul : ∀ a : Int, -a = -1 * a - | 0 => rfl - | succ n => show _ = -[1 * n +1] by rw [Nat.one_mul]; rfl - | -[n+1] => show _ = ofNat _ by rw [Nat.one_mul]; rfl - -protected theorem mul_eq_zero {a b : Int} : a * b = 0 ↔ a = 0 ∨ b = 0 := by - refine ⟨fun h => ?_, fun h => h.elim (by simp [·, Int.zero_mul]) (by simp [·, Int.mul_zero])⟩ - exact match a, b, h with - | .ofNat 0, _, _ => by simp - | _, .ofNat 0, _ => by simp - | .ofNat (a+1), .negSucc b, h => by cases h - -protected theorem mul_ne_zero {a b : Int} (a0 : a ≠ 0) (b0 : b ≠ 0) : a * b ≠ 0 := - mt Int.mul_eq_zero.1 <| not_or.2 ⟨a0, b0⟩ - -protected theorem eq_of_mul_eq_mul_right {a b c : Int} (ha : a ≠ 0) (h : b * a = c * a) : b = c := - have : (b - c) * a = 0 := by rwa [Int.sub_mul, Int.sub_eq_zero] - Int.sub_eq_zero.1 <| (Int.mul_eq_zero.1 this).resolve_right ha - -protected theorem eq_of_mul_eq_mul_left {a b c : Int} (ha : a ≠ 0) (h : a * b = a * c) : b = c := - have : a * b - a * c = 0 := Int.sub_eq_zero_of_eq h - have : a * (b - c) = 0 := by rw [Int.mul_sub, this] - have : b - c = 0 := (Int.mul_eq_zero.1 this).resolve_left ha - Int.eq_of_sub_eq_zero this - -theorem mul_eq_mul_left_iff {a b c : Int} (h : c ≠ 0) : c * a = c * b ↔ a = b := - ⟨Int.eq_of_mul_eq_mul_left h, fun w => congrArg (fun x => c * x) w⟩ - -theorem mul_eq_mul_right_iff {a b c : Int} (h : c ≠ 0) : a * c = b * c ↔ a = b := - ⟨Int.eq_of_mul_eq_mul_right h, fun w => congrArg (fun x => x * c) w⟩ - -theorem eq_one_of_mul_eq_self_left {a b : Int} (Hpos : a ≠ 0) (H : b * a = a) : b = 1 := - Int.eq_of_mul_eq_mul_right Hpos <| by rw [Int.one_mul, H] - -theorem eq_one_of_mul_eq_self_right {a b : Int} (Hpos : b ≠ 0) (H : b * a = b) : a = 1 := - Int.eq_of_mul_eq_mul_left Hpos <| by rw [Int.mul_one, H] - -/-! -The following lemmas are later subsumed by e.g. `Nat.cast_add` and `Nat.cast_mul` in Mathlib -but it is convenient to have these earlier, for users who only need `Nat` and `Int`. --/ - -theorem natCast_zero : ((0 : Nat) : Int) = (0 : Int) := rfl - -theorem natCast_one : ((1 : Nat) : Int) = (1 : Int) := rfl - -@[simp] theorem natCast_add (a b : Nat) : ((a + b : Nat) : Int) = (a : Int) + (b : Int) := by - -- Note this only works because of local simp attributes in this file, - -- so it still makes sense to tag the lemmas with `@[simp]`. - simp - -@[simp] theorem natCast_mul (a b : Nat) : ((a * b : Nat) : Int) = (a : Int) * (b : Int) := by - simp diff --git a/Std/Data/Int/Init/Order.lean b/Std/Data/Int/Init/Order.lean deleted file mode 100644 index d2902119bb..0000000000 --- a/Std/Data/Int/Init/Order.lean +++ /dev/null @@ -1,434 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro --/ -import Std.Data.Int.Init.Lemmas -import Std.Tactic.Alias - -/-! -# Results about the order properties of the integers, and the integers as an ordered ring. --/ - -open Nat - -namespace Int - -/-! ## Order properties of the integers -/ - -theorem nonneg_def {a : Int} : NonNeg a ↔ ∃ n : Nat, a = n := - ⟨fun ⟨n⟩ => ⟨n, rfl⟩, fun h => match a, h with | _, ⟨n, rfl⟩ => ⟨n⟩⟩ - -theorem NonNeg.elim {a : Int} : NonNeg a → ∃ n : Nat, a = n := nonneg_def.1 - -theorem nonneg_or_nonneg_neg : ∀ (a : Int), NonNeg a ∨ NonNeg (-a) - | (_:Nat) => .inl ⟨_⟩ - | -[_+1] => .inr ⟨_⟩ - -theorem le_def (a b : Int) : a ≤ b ↔ NonNeg (b - a) := .rfl - -theorem lt_iff_add_one_le (a b : Int) : a < b ↔ a + 1 ≤ b := .rfl - -theorem le.intro_sub {a b : Int} (n : Nat) (h : b - a = n) : a ≤ b := by - simp [le_def, h]; constructor - -attribute [local simp] Int.add_left_neg Int.add_right_neg Int.neg_add - -theorem le.intro {a b : Int} (n : Nat) (h : a + n = b) : a ≤ b := - le.intro_sub n <| by rw [← h, Int.add_comm]; simp [Int.sub_eq_add_neg, Int.add_assoc] - -theorem le.dest_sub {a b : Int} (h : a ≤ b) : ∃ n : Nat, b - a = n := nonneg_def.1 h - -theorem le.dest {a b : Int} (h : a ≤ b) : ∃ n : Nat, a + n = b := - let ⟨n, h₁⟩ := le.dest_sub h - ⟨n, by rw [← h₁, Int.add_comm]; simp [Int.sub_eq_add_neg, Int.add_assoc]⟩ - -protected theorem le_total (a b : Int) : a ≤ b ∨ b ≤ a := - (nonneg_or_nonneg_neg (b - a)).imp_right fun H => by - rwa [show -(b - a) = a - b by simp [Int.add_comm, Int.sub_eq_add_neg]] at H - -@[simp, norm_cast] theorem ofNat_le {m n : Nat} : (↑m : Int) ≤ ↑n ↔ m ≤ n := - ⟨fun h => - let ⟨k, hk⟩ := le.dest h - Nat.le.intro <| Int.ofNat.inj <| (Int.ofNat_add m k).trans hk, - fun h => - let ⟨k, (hk : m + k = n)⟩ := Nat.le.dest h - le.intro k (by rw [← hk]; rfl)⟩ - -theorem ofNat_zero_le (n : Nat) : 0 ≤ (↑n : Int) := ofNat_le.2 n.zero_le - -theorem eq_ofNat_of_zero_le {a : Int} (h : 0 ≤ a) : ∃ n : Nat, a = n := by - have t := le.dest_sub h; rwa [Int.sub_zero] at t - -theorem eq_succ_of_zero_lt {a : Int} (h : 0 < a) : ∃ n : Nat, a = n.succ := - let ⟨n, (h : ↑(1 + n) = a)⟩ := le.dest h - ⟨n, by rw [Nat.add_comm] at h; exact h.symm⟩ - -theorem lt_add_succ (a : Int) (n : Nat) : a < a + Nat.succ n := - le.intro n <| by rw [Int.add_comm, Int.add_left_comm]; rfl - -theorem lt.intro {a b : Int} {n : Nat} (h : a + Nat.succ n = b) : a < b := - h ▸ lt_add_succ a n - -theorem lt.dest {a b : Int} (h : a < b) : ∃ n : Nat, a + Nat.succ n = b := - let ⟨n, h⟩ := le.dest h; ⟨n, by rwa [Int.add_comm, Int.add_left_comm] at h⟩ - -@[simp, norm_cast] theorem ofNat_lt {n m : Nat} : (↑n : Int) < ↑m ↔ n < m := by - rw [lt_iff_add_one_le, ← ofNat_succ, ofNat_le]; rfl - -@[simp, norm_cast] theorem ofNat_pos {n : Nat} : 0 < (↑n : Int) ↔ 0 < n := ofNat_lt - -theorem ofNat_nonneg (n : Nat) : 0 ≤ (n : Int) := ⟨_⟩ - -theorem ofNat_succ_pos (n : Nat) : 0 < (succ n : Int) := ofNat_lt.2 <| Nat.succ_pos _ - -@[simp] protected theorem le_refl (a : Int) : a ≤ a := - le.intro _ (Int.add_zero a) - -protected theorem le_trans {a b c : Int} (h₁ : a ≤ b) (h₂ : b ≤ c) : a ≤ c := - let ⟨n, hn⟩ := le.dest h₁; let ⟨m, hm⟩ := le.dest h₂ - le.intro (n + m) <| by rw [← hm, ← hn, Int.add_assoc, ofNat_add] - -protected theorem le_antisymm {a b : Int} (h₁ : a ≤ b) (h₂ : b ≤ a) : a = b := by - let ⟨n, hn⟩ := le.dest h₁; let ⟨m, hm⟩ := le.dest h₂ - have := hn; rw [← hm, Int.add_assoc, ← ofNat_add] at this - have := Int.ofNat.inj <| Int.add_left_cancel <| this.trans (Int.add_zero _).symm - rw [← hn, Nat.eq_zero_of_add_eq_zero_left this, ofNat_zero, Int.add_zero a] - -protected theorem lt_irrefl (a : Int) : ¬a < a := fun H => - let ⟨n, hn⟩ := lt.dest H - have : (a+Nat.succ n) = a+0 := by - rw [hn, Int.add_zero] - have : Nat.succ n = 0 := Int.ofNat.inj (Int.add_left_cancel this) - show False from Nat.succ_ne_zero _ this - -protected theorem ne_of_lt {a b : Int} (h : a < b) : a ≠ b := fun e => by - cases e; exact Int.lt_irrefl _ h - -protected theorem ne_of_gt {a b : Int} (h : b < a) : a ≠ b := (Int.ne_of_lt h).symm - -protected theorem le_of_lt {a b : Int} (h : a < b) : a ≤ b := - let ⟨_, hn⟩ := lt.dest h; le.intro _ hn - -protected theorem lt_iff_le_and_ne {a b : Int} : a < b ↔ a ≤ b ∧ a ≠ b := by - refine ⟨fun h => ⟨Int.le_of_lt h, Int.ne_of_lt h⟩, fun ⟨aleb, aneb⟩ => ?_⟩ - let ⟨n, hn⟩ := le.dest aleb - have : n ≠ 0 := aneb.imp fun eq => by rw [← hn, eq, ofNat_zero, Int.add_zero] - apply lt.intro; rwa [← Nat.succ_pred_eq_of_pos (Nat.pos_of_ne_zero this)] at hn - -theorem lt_succ (a : Int) : a < a + 1 := Int.le_refl _ - -protected theorem zero_lt_one : (0 : Int) < 1 := ⟨_⟩ - -protected theorem lt_iff_le_not_le {a b : Int} : a < b ↔ a ≤ b ∧ ¬b ≤ a := by - rw [Int.lt_iff_le_and_ne] - constructor <;> refine fun ⟨h, h'⟩ => ⟨h, h'.imp fun h' => ?_⟩ - · exact Int.le_antisymm h h' - · subst h'; apply Int.le_refl - -protected theorem not_le {a b : Int} : ¬a ≤ b ↔ b < a := - ⟨fun h => Int.lt_iff_le_not_le.2 ⟨(Int.le_total ..).resolve_right h, h⟩, - fun h => (Int.lt_iff_le_not_le.1 h).2⟩ - -protected theorem not_lt {a b : Int} : ¬a < b ↔ b ≤ a := - by rw [← Int.not_le, Decidable.not_not] - -protected theorem lt_trichotomy (a b : Int) : a < b ∨ a = b ∨ b < a := - if eq : a = b then .inr <| .inl eq else - if le : a ≤ b then .inl <| Int.lt_iff_le_and_ne.2 ⟨le, eq⟩ else - .inr <| .inr <| Int.not_le.1 le - -protected theorem ne_iff_lt_or_gt {a b : Int} : a ≠ b ↔ a < b ∨ b < a := by - constructor - · intro h - cases Int.lt_trichotomy a b - case inl lt => exact Or.inl lt - case inr h => - cases h - case inl =>simp_all - case inr gt => exact Or.inr gt - · intro h - cases h - case inl lt => exact Int.ne_of_lt lt - case inr gt => exact Int.ne_of_gt gt - -protected alias ⟨lt_or_gt_of_ne, _⟩ := Int.ne_iff_lt_or_gt - -protected theorem eq_iff_le_and_ge {x y : Int} : x = y ↔ x ≤ y ∧ y ≤ x := by - constructor - · simp_all - · intro ⟨h₁, h₂⟩ - exact Int.le_antisymm h₁ h₂ - -protected theorem lt_of_le_of_lt {a b c : Int} (h₁ : a ≤ b) (h₂ : b < c) : a < c := - Int.not_le.1 fun h => Int.not_le.2 h₂ (Int.le_trans h h₁) - -protected theorem lt_of_lt_of_le {a b c : Int} (h₁ : a < b) (h₂ : b ≤ c) : a < c := - Int.not_le.1 fun h => Int.not_le.2 h₁ (Int.le_trans h₂ h) - -protected theorem lt_trans {a b c : Int} (h₁ : a < b) (h₂ : b < c) : a < c := - Int.lt_of_le_of_lt (Int.le_of_lt h₁) h₂ - -instance : Trans (α := Int) (· ≤ ·) (· ≤ ·) (· ≤ ·) := ⟨Int.le_trans⟩ - -instance : Trans (α := Int) (· < ·) (· ≤ ·) (· < ·) := ⟨Int.lt_of_lt_of_le⟩ - -instance : Trans (α := Int) (· ≤ ·) (· < ·) (· < ·) := ⟨Int.lt_of_le_of_lt⟩ - -instance : Trans (α := Int) (· < ·) (· < ·) (· < ·) := ⟨Int.lt_trans⟩ - -protected theorem min_def (n m : Int) : min n m = if n ≤ m then n else m := rfl - -protected theorem max_def (n m : Int) : max n m = if n ≤ m then m else n := rfl - -protected theorem min_comm (a b : Int) : min a b = min b a := by - simp [Int.min_def] - by_cases h₁ : a ≤ b <;> by_cases h₂ : b ≤ a <;> simp [h₁, h₂] - · exact Int.le_antisymm h₁ h₂ - · cases not_or_intro h₁ h₂ <| Int.le_total .. - -protected theorem min_le_right (a b : Int) : min a b ≤ b := by rw [Int.min_def]; split <;> simp [*] - -protected theorem min_le_left (a b : Int) : min a b ≤ a := Int.min_comm .. ▸ Int.min_le_right .. - -protected theorem le_min {a b c : Int} : a ≤ min b c ↔ a ≤ b ∧ a ≤ c := - ⟨fun h => ⟨Int.le_trans h (Int.min_le_left ..), Int.le_trans h (Int.min_le_right ..)⟩, - fun ⟨h₁, h₂⟩ => by rw [Int.min_def]; split <;> assumption⟩ - -protected theorem max_comm (a b : Int) : max a b = max b a := by - simp only [Int.max_def] - by_cases h₁ : a ≤ b <;> by_cases h₂ : b ≤ a <;> simp [h₁, h₂] - · exact Int.le_antisymm h₂ h₁ - · cases not_or_intro h₁ h₂ <| Int.le_total .. - -protected theorem le_max_left (a b : Int) : a ≤ max a b := by rw [Int.max_def]; split <;> simp [*] - -protected theorem le_max_right (a b : Int) : b ≤ max a b := Int.max_comm .. ▸ Int.le_max_left .. - -protected theorem max_le {a b c : Int} : max a b ≤ c ↔ a ≤ c ∧ b ≤ c := - ⟨fun h => ⟨Int.le_trans (Int.le_max_left ..) h, Int.le_trans (Int.le_max_right ..) h⟩, - fun ⟨h₁, h₂⟩ => by rw [Int.max_def]; split <;> assumption⟩ - -theorem eq_natAbs_of_zero_le {a : Int} (h : 0 ≤ a) : a = natAbs a := by - let ⟨n, e⟩ := eq_ofNat_of_zero_le h - rw [e]; rfl - -theorem le_natAbs {a : Int} : a ≤ natAbs a := - match Int.le_total 0 a with - | .inl h => by rw [eq_natAbs_of_zero_le h]; apply Int.le_refl - | .inr h => Int.le_trans h (ofNat_zero_le _) - -theorem negSucc_lt_zero (n : Nat) : -[n+1] < 0 := - Int.not_le.1 fun h => let ⟨_, h⟩ := eq_ofNat_of_zero_le h; nomatch h - -@[simp] theorem negSucc_not_nonneg (n : Nat) : 0 ≤ -[n+1] ↔ False := by - simp only [Int.not_le, iff_false]; exact Int.negSucc_lt_zero n - -protected theorem add_le_add_left {a b : Int} (h : a ≤ b) (c : Int) : c + a ≤ c + b := - let ⟨n, hn⟩ := le.dest h; le.intro n <| by rw [Int.add_assoc, hn] - -protected theorem add_lt_add_left {a b : Int} (h : a < b) (c : Int) : c + a < c + b := - Int.lt_iff_le_and_ne.2 ⟨Int.add_le_add_left (Int.le_of_lt h) _, fun heq => - b.lt_irrefl <| by rwa [Int.add_left_cancel heq] at h⟩ - -protected theorem add_le_add_right {a b : Int} (h : a ≤ b) (c : Int) : a + c ≤ b + c := - Int.add_comm c a ▸ Int.add_comm c b ▸ Int.add_le_add_left h c - -protected theorem add_lt_add_right {a b : Int} (h : a < b) (c : Int) : a + c < b + c := - Int.add_comm c a ▸ Int.add_comm c b ▸ Int.add_lt_add_left h c - -protected theorem le_of_add_le_add_left {a b c : Int} (h : a + b ≤ a + c) : b ≤ c := by - have : -a + (a + b) ≤ -a + (a + c) := Int.add_le_add_left h _ - simp [Int.neg_add_cancel_left] at this - assumption - -protected theorem le_of_add_le_add_right {a b c : Int} (h : a + b ≤ c + b) : a ≤ c := - Int.le_of_add_le_add_left (a := b) <| by rwa [Int.add_comm b a, Int.add_comm b c] - -protected theorem add_le_add_iff_left (a : Int) : a + b ≤ a + c ↔ b ≤ c := - ⟨Int.le_of_add_le_add_left, (Int.add_le_add_left · _)⟩ - -protected theorem add_le_add_iff_right (c : Int) : a + c ≤ b + c ↔ a ≤ b := - ⟨Int.le_of_add_le_add_right, (Int.add_le_add_right · _)⟩ - -protected theorem add_le_add {a b c d : Int} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d := - Int.le_trans (Int.add_le_add_right h₁ c) (Int.add_le_add_left h₂ b) - -protected theorem le_add_of_nonneg_right {a b : Int} (h : 0 ≤ b) : a ≤ a + b := by - have : a + b ≥ a + 0 := Int.add_le_add_left h a - rwa [Int.add_zero] at this - -protected theorem le_add_of_nonneg_left {a b : Int} (h : 0 ≤ b) : a ≤ b + a := by - have : 0 + a ≤ b + a := Int.add_le_add_right h a - rwa [Int.zero_add] at this - -protected theorem neg_le_neg {a b : Int} (h : a ≤ b) : -b ≤ -a := by - have : 0 ≤ -a + b := Int.add_left_neg a ▸ Int.add_le_add_left h (-a) - have : 0 + -b ≤ -a + b + -b := Int.add_le_add_right this (-b) - rwa [Int.add_neg_cancel_right, Int.zero_add] at this - -protected theorem le_of_neg_le_neg {a b : Int} (h : -b ≤ -a) : a ≤ b := - suffices - -a ≤ - -b by simp [Int.neg_neg] at this; assumption - Int.neg_le_neg h - -protected theorem neg_nonpos_of_nonneg {a : Int} (h : 0 ≤ a) : -a ≤ 0 := by - have : -a ≤ -0 := Int.neg_le_neg h - rwa [Int.neg_zero] at this - -protected theorem neg_nonneg_of_nonpos {a : Int} (h : a ≤ 0) : 0 ≤ -a := by - have : -0 ≤ -a := Int.neg_le_neg h - rwa [Int.neg_zero] at this - -protected theorem neg_lt_neg {a b : Int} (h : a < b) : -b < -a := by - have : 0 < -a + b := Int.add_left_neg a ▸ Int.add_lt_add_left h (-a) - have : 0 + -b < -a + b + -b := Int.add_lt_add_right this (-b) - rwa [Int.add_neg_cancel_right, Int.zero_add] at this - -protected theorem neg_neg_of_pos {a : Int} (h : 0 < a) : -a < 0 := by - have : -a < -0 := Int.neg_lt_neg h - rwa [Int.neg_zero] at this - -protected theorem neg_pos_of_neg {a : Int} (h : a < 0) : 0 < -a := by - have : -0 < -a := Int.neg_lt_neg h - rwa [Int.neg_zero] at this - -protected theorem sub_nonneg_of_le {a b : Int} (h : b ≤ a) : 0 ≤ a - b := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem le_of_sub_nonneg {a b : Int} (h : 0 ≤ a - b) : b ≤ a := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem sub_pos_of_lt {a b : Int} (h : b < a) : 0 < a - b := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem lt_of_sub_pos {a b : Int} (h : 0 < a - b) : b < a := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem sub_left_le_of_le_add {a b c : Int} (h : a ≤ b + c) : a - b ≤ c := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_comm b c, Int.add_neg_cancel_right] at h - -protected theorem sub_le_self (a : Int) {b : Int} (h : 0 ≤ b) : a - b ≤ a := - calc a + -b - _ ≤ a + 0 := Int.add_le_add_left (Int.neg_nonpos_of_nonneg h) _ - _ = a := by rw [Int.add_zero] - -protected theorem sub_lt_self (a : Int) {b : Int} (h : 0 < b) : a - b < a := - calc a + -b - _ < a + 0 := Int.add_lt_add_left (Int.neg_neg_of_pos h) _ - _ = a := by rw [Int.add_zero] - -theorem add_one_le_of_lt {a b : Int} (H : a < b) : a + 1 ≤ b := H - -/- ### Order properties and multiplication -/ - - -protected theorem mul_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b := by - let ⟨n, hn⟩ := eq_ofNat_of_zero_le ha - let ⟨m, hm⟩ := eq_ofNat_of_zero_le hb - rw [hn, hm, ← ofNat_mul]; apply ofNat_nonneg - -protected theorem mul_pos {a b : Int} (ha : 0 < a) (hb : 0 < b) : 0 < a * b := by - let ⟨n, hn⟩ := eq_succ_of_zero_lt ha - let ⟨m, hm⟩ := eq_succ_of_zero_lt hb - rw [hn, hm, ← ofNat_mul]; apply ofNat_succ_pos - -protected theorem mul_lt_mul_of_pos_left {a b c : Int} - (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b := by - have : 0 < c * (b - a) := Int.mul_pos h₂ (Int.sub_pos_of_lt h₁) - rw [Int.mul_sub] at this - exact Int.lt_of_sub_pos this - -protected theorem mul_lt_mul_of_pos_right {a b c : Int} - (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c := by - have : 0 < b - a := Int.sub_pos_of_lt h₁ - have : 0 < (b - a) * c := Int.mul_pos this h₂ - rw [Int.sub_mul] at this - exact Int.lt_of_sub_pos this - -protected theorem mul_le_mul_of_nonneg_left {a b c : Int} - (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := by - if hba : b ≤ a then rw [Int.le_antisymm hba h₁]; apply Int.le_refl else - if hc0 : c ≤ 0 then simp [Int.le_antisymm hc0 h₂, Int.zero_mul] else - exact Int.le_of_lt <| Int.mul_lt_mul_of_pos_left - (Int.lt_iff_le_not_le.2 ⟨h₁, hba⟩) (Int.lt_iff_le_not_le.2 ⟨h₂, hc0⟩) - -protected theorem mul_le_mul_of_nonneg_right {a b c : Int} - (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := by - rw [Int.mul_comm, Int.mul_comm b]; exact Int.mul_le_mul_of_nonneg_left h₁ h₂ - -protected theorem mul_le_mul {a b c d : Int} - (hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d := - Int.le_trans (Int.mul_le_mul_of_nonneg_right hac nn_b) (Int.mul_le_mul_of_nonneg_left hbd nn_c) - -protected theorem mul_nonpos_of_nonneg_of_nonpos {a b : Int} - (ha : 0 ≤ a) (hb : b ≤ 0) : a * b ≤ 0 := by - have h : a * b ≤ a * 0 := Int.mul_le_mul_of_nonneg_left hb ha - rwa [Int.mul_zero] at h - -protected theorem mul_nonpos_of_nonpos_of_nonneg {a b : Int} - (ha : a ≤ 0) (hb : 0 ≤ b) : a * b ≤ 0 := by - have h : a * b ≤ 0 * b := Int.mul_le_mul_of_nonneg_right ha hb - rwa [Int.zero_mul] at h - -protected theorem mul_le_mul_of_nonpos_right {a b c : Int} - (h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c := - have : -c ≥ 0 := Int.neg_nonneg_of_nonpos hc - have : b * -c ≤ a * -c := Int.mul_le_mul_of_nonneg_right h this - Int.le_of_neg_le_neg <| by rwa [← Int.neg_mul_eq_mul_neg, ← Int.neg_mul_eq_mul_neg] at this - -protected theorem mul_le_mul_of_nonpos_left {a b c : Int} - (ha : a ≤ 0) (h : c ≤ b) : a * b ≤ a * c := by - rw [Int.mul_comm a b, Int.mul_comm a c] - apply Int.mul_le_mul_of_nonpos_right h ha - -/- ## natAbs -/ - -@[simp] theorem natAbs_ofNat (n : Nat) : natAbs ↑n = n := rfl -@[simp] theorem natAbs_negSucc (n : Nat) : natAbs -[n+1] = n.succ := rfl -@[simp] theorem natAbs_zero : natAbs (0 : Int) = (0 : Nat) := rfl -@[simp] theorem natAbs_one : natAbs (1 : Int) = (1 : Nat) := rfl - -@[simp] theorem natAbs_eq_zero : natAbs a = 0 ↔ a = 0 := - ⟨fun H => match a with - | ofNat _ => congrArg ofNat H - | -[_+1] => absurd H (succ_ne_zero _), - fun e => e ▸ rfl⟩ - -theorem natAbs_pos : 0 < natAbs a ↔ a ≠ 0 := by rw [Nat.pos_iff_ne_zero, Ne, natAbs_eq_zero] - -@[simp] theorem natAbs_neg : ∀ (a : Int), natAbs (-a) = natAbs a - | 0 => rfl - | succ _ => rfl - | -[_+1] => rfl - -theorem natAbs_eq : ∀ (a : Int), a = natAbs a ∨ a = -↑(natAbs a) - | ofNat _ => Or.inl rfl - | -[_+1] => Or.inr rfl - -theorem natAbs_negOfNat (n : Nat) : natAbs (negOfNat n) = n := by - cases n <;> rfl - -theorem natAbs_mul (a b : Int) : natAbs (a * b) = natAbs a * natAbs b := by - cases a <;> cases b <;> - simp only [← Int.mul_def, Int.mul, natAbs_negOfNat] <;> simp only [natAbs] - -theorem natAbs_eq_natAbs_iff {a b : Int} : a.natAbs = b.natAbs ↔ a = b ∨ a = -b := by - constructor <;> intro h - · cases Int.natAbs_eq a with - | inl h₁ | inr h₁ => - cases Int.natAbs_eq b with - | inl h₂ | inr h₂ => rw [h₁, h₂]; simp [h] - · cases h with (subst a; try rfl) - | inr h => rw [Int.natAbs_neg] - -theorem natAbs_of_nonneg {a : Int} (H : 0 ≤ a) : (natAbs a : Int) = a := - match a, eq_ofNat_of_zero_le H with - | _, ⟨_, rfl⟩ => rfl - -theorem ofNat_natAbs_of_nonpos {a : Int} (H : a ≤ 0) : (natAbs a : Int) = -a := by - rw [← natAbs_neg, natAbs_of_nonneg (Int.neg_nonneg_of_nonpos H)] diff --git a/Std/Data/Int/Lemmas.lean b/Std/Data/Int/Lemmas.lean index 4ef4a5ee7f..a449fdb06f 100644 --- a/Std/Data/Int/Lemmas.lean +++ b/Std/Data/Int/Lemmas.lean @@ -1,7 +1,6 @@ -- This is a backwards compatibility shim, after `Std.Data.Int.Lemmas` was split into smaller files. -- Hopefully it can later be removed. -import Std.Data.Int.Basic import Std.Data.Int.Gcd import Std.Data.Int.Order import Std.Data.Int.DivMod diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index cb8166a2c1..443ec4e28a 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -4,10 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Data.Nat.Lemmas -import Std.Data.Int.Init.Order -import Std.Data.Option.Basic -import Std.Tactic.Omega -import Std.Data.Nat.Lemmas /-! # Results about the order properties of the integers, and the integers as an ordered ring. diff --git a/Std/Data/List.lean b/Std/Data/List.lean index 137c762db9..4165ebcfe7 100644 --- a/Std/Data/List.lean +++ b/Std/Data/List.lean @@ -1,7 +1,6 @@ import Std.Data.List.Basic import Std.Data.List.Count import Std.Data.List.Init.Attach -import Std.Data.List.Init.Lemmas import Std.Data.List.Lemmas import Std.Data.List.Pairwise import Std.Data.List.Perm diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index a60b09b962..6b4dec0e2d 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ -import Std.Data.Option.Init.Lemmas namespace List @@ -200,8 +199,13 @@ def enumFromTR (n : Nat) (l : List α) : List (Nat × α) := | [], n => rfl | a::as, n => by rw [← show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as] - simp [enumFrom] - rw [Array.foldr_eq_foldr_data]; simp [go] + simp [enumFrom, f] + -- Note: there was a regression here caused by leanprover/lean4#3388. + -- Previously the `go` was in the `simp`, not the `rw`, but currently `simp` can't use it. + -- A fix will land in nightly-2024-02-20 + -- https://github.com/leanprover/lean4/pull/3406 + rw [Array.foldr_eq_foldr_data, go] + simp theorem replicateTR_loop_eq : ∀ n, replicateTR.loop a n acc = replicate n a ++ acc | 0 => rfl @@ -259,29 +263,6 @@ protected def Subset (l₁ l₂ : List α) := ∀ ⦃a : α⦄, a ∈ l₁ → a instance : HasSubset (List α) := ⟨List.Subset⟩ -instance decidableBEx (p : α → Prop) [DecidablePred p] : - ∀ l : List α, Decidable (∃ x ∈ l, p x) - | [] => isFalse nofun - | x :: xs => - if h₁ : p x then isTrue ⟨x, .head .., h₁⟩ else - match decidableBEx p xs with - | isTrue h₂ => isTrue <| let ⟨y, hm, hp⟩ := h₂; ⟨y, .tail _ hm, hp⟩ - | isFalse h₂ => isFalse fun - | ⟨y, .tail _ h, hp⟩ => h₂ ⟨y, h, hp⟩ - | ⟨_, .head .., hp⟩ => h₁ hp - -instance decidableBAll (p : α → Prop) [DecidablePred p] : - ∀ l : List α, Decidable (∀ x ∈ l, p x) - | [] => isTrue nofun - | x :: xs => - if h₁ : p x then - match decidableBAll p xs with - | isTrue h₂ => isTrue fun - | y, .tail _ h => h₂ y h - | _, .head .. => h₁ - | isFalse h₂ => isFalse fun H => h₂ fun y hm => H y (.tail _ hm) - else isFalse fun H => h₁ <| H x (.head ..) - instance [DecidableEq α] : DecidableRel (Subset : List α → List α → Prop) := fun _ _ => decidableBAll _ _ @@ -409,10 +390,6 @@ def indexOf [BEq α] (a : α) : List α → Nat := findIdx (· == a) · rw [go _ xs]; simp exact (go #[] _).symm -/-- Inserts an element into a list without duplication. -/ -@[inline] protected def insert [BEq α] (a : α) (l : List α) : List α := - if l.elem a then l else a :: l - /-- Constructs the union of two lists, by inserting the elements of `l₁` in reverse order to `l₂`. As a result, `l₂` will always be a suffix, but only the last occurrence of each element in `l₁` diff --git a/Std/Data/List/Count.lean b/Std/Data/List/Count.lean index a50809b5cb..0087e86007 100644 --- a/Std/Data/List/Count.lean +++ b/Std/Data/List/Count.lean @@ -5,7 +5,6 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M -/ import Std.Data.List.Basic import Std.Data.List.Lemmas -import Std.Data.List.Init.Lemmas /-! # Counting in lists diff --git a/Std/Data/List/Init/Attach.lean b/Std/Data/List/Init/Attach.lean index 241c72ed3f..63ebca89df 100644 --- a/Std/Data/List/Init/Attach.lean +++ b/Std/Data/List/Init/Attach.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Data.List.Init.Lemmas namespace List diff --git a/Std/Data/List/Init/Lemmas.lean b/Std/Data/List/Init/Lemmas.lean deleted file mode 100644 index 76a8f1328b..0000000000 --- a/Std/Data/List/Init/Lemmas.lean +++ /dev/null @@ -1,27 +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 --/ - -namespace List - -open Nat - -/-! -# Bootstrapping theorems for lists - -These are theorems used in the definitions of `Std.Data.List.Basic` and tactics. -New theorems should be added to `Std.Data.List.Lemmas` if they are not needed by the bootstrap. --/ - -theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a, a ∈ l → ¬p a := by - simp only [eq_nil_iff_forall_not_mem, mem_filter, not_and] - --- A specialization of `minimum?_eq_some_iff` to Nat. -theorem minimum?_eq_some_iff' {xs : List Nat} : - xs.minimum? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, a ≤ b) := - minimum?_eq_some_iff - (le_refl := Nat.le_refl) - (min_eq_or := fun _ _ => Nat.min_def .. ▸ by split <;> simp) - (le_min_iff := fun _ _ _ => Nat.le_min) diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index d7debbc11e..7370f269e4 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -10,7 +10,6 @@ import Std.Data.Nat.Lemmas import Std.Data.List.Basic import Std.Data.Option.Lemmas import Std.Classes.BEq -import Std.Tactic.Ext import Std.Tactic.Simpa namespace List diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean index dc6324c2df..ddf2f7c112 100644 --- a/Std/Data/Nat/Bitwise.lean +++ b/Std/Data/Nat/Bitwise.lean @@ -10,9 +10,9 @@ This module defines properties of the bitwise operations on Natural numbers. It is primarily intended to support the bitvector library. -/ -import Std.Data.Bool -import Std.Data.Nat.Lemmas -import Std.Tactic.Omega +import Std.Data.Nat.Basic +import Std.Tactic.Simpa +import Std.Tactic.Basic namespace Nat diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index fd70d5646c..a0c16adb9d 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -6,7 +6,6 @@ Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro import Std.Tactic.Alias import Std.Tactic.Init import Std.Data.Nat.Basic -import Std.Data.Ord /-! # Basic lemmas about natural numbers @@ -138,46 +137,6 @@ theorem recDiagOn_succ_succ {motive : Nat → Nat → Sort _} (zero_zero : motiv (succ_succ : ∀ m n, motive (m+1) (n+1)) (m n) : Nat.casesDiagOn (m+1) (n+1) zero_zero zero_succ succ_zero succ_succ = succ_succ m n := rfl -/-! ### le/lt -/ - -protected theorem lt_asymm {a b : Nat} (h : a < b) : ¬ b < a := Nat.not_lt.2 (Nat.le_of_lt h) -protected alias not_lt_of_gt := Nat.lt_asymm -protected alias not_lt_of_lt := Nat.lt_asymm - -protected theorem lt_iff_le_not_le {m n : Nat} : m < n ↔ m ≤ n ∧ ¬ n ≤ m := - ⟨fun h => ⟨Nat.le_of_lt h, Nat.not_le_of_gt h⟩, fun ⟨_, h⟩ => Nat.lt_of_not_ge h⟩ -protected alias lt_iff_le_and_not_ge := Nat.lt_iff_le_not_le - -protected theorem lt_iff_le_and_ne {m n : Nat} : m < n ↔ m ≤ n ∧ m ≠ n := - ⟨fun h => ⟨Nat.le_of_lt h, Nat.ne_of_lt h⟩, fun h => Nat.lt_of_le_of_ne h.1 h.2⟩ - -protected theorem ne_iff_lt_or_gt {a b : Nat} : a ≠ b ↔ a < b ∨ b < a := - ⟨Nat.lt_or_gt_of_ne, fun | .inl h => Nat.ne_of_lt h | .inr h => Nat.ne_of_gt h⟩ -protected alias lt_or_gt := Nat.ne_iff_lt_or_gt - -protected alias le_or_ge := Nat.le_total -protected alias le_or_le := Nat.le_total - -protected theorem eq_or_lt_of_not_lt {a b : Nat} (hnlt : ¬ a < b) : a = b ∨ b < a := - (Nat.lt_trichotomy ..).resolve_left hnlt - -protected theorem lt_or_eq_of_le {n m : Nat} (h : n ≤ m) : n < m ∨ n = m := - (Nat.lt_or_ge ..).imp_right (Nat.le_antisymm h) - -protected theorem le_iff_lt_or_eq {n m : Nat} : n ≤ m ↔ n < m ∨ n = m := - ⟨Nat.lt_or_eq_of_le, fun | .inl h => Nat.le_of_lt h | .inr rfl => Nat.le_refl _⟩ - -protected theorem lt_succ_iff : m < succ n ↔ m ≤ n := ⟨le_of_lt_succ, lt_succ_of_le⟩ - -protected theorem lt_succ_iff_lt_or_eq : m < succ n ↔ m < n ∨ m = n := - Nat.lt_succ_iff.trans Nat.le_iff_lt_or_eq - -protected theorem eq_of_lt_succ_of_not_lt (hmn : m < n + 1) (h : ¬ m < n) : m = n := - (Nat.lt_succ_iff_lt_or_eq.1 hmn).resolve_left h - -protected theorem eq_of_le_of_lt_succ (h₁ : n ≤ m) (h₂ : m < n + 1) : m = n := - Nat.le_antisymm (le_of_succ_le_succ h₂) h₁ - /-! ## compare -/ theorem compare_def_lt (a b : Nat) : @@ -231,419 +190,18 @@ protected def sum_trichotomy (a b : Nat) : a < b ⊕' a = b ⊕' b < a := | .eq => .inr (.inl (Nat.compare_eq_eq.1 h)) | .gt => .inr (.inr (Nat.compare_eq_gt.1 h)) -/-! ## zero/one/two -/ - -theorem le_zero : i ≤ 0 ↔ i = 0 := ⟨Nat.eq_zero_of_le_zero, fun | rfl => Nat.le_refl _⟩ - -protected alias one_pos := Nat.zero_lt_one - -protected theorem two_pos : 0 < 2 := Nat.zero_lt_succ _ - -theorem add_one_ne_zero (n) : n + 1 ≠ 0 := succ_ne_zero _ - -protected theorem ne_zero_iff_zero_lt : n ≠ 0 ↔ 0 < n := Nat.pos_iff_ne_zero.symm - -protected theorem zero_lt_two : 0 < 2 := Nat.zero_lt_succ _ - -protected theorem one_lt_two : 1 < 2 := Nat.succ_lt_succ Nat.zero_lt_one - -protected theorem eq_zero_of_not_pos (h : ¬0 < n) : n = 0 := - Nat.eq_zero_of_le_zero (Nat.not_lt.1 h) - -/-! ## succ/pred -/ - -attribute [simp] succ_ne_zero zero_lt_succ lt_succ_self Nat.pred_zero Nat.pred_succ Nat.pred_le - -theorem succ_ne_self (n) : succ n ≠ n := Nat.ne_of_gt (lt_succ_self n) - -theorem succ_le : succ n ≤ m ↔ n < m := .rfl - -theorem lt_succ : m < succ n ↔ m ≤ n := ⟨le_of_lt_succ, lt_succ_of_le⟩ - -theorem lt_succ_of_lt (h : a < b) : a < succ b := le_succ_of_le h - -theorem succ_pred_eq_of_ne_zero : ∀ {n}, n ≠ 0 → succ (pred n) = n - | _+1, _ => rfl - -theorem eq_zero_or_eq_succ_pred : ∀ n, n = 0 ∨ n = succ (pred n) - | 0 => .inl rfl - | _+1 => .inr rfl - -theorem succ_inj' : succ a = succ b ↔ a = b := ⟨succ.inj, congrArg _⟩ - -theorem succ_le_succ_iff : succ a ≤ succ b ↔ a ≤ b := ⟨le_of_succ_le_succ, succ_le_succ⟩ - -theorem succ_lt_succ_iff : succ a < succ b ↔ a < b := ⟨lt_of_succ_lt_succ, succ_lt_succ⟩ - -theorem pred_inj : ∀ {a b}, 0 < a → 0 < b → pred a = pred b → a = b - | _+1, _+1, _, _ => congrArg _ - -theorem pred_ne_self : ∀ {a}, a ≠ 0 → pred a ≠ a - | _+1, _ => (succ_ne_self _).symm - -theorem pred_lt_self : ∀ {a}, 0 < a → pred a < a - | _+1, _ => lt_succ_self _ - -theorem pred_lt_pred : ∀ {n m}, n ≠ 0 → n < m → pred n < pred m - | _+1, _+1, _, h => lt_of_succ_lt_succ h - -theorem pred_le_iff_le_succ : ∀ {n m}, pred n ≤ m ↔ n ≤ succ m - | 0, _ => ⟨fun _ => Nat.zero_le _, fun _ => Nat.zero_le _⟩ - | _+1, _ => Nat.succ_le_succ_iff.symm - -theorem le_succ_of_pred_le : pred n ≤ m → n ≤ succ m := pred_le_iff_le_succ.1 - -theorem pred_le_of_le_succ : n ≤ succ m → pred n ≤ m := pred_le_iff_le_succ.2 - -theorem lt_pred_iff_succ_lt : ∀ {n m}, n < pred m ↔ succ n < m - | _, 0 => ⟨nofun, nofun⟩ - | _, _+1 => Nat.succ_lt_succ_iff.symm - -theorem succ_lt_of_lt_pred : n < pred m → succ n < m := lt_pred_iff_succ_lt.1 - -theorem lt_pred_of_succ_lt : succ n < m → n < pred m := lt_pred_iff_succ_lt.2 - -theorem le_pred_iff_lt : ∀ {n m}, 0 < m → (n ≤ pred m ↔ n < m) - | 0, _+1, _ => ⟨fun _ => Nat.zero_lt_succ _, fun _ => Nat.zero_le _⟩ - | _+1, _+1, _ => Nat.lt_pred_iff_succ_lt - -theorem lt_of_le_pred (h : 0 < m) : n ≤ pred m → n < m := (le_pred_iff_lt h).1 - -theorem le_pred_of_lt (h : n < m) : n ≤ pred m := (le_pred_iff_lt (Nat.zero_lt_of_lt h)).2 h - -theorem exists_eq_succ_of_ne_zero : ∀ {n}, n ≠ 0 → ∃ k, n = succ k - | _+1, _ => ⟨_, rfl⟩ - /-! ## add -/ -protected theorem add_add_add_comm (a b c d : Nat) : (a + b) + (c + d) = (a + c) + (b + d) := by - rw [Nat.add_assoc, Nat.add_assoc, Nat.add_left_comm b] - -theorem one_add (n) : 1 + n = succ n := Nat.add_comm .. - -theorem succ_eq_one_add (n) : succ n = 1 + n := (one_add _).symm - -theorem succ_add_eq_add_succ (a b) : succ a + b = a + succ b := Nat.succ_add .. @[deprecated] alias succ_add_eq_succ_add := Nat.succ_add_eq_add_succ -protected theorem eq_zero_of_add_eq_zero_right (h : n + m = 0) : n = 0 := - (Nat.eq_zero_of_add_eq_zero h).1 - -protected theorem add_eq_zero_iff : n + m = 0 ↔ n = 0 ∧ m = 0 := - ⟨Nat.eq_zero_of_add_eq_zero, fun ⟨h₁, h₂⟩ => h₂.symm ▸ h₁⟩ - -protected theorem add_left_cancel_iff {n : Nat} : n + m = n + k ↔ m = k := - ⟨Nat.add_left_cancel, fun | rfl => rfl⟩ - -protected theorem add_right_cancel_iff {n : Nat} : m + n = k + n ↔ m = k := - ⟨Nat.add_right_cancel, fun | rfl => rfl⟩ - -protected theorem add_le_add_iff_left {n : Nat} : n + m ≤ n + k ↔ m ≤ k := - ⟨Nat.le_of_add_le_add_left, fun h => Nat.add_le_add_left h _⟩ - -protected theorem lt_of_add_lt_add_right : ∀ {n : Nat}, k + n < m + n → k < m - | 0, h => h - | _+1, h => Nat.lt_of_add_lt_add_right (Nat.lt_of_succ_lt_succ h) - -protected theorem lt_of_add_lt_add_left {n : Nat} : n + k < n + m → k < m := by - rw [Nat.add_comm n, Nat.add_comm n]; exact Nat.lt_of_add_lt_add_right - -protected theorem add_lt_add_iff_left {k n m : Nat} : k + n < k + m ↔ n < m := - ⟨Nat.lt_of_add_lt_add_left, fun h => Nat.add_lt_add_left h _⟩ - -protected theorem add_lt_add_iff_right {k n m : Nat} : n + k < m + k ↔ n < m := - ⟨Nat.lt_of_add_lt_add_right, fun h => Nat.add_lt_add_right h _⟩ - -protected theorem add_lt_add_of_le_of_lt {a b c d : Nat} (hle : a ≤ b) (hlt : c < d) : - a + c < b + d := - Nat.lt_of_le_of_lt (Nat.add_le_add_right hle _) (Nat.add_lt_add_left hlt _) - -protected theorem add_lt_add_of_lt_of_le {a b c d : Nat} (hlt : a < b) (hle : c ≤ d) : - a + c < b + d := - Nat.lt_of_le_of_lt (Nat.add_le_add_left hle _) (Nat.add_lt_add_right hlt _) - -protected theorem lt_add_left (c : Nat) (h : a < b) : a < c + b := - Nat.lt_of_lt_of_le h (Nat.le_add_left ..) - -protected theorem lt_add_right (c : Nat) (h : a < b) : a < b + c := - Nat.lt_of_lt_of_le h (Nat.le_add_right ..) - -protected theorem lt_add_of_pos_right (h : 0 < k) : n < n + k := - Nat.add_lt_add_left h n - -protected theorem lt_add_of_pos_left : 0 < k → n < k + n := by - rw [Nat.add_comm]; exact Nat.lt_add_of_pos_right - -protected theorem pos_of_lt_add_right (h : n < n + k) : 0 < k := - Nat.lt_of_add_lt_add_left h - -protected theorem pos_of_lt_add_left : n < k + n → 0 < k := by - rw [Nat.add_comm]; exact Nat.pos_of_lt_add_right - -protected theorem lt_add_right_iff_pos : n < n + k ↔ 0 < k := - ⟨Nat.pos_of_lt_add_right, Nat.lt_add_of_pos_right⟩ - -protected theorem lt_add_left_iff_pos : n < k + n ↔ 0 < k := - ⟨Nat.pos_of_lt_add_left, Nat.lt_add_of_pos_left⟩ - -protected theorem add_pos_left (h : 0 < m) (n) : 0 < m + n := - Nat.lt_of_lt_of_le h (Nat.le_add_right ..) - -protected theorem add_pos_right (m) (h : 0 < n) : 0 < m + n := - Nat.lt_of_lt_of_le h (Nat.le_add_left ..) - -protected theorem add_self_ne_one : ∀ n, n + n ≠ 1 - | n+1, h => by rw [Nat.succ_add, Nat.succ_inj'] at h; contradiction - /-! ## sub -/ -protected theorem sub_one (n) : n - 1 = pred n := rfl - -protected theorem one_sub : ∀ n, 1 - n = if n = 0 then 1 else 0 - | 0 => rfl - | _+1 => by rw [if_neg (Nat.succ_ne_zero _), Nat.succ_sub_succ, Nat.zero_sub] - -theorem succ_sub_sub_succ (n m k) : succ n - m - succ k = n - m - k := by - rw [Nat.sub_sub, Nat.sub_sub, add_succ, succ_sub_succ] - -protected theorem sub_right_comm (m n k : Nat) : m - n - k = m - k - n := by - rw [Nat.sub_sub, Nat.sub_sub, Nat.add_comm] - -protected theorem add_sub_cancel_right (n m : Nat) : (n + m) - m = n := Nat.add_sub_cancel .. - -@[simp] protected theorem add_sub_cancel' {n m : Nat} (h : m ≤ n) : m + (n - m) = n := by - rw [Nat.add_comm, Nat.sub_add_cancel h] - -theorem succ_sub_one (n) : succ n - 1 = n := rfl - -protected theorem add_one_sub_one (n : Nat) : (n + 1) - 1 = n := rfl - -protected theorem one_add_sub_one (n : Nat) : (1 + n) - 1 = n := Nat.add_sub_cancel_left 1 _ - -protected theorem sub_sub_self {n m : Nat} (h : m ≤ n) : n - (n - m) = m := - (Nat.sub_eq_iff_eq_add (Nat.sub_le ..)).2 (Nat.add_sub_of_le h).symm - -protected theorem sub_add_comm {n m k : Nat} (h : k ≤ n) : n + m - k = n - k + m := by - rw [Nat.sub_eq_iff_eq_add (Nat.le_trans h (Nat.le_add_right ..))] - rwa [Nat.add_right_comm, Nat.sub_add_cancel] - -protected theorem sub_eq_zero_iff_le : n - m = 0 ↔ n ≤ m := - ⟨Nat.le_of_sub_eq_zero, Nat.sub_eq_zero_of_le⟩ - -protected theorem sub_pos_iff_lt : 0 < n - m ↔ m < n := - ⟨Nat.lt_of_sub_pos, Nat.sub_pos_of_lt⟩ - -protected theorem sub_le_iff_le_add {a b c : Nat} : a - b ≤ c ↔ a ≤ c + b := - ⟨Nat.le_add_of_sub_le, sub_le_of_le_add⟩ - -protected theorem sub_le_iff_le_add' {a b c : Nat} : a - b ≤ c ↔ a ≤ b + c := by - rw [Nat.add_comm, Nat.sub_le_iff_le_add] - -protected theorem le_sub_iff_add_le {n : Nat} (h : k ≤ m) : n ≤ m - k ↔ n + k ≤ m := - ⟨Nat.add_le_of_le_sub h, Nat.le_sub_of_add_le⟩ - -@[deprecated Nat.le_sub_iff_add_le] -protected theorem add_le_to_le_sub (n : Nat) (h : m ≤ k) : n + m ≤ k ↔ n ≤ k - m := - (Nat.le_sub_iff_add_le h).symm - -protected theorem add_le_of_le_sub' {n k m : Nat} (h : m ≤ k) : n ≤ k - m → m + n ≤ k := - Nat.add_comm .. ▸ Nat.add_le_of_le_sub h - -@[deprecated Nat.add_le_of_le_sub'] -protected theorem add_le_of_le_sub_left {n k m : Nat} (h : m ≤ k) : n ≤ k - m → m + n ≤ k := - Nat.add_le_of_le_sub' h - -protected theorem le_sub_of_add_le' {n k m : Nat} : m + n ≤ k → n ≤ k - m := - Nat.add_comm .. ▸ Nat.le_sub_of_add_le - -protected theorem le_sub_iff_add_le' {n : Nat} (h : k ≤ m) : n ≤ m - k ↔ k + n ≤ m := - ⟨Nat.add_le_of_le_sub' h, Nat.le_sub_of_add_le'⟩ - @[deprecated] protected alias le_of_le_of_sub_le_sub_right := Nat.le_of_sub_le_sub_right -protected theorem le_of_sub_le_sub_left : ∀ {n k m : Nat}, n ≤ k → k - m ≤ k - n → n ≤ m - | 0, _, _, _, _ => Nat.zero_le .. - | _+1, _, 0, h₀, h₁ => - absurd (Nat.sub_lt (Nat.zero_lt_of_lt h₀) (Nat.zero_lt_succ _)) (Nat.not_lt.2 h₁) - | _+1, _+1, _+1, h₀, h₁ => by - simp only [Nat.succ_sub_succ] at h₁ - exact succ_le_succ <| Nat.le_of_sub_le_sub_left (Nat.le_of_succ_le_succ h₀) h₁ @[deprecated] protected alias le_of_le_of_sub_le_sub_left := Nat.le_of_sub_le_sub_left -protected theorem sub_le_sub_iff_left {n m k : Nat} (h : n ≤ k) : k - m ≤ k - n ↔ n ≤ m := - ⟨Nat.le_of_sub_le_sub_left h, fun h => Nat.sub_le_sub_left h _⟩ - -protected theorem sub_lt_of_pos_le (h₀ : 0 < a) (h₁ : a ≤ b) : b - a < b := - Nat.sub_lt (Nat.lt_of_lt_of_le h₀ h₁) h₀ -protected alias sub_lt_self := Nat.sub_lt_of_pos_le - -theorem add_lt_of_lt_sub' {a b c : Nat} : b < c - a → a + b < c := by - rw [Nat.add_comm]; exact Nat.add_lt_of_lt_sub - -protected theorem sub_add_lt_sub (h₁ : m + k ≤ n) (h₂ : 0 < k) : n - (m + k) < n - m := by - rw [← Nat.sub_sub]; exact Nat.sub_lt_of_pos_le h₂ (Nat.le_sub_of_add_le' h₁) - -theorem le_sub_one_of_lt : a < b → a ≤ b - 1 := Nat.le_pred_of_lt - -theorem sub_one_lt_of_le (h₀ : 0 < a) (h₁ : a ≤ b) : a - 1 < b := - Nat.lt_of_lt_of_le (Nat.pred_lt' h₀) h₁ - -theorem sub_lt_succ (a b) : a - b < succ a := lt_succ_of_le (sub_le a b) - -theorem sub_one_sub_lt (h : i < n) : n - 1 - i < n := by - rw [Nat.sub_right_comm]; exact Nat.sub_one_lt_of_le (Nat.sub_pos_of_lt h) (Nat.sub_le ..) - -protected theorem exists_eq_add_of_le (h : m ≤ n) : ∃ k : Nat, n = m + k := - ⟨n - m, (add_sub_of_le h).symm⟩ - -protected theorem exists_eq_add_of_le' (h : m ≤ n) : ∃ k : Nat, n = k + m := - ⟨n - m, (Nat.sub_add_cancel h).symm⟩ - -protected theorem exists_eq_add_of_lt (h : m < n) : ∃ k : Nat, n = m + k + 1 := - ⟨n - (m + 1), by rw [Nat.add_right_comm, add_sub_of_le h]⟩ - /-! ### min/max -/ -theorem succ_min_succ (x y) : min (succ x) (succ y) = succ (min x y) := by - cases Nat.le_total x y with - | inl h => rw [Nat.min_eq_left h, Nat.min_eq_left (Nat.succ_le_succ h)] - | inr h => rw [Nat.min_eq_right h, Nat.min_eq_right (Nat.succ_le_succ h)] - -@[simp] protected theorem min_self (a : Nat) : min a a = a := Nat.min_eq_left (Nat.le_refl _) - -@[simp] protected theorem zero_min (a) : min 0 a = 0 := Nat.min_eq_left (Nat.zero_le _) - -@[simp] protected theorem min_zero (a) : min a 0 = 0 := Nat.min_eq_right (Nat.zero_le _) - -protected theorem min_assoc : ∀ (a b c : Nat), min (min a b) c = min a (min b c) - | 0, _, _ => by rw [Nat.zero_min, Nat.zero_min, Nat.zero_min] - | _, 0, _ => by rw [Nat.zero_min, Nat.min_zero, Nat.zero_min] - | _, _, 0 => by rw [Nat.min_zero, Nat.min_zero, Nat.min_zero] - | _+1, _+1, _+1 => by simp only [Nat.succ_min_succ]; exact congrArg succ <| Nat.min_assoc .. - -protected theorem sub_sub_eq_min : ∀ (a b : Nat), a - (a - b) = min a b - | 0, _ => by rw [Nat.zero_sub, Nat.zero_min] - | _, 0 => by rw [Nat.sub_zero, Nat.sub_self, Nat.min_zero] - | _+1, _+1 => by - rw [Nat.succ_sub_succ, Nat.succ_min_succ, Nat.succ_sub (Nat.sub_le ..)] - exact congrArg succ <| Nat.sub_sub_eq_min .. - -protected theorem sub_eq_sub_min (n m : Nat) : n - m = n - min n m := by - cases Nat.le_total n m with - | inl h => rw [Nat.min_eq_left h, Nat.sub_eq_zero_of_le h, Nat.sub_self] - | inr h => rw [Nat.min_eq_right h] - -@[simp] protected theorem sub_add_min_cancel (n m : Nat) : n - m + min n m = n := by - rw [Nat.sub_eq_sub_min, Nat.sub_add_cancel (Nat.min_le_left ..)] - -protected theorem max_eq_right {a b : Nat} (h : a ≤ b) : max a b = b := if_pos h - -protected theorem max_eq_left {a b : Nat} (h : b ≤ a) : max a b = a := by - rw [Nat.max_comm]; exact Nat.max_eq_right h - -protected theorem succ_max_succ (x y) : max (succ x) (succ y) = succ (max x y) := by - cases Nat.le_total x y with - | inl h => rw [Nat.max_eq_right h, Nat.max_eq_right (Nat.succ_le_succ h)] - | inr h => rw [Nat.max_eq_left h, Nat.max_eq_left (Nat.succ_le_succ h)] - -protected theorem max_le_of_le_of_le {a b c : Nat} : a ≤ c → b ≤ c → max a b ≤ c := by - intros; cases Nat.le_total a b with - | inl h => rw [Nat.max_eq_right h]; assumption - | inr h => rw [Nat.max_eq_left h]; assumption - -protected theorem max_le {a b c : Nat} : max a b ≤ c ↔ a ≤ c ∧ b ≤ c := - ⟨fun h => ⟨Nat.le_trans (Nat.le_max_left ..) h, Nat.le_trans (Nat.le_max_right ..) h⟩, - fun ⟨h₁, h₂⟩ => Nat.max_le_of_le_of_le h₁ h₂⟩ - -protected theorem max_lt {a b c : Nat} : max a b < c ↔ a < c ∧ b < c := by - rw [← Nat.succ_le, ← Nat.succ_max_succ a b]; exact Nat.max_le - -@[simp] protected theorem max_self (a : Nat) : max a a = a := Nat.max_eq_right (Nat.le_refl _) - -@[simp] protected theorem zero_max (a) : max 0 a = a := Nat.max_eq_right (Nat.zero_le _) - -@[simp] protected theorem max_zero (a) : max a 0 = a := Nat.max_eq_left (Nat.zero_le _) - -protected theorem max_assoc : ∀ (a b c : Nat), max (max a b) c = max a (max b c) - | 0, _, _ => by rw [Nat.zero_max, Nat.zero_max] - | _, 0, _ => by rw [Nat.zero_max, Nat.max_zero] - | _, _, 0 => by rw [Nat.max_zero, Nat.max_zero] - | _+1, _+1, _+1 => by simp only [Nat.succ_max_succ]; exact congrArg succ <| Nat.max_assoc .. - -protected theorem sub_add_eq_max (a b : Nat) : a - b + b = max a b := by - match Nat.le_total a b with - | .inl hl => rw [Nat.max_eq_right hl, Nat.sub_eq_zero_iff_le.mpr hl, Nat.zero_add] - | .inr hr => rw [Nat.max_eq_left hr, Nat.sub_add_cancel hr] - -protected theorem sub_eq_max_sub (n m : Nat) : n - m = max n m - m := by - cases Nat.le_total m n with - | inl h => rw [Nat.max_eq_left h] - | inr h => rw [Nat.max_eq_right h, Nat.sub_eq_zero_of_le h, Nat.sub_self] - -protected theorem max_min_distrib_left : ∀ (a b c : Nat), max a (min b c) = min (max a b) (max a c) - | 0, _, _ => by simp only [Nat.zero_max] - | _, 0, _ => by - rw [Nat.zero_min, Nat.max_zero] - exact Nat.min_eq_left (Nat.le_max_left ..) |>.symm - | _, _, 0 => by - rw [Nat.min_zero, Nat.max_zero] - exact Nat.min_eq_right (Nat.le_max_left ..) |>.symm - | _+1, _+1, _+1 => by - simp only [Nat.succ_max_succ, Nat.succ_min_succ] - exact congrArg succ <| Nat.max_min_distrib_left .. - -protected theorem min_max_distrib_left : ∀ (a b c : Nat), min a (max b c) = max (min a b) (min a c) - | 0, _, _ => by simp only [Nat.zero_min, Nat.max_self] - | _, 0, _ => by simp only [Nat.min_zero, Nat.zero_max] - | _, _, 0 => by simp only [Nat.min_zero, Nat.max_zero] - | _+1, _+1, _+1 => by - simp only [Nat.succ_max_succ, Nat.succ_min_succ] - exact congrArg succ <| Nat.min_max_distrib_left .. - -protected theorem max_min_distrib_right (a b c : Nat) : - max (min a b) c = min (max a c) (max b c) := by - repeat rw [Nat.max_comm _ c] - exact Nat.max_min_distrib_left .. - -protected theorem min_max_distrib_right (a b c : Nat) : - min (max a b) c = max (min a c) (min b c) := by - repeat rw [Nat.min_comm _ c] - exact Nat.min_max_distrib_left .. - -protected theorem add_max_add_right : ∀ (a b c : Nat), max (a + c) (b + c) = max a b + c - | _, _, 0 => rfl - | _, _, _+1 => Eq.trans (Nat.succ_max_succ ..) <| congrArg _ (Nat.add_max_add_right ..) - -protected theorem add_min_add_right : ∀ (a b c : Nat), min (a + c) (b + c) = min a b + c - | _, _, 0 => rfl - | _, _, _+1 => Eq.trans (Nat.succ_min_succ ..) <| congrArg _ (Nat.add_min_add_right ..) - -protected theorem add_max_add_left (a b c : Nat) : max (a + b) (a + c) = a + max b c := by - repeat rw [Nat.add_comm a] - exact Nat.add_max_add_right .. - -protected theorem add_min_add_left (a b c : Nat) : min (a + b) (a + c) = a + min b c := by - repeat rw [Nat.add_comm a] - exact Nat.add_min_add_right .. - -protected theorem pred_min_pred : ∀ (x y), min (pred x) (pred y) = pred (min x y) - | 0, _ => by simp only [Nat.pred_zero, Nat.zero_min] - | _, 0 => by simp only [Nat.pred_zero, Nat.min_zero] - | _+1, _+1 => by simp only [Nat.pred_succ, Nat.succ_min_succ] - -protected theorem pred_max_pred : ∀ (x y), max (pred x) (pred y) = pred (max x y) - | 0, _ => by simp only [Nat.pred_zero, Nat.zero_max] - | _, 0 => by simp only [Nat.pred_zero, Nat.max_zero] - | _+1, _+1 => by simp only [Nat.pred_succ, Nat.succ_max_succ] - -protected theorem sub_min_sub_right : ∀ (a b c : Nat), min (a - c) (b - c) = min a b - c - | _, _, 0 => rfl - | _, _, _+1 => Eq.trans (Nat.pred_min_pred ..) <| congrArg _ (Nat.sub_min_sub_right ..) - -protected theorem sub_max_sub_right : ∀ (a b c : Nat), max (a - c) (b - c) = max a b - c - | _, _, 0 => rfl - | _, _, _+1 => Eq.trans (Nat.pred_max_pred ..) <| congrArg _ (Nat.sub_max_sub_right ..) - protected theorem sub_min_sub_left (a b c : Nat) : min (a - b) (a - c) = a - max b c := by induction b, c using Nat.recDiagAux with | zero_left => rw [Nat.sub_zero, Nat.zero_max]; exact Nat.min_eq_right (Nat.sub_le ..) @@ -678,477 +236,18 @@ protected theorem mul_min_mul_left (a b c : Nat) : min (a * b) (a * c) = a * min /-! ### mul -/ -@[deprecated Nat.mul_le_mul_left] -protected theorem mul_le_mul_of_nonneg_left {a b c : Nat} : a ≤ b → c * a ≤ c * b := - Nat.mul_le_mul_left c - -@[deprecated Nat.mul_le_mul_right] -protected theorem mul_le_mul_of_nonneg_right {a b c : Nat} : a ≤ b → a * c ≤ b * c := - Nat.mul_le_mul_right c - -protected theorem mul_right_comm (n m k : Nat) : n * m * k = n * k * m := by - rw [Nat.mul_assoc, Nat.mul_comm m, ← Nat.mul_assoc] - -protected theorem mul_mul_mul_comm (a b c d : Nat) : (a * b) * (c * d) = (a * c) * (b * d) := by - rw [Nat.mul_assoc, Nat.mul_assoc, Nat.mul_left_comm b] - -protected theorem mul_two (n) : n * 2 = n + n := by rw [Nat.mul_succ, Nat.mul_one] - -protected theorem two_mul (n) : 2 * n = n + n := by rw [Nat.succ_mul, Nat.one_mul] - -theorem mul_eq_zero : ∀ {m n}, n * m = 0 ↔ n = 0 ∨ m = 0 - | 0, _ => ⟨fun _ => .inr rfl, fun _ => rfl⟩ - | _, 0 => ⟨fun _ => .inl rfl, fun _ => Nat.zero_mul ..⟩ - | _+1, _+1 => ⟨nofun, nofun⟩ - -protected theorem mul_ne_zero_iff : n * m ≠ 0 ↔ n ≠ 0 ∧ m ≠ 0 := by rw [ne_eq, mul_eq_zero, not_or] - -protected theorem mul_ne_zero : n ≠ 0 → m ≠ 0 → n * m ≠ 0 := (Nat.mul_ne_zero_iff.2 ⟨·,·⟩) - -protected theorem ne_zero_of_mul_ne_zero_left (h : n * m ≠ 0) : n ≠ 0 := - (Nat.mul_ne_zero_iff.1 h).1 - -protected theorem mul_left_cancel {n m k : Nat} (np : 0 < n) (h : n * m = n * k) : m = k := by - match Nat.lt_trichotomy m k with - | Or.inl p => - have r : n * m < n * k := Nat.mul_lt_mul_of_pos_left p np - simp [h] at r - | Or.inr (Or.inl p) => exact p - | Or.inr (Or.inr p) => - have r : n * k < n * m := Nat.mul_lt_mul_of_pos_left p np - simp [h] at r - -protected theorem mul_right_cancel {n m k : Nat} (mp : 0 < m) (h : n * m = k * m) : n = k := by - simp [Nat.mul_comm _ m] at h - apply Nat.mul_left_cancel mp h - -protected theorem mul_left_cancel_iff {n: Nat} (p : 0 < n) (m k : Nat) : n * m = n * k ↔ m = k := - ⟨Nat.mul_left_cancel p, fun | rfl => rfl⟩ - -protected theorem mul_right_cancel_iff {m : Nat} (p : 0 < m) (n k : Nat) : n * m = k * m ↔ n = k := - ⟨Nat.mul_right_cancel p, fun | rfl => rfl⟩ - -protected theorem ne_zero_of_mul_ne_zero_right (h : n * m ≠ 0) : m ≠ 0 := - (Nat.mul_ne_zero_iff.1 h).2 - -protected theorem le_mul_of_pos_left (m) (h : 0 < n) : m ≤ n * m := - Nat.le_trans (Nat.le_of_eq (Nat.one_mul _).symm) (Nat.mul_le_mul_right _ h) - -protected theorem le_mul_of_pos_right (n) (h : 0 < m) : n ≤ n * m := - Nat.le_trans (Nat.le_of_eq (Nat.mul_one _).symm) (Nat.mul_le_mul_left _ h) - -protected theorem mul_lt_mul_of_lt_of_le (hac : a < c) (hbd : b ≤ d) (hd : 0 < d) : - a * b < c * d := - Nat.lt_of_le_of_lt (Nat.mul_le_mul_left _ hbd) (Nat.mul_lt_mul_of_pos_right hac hd) - -protected theorem mul_lt_mul_of_lt_of_le' (hac : a < c) (hbd : b ≤ d) (hb : 0 < b) : - a * b < c * d := - Nat.mul_lt_mul_of_lt_of_le hac hbd (Nat.lt_of_lt_of_le hb hbd) - @[deprecated] protected alias mul_lt_mul := Nat.mul_lt_mul_of_lt_of_le' -protected theorem mul_lt_mul_of_le_of_lt (hac : a ≤ c) (hbd : b < d) (hc : 0 < c) : - a * b < c * d := - Nat.lt_of_le_of_lt (Nat.mul_le_mul_right _ hac) (Nat.mul_lt_mul_of_pos_left hbd hc) - -protected theorem mul_lt_mul_of_le_of_lt' (hac : a ≤ c) (hbd : b < d) (ha : 0 < a) : - a * b < c * d := - Nat.mul_lt_mul_of_le_of_lt hac hbd (Nat.lt_of_lt_of_le ha hac) - @[deprecated] protected alias mul_lt_mul' := Nat.mul_lt_mul_of_le_of_lt -protected theorem mul_lt_mul_of_lt_of_lt {a b c d : Nat} (hac : a < c) (hbd : b < d) : - a * b < c * d := - Nat.mul_lt_mul_of_le_of_lt (Nat.le_of_lt hac) hbd (Nat.zero_lt_of_lt hac) - -theorem succ_mul_succ (a b) : succ a * succ b = a * b + a + b + 1 := by - rw [succ_mul, mul_succ]; rfl -theorem mul_le_add_right (m k n : Nat) : k * m ≤ m + n ↔ (k-1) * m ≤ n := by - match k with - | 0 => - simp - | succ k => - simp [succ_mul, Nat.add_comm _ m, Nat.add_le_add_iff_left] - -theorem succ_mul_succ_eq (a b : Nat) : succ a * succ b = a * b + a + b + 1 := by - rw [mul_succ, succ_mul, Nat.add_right_comm _ a]; rfl - -protected theorem mul_self_sub_mul_self_eq (a b : Nat) : a * a - b * b = (a + b) * (a - b) := by - rw [Nat.mul_sub_left_distrib, Nat.right_distrib, Nat.right_distrib, Nat.mul_comm b a, - Nat.sub_add_eq, Nat.add_sub_cancel] - -protected theorem pos_of_mul_pos_left {a b : Nat} (h : 0 < a * b) : 0 < b := by - by_contra w; simp_all - -protected theorem pos_of_mul_pos_right {a b : Nat} (h : 0 < a * b) : 0 < a := by - by_contra w; simp_all - -@[simp] protected theorem mul_pos_iff_of_pos_left {a b : Nat} (h : 0 < a) : - 0 < a * b ↔ 0 < b := - ⟨Nat.pos_of_mul_pos_left, Nat.mul_pos h⟩ - -@[simp] protected theorem mul_pos_iff_of_pos_right {a b : Nat} (h : 0 < b) : - 0 < a * b ↔ 0 < a := - ⟨Nat.pos_of_mul_pos_right, fun w => Nat.mul_pos w h⟩ - /-! ### div/mod -/ -- TODO mod_core_congr, mod_def -- TODO div_core_congr, div_def -protected theorem div_le_of_le_mul {m n : Nat} : ∀ {k}, m ≤ k * n → m / k ≤ n - | 0, _ => by simp [Nat.div_zero, n.zero_le] - | succ k, h => by - suffices succ k * (m / succ k) ≤ succ k * n from - Nat.le_of_mul_le_mul_left this (zero_lt_succ _) - have h1 : succ k * (m / succ k) ≤ m % succ k + succ k * (m / succ k) := Nat.le_add_left _ _ - have h2 : m % succ k + succ k * (m / succ k) = m := by rw [mod_add_div] - have h3 : m ≤ succ k * n := h - rw [← h2] at h3 - exact Nat.le_trans h1 h3 - -@[simp] theorem mul_div_right (n : Nat) {m : Nat} (H : 0 < m) : m * n / m = n := by - induction n <;> simp_all [mul_succ] - -@[simp] theorem mul_div_left (m : Nat) {n : Nat} (H : 0 < n) : m * n / n = m := by - rw [Nat.mul_comm, mul_div_right _ H] - -protected theorem div_self (H : 0 < n) : n / n = 1 := by - let t := add_div_right 0 H - rwa [Nat.zero_add, Nat.zero_div] at t - -protected theorem mul_div_cancel (m : Nat) {n : Nat} (H : 0 < n) : m * n / n = m := by - let t := add_mul_div_right 0 m H - rwa [Nat.zero_add, Nat.zero_div, Nat.zero_add] at t - -protected theorem mul_div_cancel_left (m : Nat) {n : Nat} (H : 0 < n) : n * m / n = m := -by rw [Nat.mul_comm, Nat.mul_div_cancel _ H] - -protected theorem div_eq_of_eq_mul_left (H1 : 0 < n) (H2 : m = k * n) : m / n = k := -by rw [H2, Nat.mul_div_cancel _ H1] - -protected theorem div_eq_of_eq_mul_right (H1 : 0 < n) (H2 : m = n * k) : m / n = k := -by rw [H2, Nat.mul_div_cancel_left _ H1] - -protected theorem div_div_eq_div_mul (m n k : Nat) : m / n / k = m / (n * k) := by - cases eq_zero_or_pos k with - | inl k0 => rw [k0, Nat.mul_zero, Nat.div_zero, Nat.div_zero] | inr kpos => ?_ - cases eq_zero_or_pos n with - | inl n0 => rw [n0, Nat.zero_mul, Nat.div_zero, Nat.zero_div] | inr npos => ?_ - apply Nat.le_antisymm - · apply (le_div_iff_mul_le (Nat.mul_pos npos kpos)).2 - rw [Nat.mul_comm n k, ← Nat.mul_assoc] - apply (le_div_iff_mul_le npos).1 - apply (le_div_iff_mul_le kpos).1 - (apply Nat.le_refl) - · apply (le_div_iff_mul_le kpos).2 - apply (le_div_iff_mul_le npos).2 - rw [Nat.mul_assoc, Nat.mul_comm n k] - apply (le_div_iff_mul_le (Nat.mul_pos kpos npos)).1 - apply Nat.le_refl - -protected theorem mul_div_mul_left {m : Nat} (n k : Nat) (H : 0 < m) : - m * n / (m * k) = n / k := by rw [← Nat.div_div_eq_div_mul, Nat.mul_div_cancel_left _ H] - -protected theorem mul_div_mul_right {m : Nat} (n k : Nat) (H : 0 < m) : - n * m / (k * m) = n / k := by rw [Nat.mul_comm, Nat.mul_comm k, Nat.mul_div_mul_left _ _ H] - -theorem mul_div_le (m n : Nat) : n * (m / n) ≤ m := by - match n, Nat.eq_zero_or_pos n with - | _, Or.inl rfl => rw [Nat.zero_mul]; exact m.zero_le - | n, Or.inr h => rw [Nat.mul_comm, ← Nat.le_div_iff_mul_le h]; exact Nat.le_refl _ - -theorem mod_two_eq_zero_or_one (n : Nat) : n % 2 = 0 ∨ n % 2 = 1 := - match n % 2, @Nat.mod_lt n 2 (by decide) with - | 0, _ => .inl rfl - | 1, _ => .inr rfl - -theorem le_of_mod_lt {a b : Nat} (h : a % b < a) : b ≤ a := - Nat.not_lt.1 fun hf => (ne_of_lt h).elim (Nat.mod_eq_of_lt hf) - -theorem mul_mod_mul_right (z x y : Nat) : (x * z) % (y * z) = (x % y) * z := by - rw [Nat.mul_comm x z, Nat.mul_comm y z, Nat.mul_comm (x % y) z]; apply mul_mod_mul_left - -@[simp] theorem mod_mod_of_dvd (a : Nat) (h : c ∣ b) : a % b % c = a % c := by - conv => - rhs - rw [← mod_add_div a b] - obtain ⟨x, rfl⟩ := h - rw [Nat.mul_assoc, add_mul_mod_self_left] - -- TODO cont_to_bool_mod_two -theorem sub_mul_mod {x k n : Nat} (h₁ : n*k ≤ x) : (x - n*k) % n = x % n := by - match k with - | 0 => rw [Nat.mul_zero, Nat.sub_zero] - | succ k => - have h₂ : n * k ≤ x := Nat.le_trans (le_add_right _ n) h₁ - have h₄ : x - n * k ≥ n := by - apply Nat.le_of_add_le_add_right (b := n * k) - rw [Nat.sub_add_cancel h₂] - simp [mul_succ, Nat.add_comm] at h₁; simp [h₁] - rw [mul_succ, ← Nat.sub_sub, ← mod_eq_sub_mod h₄, sub_mul_mod h₂] - -@[simp] theorem mod_mod (a n : Nat) : (a % n) % n = a % n := - match eq_zero_or_pos n with - | .inl n0 => by simp [n0, mod_zero] - | .inr npos => Nat.mod_eq_of_lt (mod_lt _ npos) - -theorem mul_mod (a b n : Nat) : a * b % n = (a % n) * (b % n) % n := by - conv => lhs; rw [ - ← mod_add_div a n, ← mod_add_div b n, Nat.add_mul, Nat.mul_add, Nat.mul_add, - Nat.mul_assoc, Nat.mul_assoc, ← Nat.mul_add n, add_mul_mod_self_left, - Nat.mul_comm _ (n * (b / n)), Nat.mul_assoc, add_mul_mod_self_left] - -@[simp] theorem mod_add_mod (m n k : Nat) : (m % n + k) % n = (m + k) % n := by - have := (add_mul_mod_self_left (m % n + k) n (m / n)).symm - rwa [Nat.add_right_comm, mod_add_div] at this - -@[simp] theorem add_mod_mod (m n k : Nat) : (m + n % k) % k = (m + n) % k := by - rw [Nat.add_comm, mod_add_mod, Nat.add_comm] - -theorem add_mod (a b n : Nat) : (a + b) % n = ((a % n) + (b % n)) % n := by - rw [add_mod_mod, mod_add_mod] - -/-! ### pow -/ - -theorem pow_succ' {m n : Nat} : m ^ n.succ = m * m ^ n := by - rw [Nat.pow_succ, Nat.mul_comm] - -@[simp] theorem pow_eq {m n : Nat} : m.pow n = m ^ n := rfl - -theorem shiftLeft_eq (a b : Nat) : a <<< b = a * 2 ^ b := - match b with - | 0 => (Nat.mul_one _).symm - | b+1 => (shiftLeft_eq _ b).trans <| by - simp [pow_succ, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm] - -theorem one_shiftLeft (n : Nat) : 1 <<< n = 2 ^ n := by rw [shiftLeft_eq, Nat.one_mul] - -attribute [simp] Nat.pow_zero - -protected theorem zero_pow {n : Nat} (H : 0 < n) : 0 ^ n = 0 := by - match n with - | 0 => contradiction - | n+1 => rw [Nat.pow_succ, Nat.mul_zero] - -@[simp] protected theorem one_pow (n : Nat) : 1 ^ n = 1 := by - induction n with - | zero => rfl - | succ _ ih => rw [Nat.pow_succ, Nat.mul_one, ih] - -@[simp] protected theorem pow_one (a : Nat) : a ^ 1 = a := by - rw [Nat.pow_succ, Nat.pow_zero, Nat.one_mul] - -protected theorem pow_two (a : Nat) : a ^ 2 = a * a := by rw [Nat.pow_succ, Nat.pow_one] - -protected theorem pow_add (a m n : Nat) : a ^ (m + n) = a ^ m * a ^ n := by - induction n with - | zero => rw [Nat.add_zero, Nat.pow_zero, Nat.mul_one] - | succ _ ih => rw [Nat.add_succ, Nat.pow_succ, Nat.pow_succ, ih, Nat.mul_assoc] - -protected theorem pow_add' (a m n : Nat) : a ^ (m + n) = a ^ n * a ^ m := by - rw [← Nat.pow_add, Nat.add_comm] - -protected theorem pow_mul (a m n : Nat) : a ^ (m * n) = (a ^ m) ^ n := by - induction n with - | zero => rw [Nat.mul_zero, Nat.pow_zero, Nat.pow_zero] - | succ _ ih => rw [Nat.mul_succ, Nat.pow_add, Nat.pow_succ, ih] - -protected theorem pow_mul' (a m n : Nat) : a ^ (m * n) = (a ^ n) ^ m := by - rw [← Nat.pow_mul, Nat.mul_comm] - -protected theorem pow_right_comm (a m n : Nat) : (a ^ m) ^ n = (a ^ n) ^ m := by - rw [← Nat.pow_mul, Nat.pow_mul'] - -protected theorem mul_pow (a b n : Nat) : (a * b) ^ n = a ^ n * b ^ n := by - induction n with - | zero => rw [Nat.pow_zero, Nat.pow_zero, Nat.pow_zero, Nat.mul_one] - | succ _ ih => rw [Nat.pow_succ, Nat.pow_succ, Nat.pow_succ, Nat.mul_mul_mul_comm, ih] - -protected alias pow_le_pow_left := pow_le_pow_of_le_left -protected alias pow_le_pow_right := pow_le_pow_of_le_right - -protected theorem one_lt_two_pow (h : n ≠ 0) : 1 < 2 ^ n := - match n, h with - | n+1, _ => by - rw [Nat.pow_succ', ← Nat.one_mul 1] - exact Nat.mul_lt_mul_of_lt_of_le' (by decide) (Nat.two_pow_pos n) (by decide) - -@[simp] protected theorem one_lt_two_pow_iff : 1 < 2 ^ n ↔ n ≠ 0 := - ⟨(by intro h p; subst p; simp at h), Nat.one_lt_two_pow⟩ - -protected theorem one_le_two_pow : 1 ≤ 2 ^ n := by - if h : n = 0 then - subst h; simp - else - exact Nat.le_of_lt (Nat.one_lt_two_pow h) - -protected theorem pow_pos (h : 0 < a) : 0 < a^n := - match n with - | 0 => Nat.zero_lt_one - | _ + 1 => Nat.mul_pos (Nat.pow_pos h) h - -protected theorem pow_lt_pow_succ (h : 1 < a) : a ^ n < a ^ (n + 1) := by - rw [Nat.pow_succ] - conv => lhs; rw [← Nat.mul_one (a^n)] - exact Nat.mul_lt_mul_of_le_of_lt (Nat.le_refl _) h (Nat.pow_pos (Nat.lt_trans Nat.zero_lt_one h)) - -protected theorem pow_lt_pow_of_lt {a n m : Nat} (h : 1 < a) (w : n < m) : a ^ n < a ^ m := by - have := Nat.exists_eq_add_of_lt w - cases this - case intro k p => - rw [Nat.add_right_comm] at p - subst p - rw [Nat.pow_add] - conv => lhs; rw [← Nat.mul_one (a^n)] - have t : 0 < a ^ k := Nat.pow_pos (Nat.lt_trans Nat.zero_lt_one h) - exact Nat.mul_lt_mul_of_lt_of_le (Nat.pow_lt_pow_succ h) t t - -protected theorem pow_le_pow_of_le {a n m : Nat} (h : 1 < a) (w : n ≤ m) : a ^ n ≤ a ^ m := by - cases Nat.lt_or_eq_of_le w - case inl lt => - exact Nat.le_of_lt (Nat.pow_lt_pow_of_lt h lt) - case inr eq => - subst eq - exact Nat.le_refl _ - -protected theorem pow_le_pow_iff_right {a n m : Nat} (h : 1 < a) : - a ^ n ≤ a ^ m ↔ n ≤ m := by - constructor - · by_contra w - simp [Decidable.not_imp_iff_and_not] at w - apply Nat.lt_irrefl (a ^ n) - exact Nat.lt_of_le_of_lt w.1 (Nat.pow_lt_pow_of_lt h w.2) - · intro w - cases Nat.eq_or_lt_of_le w - case inl eq => subst eq; apply Nat.le_refl - case inr lt => exact Nat.le_of_lt (Nat.pow_lt_pow_of_lt h lt) - -protected theorem pow_lt_pow_iff_right {a n m : Nat} (h : 1 < a) : - a ^ n < a ^ m ↔ n < m := by - constructor - · by_contra w - simp at w - apply Nat.lt_irrefl (a ^ n) - exact Nat.lt_of_lt_of_le w.1 (Nat.pow_le_pow_of_le h w.2) - · intro w - exact Nat.pow_lt_pow_of_lt h w - -/-! ### log2 -/ - -theorem le_log2 (h : n ≠ 0) : k ≤ n.log2 ↔ 2 ^ k ≤ n := by - match k with - | 0 => simp [show 1 ≤ n from Nat.pos_of_ne_zero h] - | k+1 => - rw [log2]; split - · have n0 : 0 < n / 2 := (Nat.le_div_iff_mul_le (by decide)).2 ‹_› - simp only [Nat.add_le_add_iff_right, le_log2 (Nat.ne_of_gt n0), le_div_iff_mul_le, - Nat.pow_succ] - exact Nat.le_div_iff_mul_le (by decide) - · simp only [le_zero_eq, succ_ne_zero, false_iff] - refine mt (Nat.le_trans ?_) ‹_› - exact Nat.pow_le_pow_of_le_right Nat.zero_lt_two (Nat.le_add_left 1 k) - -theorem log2_lt (h : n ≠ 0) : n.log2 < k ↔ n < 2 ^ k := by - rw [← Nat.not_le, ← Nat.not_le, le_log2 h] - -theorem log2_self_le (h : n ≠ 0) : 2 ^ n.log2 ≤ n := (le_log2 h).1 (Nat.le_refl _) - -theorem lt_log2_self : n < 2 ^ (n.log2 + 1) := - match n with - | 0 => Nat.zero_lt_two - | n+1 => (log2_lt n.succ_ne_zero).1 (Nat.le_refl _) - -/-! ### dvd -/ - -theorem dvd_sub {k m n : Nat} (H : n ≤ m) (h₁ : k ∣ m) (h₂ : k ∣ n) : k ∣ m - n := - (Nat.dvd_add_iff_left h₂).2 <| by rwa [Nat.sub_add_cancel H] - -protected theorem mul_dvd_mul {a b c d : Nat} : a ∣ b → c ∣ d → a * c ∣ b * d - | ⟨e, he⟩, ⟨f, hf⟩ => - ⟨e * f, by simp [he, hf, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm]⟩ - -protected theorem mul_dvd_mul_left (a : Nat) (h : b ∣ c) : a * b ∣ a * c := - Nat.mul_dvd_mul (Nat.dvd_refl a) h - -protected theorem mul_dvd_mul_right (h: a ∣ b) (c : Nat) : a * c ∣ b * c := - Nat.mul_dvd_mul h (Nat.dvd_refl c) - -@[simp] theorem dvd_one {n : Nat} : n ∣ 1 ↔ n = 1 := - ⟨eq_one_of_dvd_one, fun h => h.symm ▸ Nat.dvd_refl _⟩ - -protected theorem mul_div_assoc (m : Nat) (H : k ∣ n) : m * n / k = m * (n / k) := by - match Nat.eq_zero_or_pos k with - | .inl h0 => rw [h0, Nat.div_zero, Nat.div_zero, Nat.mul_zero] - | .inr hpos => - have h1 : m * n / k = m * (n / k * k) / k := by rw [Nat.div_mul_cancel H] - rw [h1, ← Nat.mul_assoc, Nat.mul_div_cancel _ hpos] - -protected theorem dvd_of_mul_dvd_mul_left - (kpos : 0 < k) (H : k * m ∣ k * n) : m ∣ n := by - let ⟨l, H⟩ := H - rw [Nat.mul_assoc] at H - exact ⟨_, Nat.eq_of_mul_eq_mul_left kpos H⟩ - -protected theorem dvd_of_mul_dvd_mul_right (kpos : 0 < k) (H : m * k ∣ n * k) : m ∣ n := by - rw [Nat.mul_comm m k, Nat.mul_comm n k] at H; exact Nat.dvd_of_mul_dvd_mul_left kpos H - -theorem pow_dvd_pow_iff_pow_le_pow {k l : Nat} : - ∀ {x : Nat}, 0 < x → (x ^ k ∣ x ^ l ↔ x ^ k ≤ x ^ l) - | x + 1, w => by - constructor - · intro a - exact le_of_dvd (Nat.pow_pos (succ_pos x)) a - · intro a - cases x - case zero => simp - case succ x => - have le := - (Nat.pow_le_pow_iff_right (Nat.succ_le_succ (Nat.succ_le_succ (Nat.zero_le _)))).mp a - refine ⟨(x + 2) ^ (l - k), ?_⟩ - rw [← Nat.pow_add, Nat.add_comm k, Nat.sub_add_cancel le] - -/-- If `1 < x`, then `x^k` divides `x^l` if and only if `k` is at most `l`. -/ -theorem pow_dvd_pow_iff_le_right {x k l : Nat} (w : 1 < x) : x ^ k ∣ x ^ l ↔ k ≤ l := by - rw [pow_dvd_pow_iff_pow_le_pow (lt_of_succ_lt w), Nat.pow_le_pow_iff_right w] - -theorem pow_dvd_pow_iff_le_right' {b k l : Nat} : (b + 2) ^ k ∣ (b + 2) ^ l ↔ k ≤ l := - pow_dvd_pow_iff_le_right (Nat.lt_of_sub_eq_succ rfl) - -protected theorem eq_mul_of_div_eq_right {a b c : Nat} (H1 : b ∣ a) (H2 : a / b = c) : - a = b * c := by - rw [← H2, Nat.mul_div_cancel' H1] - -protected theorem div_eq_iff_eq_mul_right {a b c : Nat} (H : 0 < b) (H' : b ∣ a) : - a / b = c ↔ a = b * c := - ⟨Nat.eq_mul_of_div_eq_right H', Nat.div_eq_of_eq_mul_right H⟩ - -protected theorem div_eq_iff_eq_mul_left {a b c : Nat} (H : 0 < b) (H' : b ∣ a) : - a / b = c ↔ a = c * b := by - rw [Nat.mul_comm]; exact Nat.div_eq_iff_eq_mul_right H H' - -protected theorem pow_dvd_pow {m n : Nat} (a : Nat) (h : m ≤ n) : a ^ m ∣ a ^ n := by - cases Nat.exists_eq_add_of_le h - case intro k p => - subst p - rw [Nat.pow_add] - apply Nat.dvd_mul_right - -protected theorem pow_sub_mul_pow (a : Nat) {m n : Nat} (h : m ≤ n) : - a ^ (n - m) * a ^ m = a ^ n := by - rw [← Nat.pow_add, Nat.sub_add_cancel h] - -theorem pow_dvd_of_le_of_pow_dvd {p m n k : Nat} (hmn : m ≤ n) (hdiv : p ^ n ∣ k) : p ^ m ∣ k := - Nat.dvd_trans (Nat.pow_dvd_pow _ hmn) hdiv - -theorem dvd_of_pow_dvd {p k m : Nat} (hk : 1 ≤ k) (hpk : p ^ k ∣ m) : p ∣ m := by - rw [← Nat.pow_one p]; exact pow_dvd_of_le_of_pow_dvd hk hpk - -protected theorem pow_div {x m n : Nat} (h : n ≤ m) (hx : 0 < x) : x ^ m / x ^ n = x ^ (m - n) := by - rw [Nat.div_eq_iff_eq_mul_left (Nat.pow_pos hx) (Nat.pow_dvd_pow _ h), Nat.pow_sub_mul_pow _ h] - /-! ### sum -/ @[simp] theorem sum_nil : Nat.sum [] = 0 := rfl @@ -1158,104 +257,5 @@ protected theorem pow_div {x m n : Nat} (h : n ≤ m) (hx : 0 < x) : x ^ m / x ^ @[simp] theorem sum_append : Nat.sum (l₁ ++ l₂) = Nat.sum l₁ + Nat.sum l₂ := by induction l₁ <;> simp [*, Nat.add_assoc] -/-! ### shiftLeft and shiftRight -/ - -@[simp] theorem shiftLeft_zero : n <<< 0 = n := rfl - -/-- Shiftleft on successor with multiple moved inside. -/ -theorem shiftLeft_succ_inside (m n : Nat) : m <<< (n+1) = (2*m) <<< n := rfl - -/-- Shiftleft on successor with multiple moved to outside. -/ -theorem shiftLeft_succ : ∀(m n), m <<< (n + 1) = 2 * (m <<< n) -| m, 0 => rfl -| m, k + 1 => by - rw [shiftLeft_succ_inside _ (k+1)] - rw [shiftLeft_succ _ k, shiftLeft_succ_inside] - -@[simp] theorem shiftRight_zero : n >>> 0 = n := rfl - -theorem shiftRight_succ (m n) : m >>> (n + 1) = (m >>> n) / 2 := rfl - -/-- Shiftright on successor with division moved inside. -/ -theorem shiftRight_succ_inside : ∀m n, m >>> (n+1) = (m/2) >>> n -| m, 0 => rfl -| m, k + 1 => by - rw [shiftRight_succ _ (k+1)] - rw [shiftRight_succ_inside _ k, shiftRight_succ] - -@[simp] theorem zero_shiftLeft : ∀ n, 0 <<< n = 0 - | 0 => by simp [shiftLeft] - | n + 1 => by simp [shiftLeft, zero_shiftLeft, shiftLeft_succ] - -@[simp] theorem zero_shiftRight : ∀ n, 0 >>> n = 0 - | 0 => by simp [shiftRight] - | n + 1 => by simp [shiftRight, zero_shiftRight, shiftRight_succ] - -theorem shiftRight_add (m n : Nat) : ∀ k, m >>> (n + k) = (m >>> n) >>> k - | 0 => rfl - | k + 1 => by simp [add_succ, shiftRight_add, shiftRight_succ] - -theorem shiftLeft_shiftLeft (m n : Nat) : ∀ k, (m <<< n) <<< k = m <<< (n + k) - | 0 => rfl - | k + 1 => by simp [add_succ, shiftLeft_shiftLeft _ _ k, shiftLeft_succ] - -theorem shiftRight_eq_div_pow (m : Nat) : ∀ n, m >>> n = m / 2 ^ n - | 0 => (Nat.div_one _).symm - | k + 1 => by - rw [shiftRight_add, shiftRight_eq_div_pow m k] - simp [Nat.div_div_eq_div_mul, ← Nat.pow_succ, shiftRight_succ] - -theorem mul_add_div {m : Nat} (m_pos : m > 0) (x y : Nat) : (m * x + y) / m = x + y / m := by - match x with - | 0 => simp - | x + 1 => - simp [Nat.mul_succ, Nat.add_assoc _ m, - mul_add_div m_pos x (m+y), - div_eq (m+y) m, - m_pos, - Nat.le_add_right m, Nat.add_succ, Nat.succ_add] - -theorem mul_add_mod (m x y : Nat) : (m * x + y) % m = y % m := by - match x with - | 0 => simp - | x + 1 => - simp [Nat.mul_succ, Nat.add_assoc _ m, mul_add_mod _ x] - -@[simp] theorem mod_div_self (m n : Nat) : m % n / n = 0 := by - cases n - · exact (m % 0).div_zero - · case succ n => exact Nat.div_eq_of_lt (m.mod_lt n.succ_pos) - -/-! ### Decidability of predicates -/ - -instance decidableBallLT : - ∀ (n : Nat) (P : ∀ k, k < n → Prop) [∀ n h, Decidable (P n h)], Decidable (∀ n h, P n h) -| 0, _, _ => isTrue fun _ => (by cases ·) -| n + 1, P, H => - match decidableBallLT n (P · <| lt_succ_of_lt ·) with - | isFalse h => isFalse (h fun _ _ => · _ _) - | isTrue h => - match H n Nat.le.refl with - | isFalse p => isFalse (p <| · _ _) - | isTrue p => isTrue fun _ h' => (Nat.lt_succ_iff_lt_or_eq.1 h').elim (h _) fun hn => hn ▸ p - -instance decidableForallFin (P : Fin n → Prop) [DecidablePred P] : Decidable (∀ i, P i) := - decidable_of_iff (∀ k h, P ⟨k, h⟩) ⟨fun m ⟨k, h⟩ => m k h, fun m k h => m ⟨k, h⟩⟩ - -instance decidableBallLE (n : Nat) (P : ∀ k, k ≤ n → Prop) [∀ n h, Decidable (P n h)] : - Decidable (∀ n h, P n h) := - decidable_of_iff (∀ (k) (h : k < succ n), P k (le_of_lt_succ h)) - ⟨fun m k h => m k (lt_succ_of_le h), fun m k _ => m k _⟩ - -instance decidableExistsLT [h : DecidablePred p] : DecidablePred fun n => ∃ m : Nat, m < n ∧ p m - | 0 => isFalse (by simp only [not_lt_zero, false_and, exists_const, not_false_eq_true]) - | n + 1 => - @decidable_of_decidable_of_iff _ _ (@instDecidableOr _ _ (decidableExistsLT (p := p) n) (h n)) - (by simp only [Nat.lt_succ_iff_lt_or_eq, or_and_right, exists_or, exists_eq_left]) - -instance decidableExistsLE [DecidablePred p] : DecidablePred fun n => ∃ m : Nat, m ≤ n ∧ p m := - fun n => decidable_of_iff (∃ m, m < n + 1 ∧ p m) - (exists_congr fun _ => and_congr_left' Nat.lt_succ_iff) - @[deprecated] protected alias lt_connex := Nat.lt_or_gt_of_ne @[deprecated] alias pow_two_pos := Nat.two_pow_pos -- deprecated 2024-02-09 diff --git a/Std/Data/Option.lean b/Std/Data/Option.lean index a7f6b1dacf..ef8d986852 100644 --- a/Std/Data/Option.lean +++ b/Std/Data/Option.lean @@ -1,3 +1 @@ -import Std.Data.Option.Basic -import Std.Data.Option.Init.Lemmas import Std.Data.Option.Lemmas diff --git a/Std/Data/Option/Basic.lean b/Std/Data/Option/Basic.lean deleted file mode 100644 index 131a4ada36..0000000000 --- a/Std/Data/Option/Basic.lean +++ /dev/null @@ -1,187 +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 --/ - -namespace Option - -/-- An elimination principle for `Option`. It is a nondependent version of `Option.recOn`. -/ -@[simp, inline] protected def elim : Option α → β → (α → β) → β - | some x, _, f => f x - | none, y, _ => y - -instance : Membership α (Option α) := ⟨fun a b => b = some a⟩ - -@[simp] theorem mem_def {a : α} {b : Option α} : a ∈ b ↔ b = some a := .rfl - -instance [DecidableEq α] (j : α) (o : Option α) : Decidable (j ∈ o) := - inferInstanceAs <| Decidable (o = some j) - -theorem isNone_iff_eq_none {o : Option α} : o.isNone ↔ o = none := - ⟨Option.eq_none_of_isNone, fun e => e.symm ▸ rfl⟩ - -theorem some_inj {a b : α} : some a = some b ↔ a = b := by simp - -/-- -`o = none` is decidable even if the wrapped type does not have decidable equality. -This is not an instance because it is not definitionally equal to `instance : DecidableEq Option`. -Try to use `o.isNone` or `o.isSome` instead. --/ -@[inline] def decidable_eq_none {o : Option α} : Decidable (o = none) := - decidable_of_decidable_of_iff isNone_iff_eq_none - -instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (∀ a ∈ o, p a) -| none => isTrue (by simp) -| some a => - if h : p a then isTrue fun o e => some_inj.1 e ▸ h - else isFalse <| mt (· _ rfl) h - -instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (∃ a ∈ o, p a) -| none => isFalse nofun -| some a => if h : p a then isTrue ⟨_, rfl, h⟩ else isFalse fun ⟨_, ⟨rfl, hn⟩⟩ => h hn - -/-- Extracts the value `a` from an option that is known to be `some a` for some `a`. -/ -@[inline] def get {α : Type u} : (o : Option α) → isSome o → α - | some x, _ => x - -/-- `guard p a` returns `some a` if `p a` holds, otherwise `none`. -/ -@[inline] def guard (p : α → Prop) [DecidablePred p] (a : α) : Option α := - if p a then some a else none - -/-- -Cast of `Option` to `List`. Returns `[a]` if the input is `some a`, and `[]` if it is `none`. --/ -@[inline] def toList : Option α → List α - | none => [] - | some a => [a] - -/-- -Cast of `Option` to `Array`. Returns `[a]` if the input is `some a`, and `[]` if it is `none`. --/ -@[inline] def toArray : Option α → Array α - | none => #[] - | some a => #[a] - -/-- -Two arguments failsafe function. Returns `f a b` if the inputs are `some a` and `some b`, and -"does nothing" otherwise. --/ -def liftOrGet (f : α → α → α) : Option α → Option α → Option α - | none, none => none - | some a, none => some a - | none, some b => some b - | some a, some b => some (f a b) - -/-- Lifts a relation `α → β → Prop` to a relation `Option α → Option β → Prop` by just adding -`none ~ none`. -/ -inductive Rel (r : α → β → Prop) : Option α → Option β → Prop - /-- If `a ~ b`, then `some a ~ some b` -/ - | some {a b} : r a b → Rel r (some a) (some b) - /-- `none ~ none` -/ - | none : Rel r none none - -/-- -Partial bind. If for some `x : Option α`, `f : Π (a : α), a ∈ x → Option β` is a -partial function defined on `a : α` giving an `Option β`, where `some a = x`, -then `pbind x f h` is essentially the same as `bind x f` -but is defined only when all `x = some a`, using the proof to apply `f`. --/ -@[simp, inline] -def pbind : ∀ x : Option α, (∀ a : α, a ∈ x → Option β) → Option β - | none, _ => none - | some a, f => f a rfl - -/-- -Partial map. If `f : Π a, p a → β` is a partial function defined on `a : α` satisfying `p`, -then `pmap f x h` is essentially the same as `map f x` but is defined only when all members of `x` -satisfy `p`, using the proof to apply `f`. --/ -@[simp, inline] def pmap {p : α → Prop} (f : ∀ a : α, p a → β) : - ∀ x : Option α, (∀ a ∈ x, p a) → Option β - | none, _ => none - | some a, H => f a (H a rfl) - -/-- Flatten an `Option` of `Option`, a specialization of `joinM`. -/ -@[simp, inline] def join (x : Option (Option α)) : Option α := x.bind id - -/-- Map a monadic function which returns `Unit` over an `Option`. -/ -@[inline] protected def forM [Pure m] : Option α → (α → m PUnit) → m PUnit - | none , _ => pure () - | some a, f => f a - -instance : ForM m (Option α) α := - ⟨Option.forM⟩ - -instance : ForIn' m (Option α) α inferInstance where - forIn' x init f := do - match x with - | none => return init - | some a => - match ← f a rfl init with - | .done r | .yield r => return r - -/-- Like `Option.mapM` but for applicative functors. -/ -@[inline] protected def mapA [Applicative m] {α β} (f : α → m β) : Option α → m (Option β) - | none => pure none - | some x => some <$> f x - -/-- -If you maybe have a monadic computation in a `[Monad m]` which produces a term of type `α`, then -there is a naturally associated way to always perform a computation in `m` which maybe produces a -result. --/ -@[inline] def sequence [Monad m] {α : Type u} : Option (m α) → m (Option α) - | none => pure none - | some fn => some <$> fn - -/-- A monadic analogue of `Option.elim`. -/ -@[inline] def elimM [Monad m] (x : m (Option α)) (y : m β) (z : α → m β) : m β := - do (← x).elim y z - -/-- A monadic analogue of `Option.getD`. -/ -@[inline] def getDM [Monad m] (x : Option α) (y : m α) : m α := - match x with - | some a => pure a - | none => y - -instance (α) [BEq α] [LawfulBEq α] : LawfulBEq (Option α) where - rfl {x} := - match x with - | some x => LawfulBEq.rfl (α := α) - | none => rfl - eq_of_beq {x y h} := by - match x, y with - | some x, some y => rw [LawfulBEq.eq_of_beq (α := α) h] - | none, none => rfl - -@[simp] theorem all_none : Option.all p none = true := rfl -@[simp] theorem all_some : Option.all p (some x) = p x := rfl - -/-- The minimum of two optional values. -/ -protected def min [Min α] : Option α → Option α → Option α - | some x, some y => some (Min.min x y) - | some x, none => some x - | none, some y => some y - | none, none => none - -instance [Min α] : Min (Option α) where min := Option.min - -@[simp] theorem min_some_some [Min α] {a b : α} : min (some a) (some b) = some (min a b) := rfl -@[simp] theorem min_some_none [Min α] {a : α} : min (some a) none = some a := rfl -@[simp] theorem min_none_some [Min α] {b : α} : min none (some b) = some b := rfl -@[simp] theorem min_none_none [Min α] : min (none : Option α) none = none := rfl - -/-- The maximum of two optional values. -/ -protected def max [Max α] : Option α → Option α → Option α - | some x, some y => some (Max.max x y) - | some x, none => some x - | none, some y => some y - | none, none => none - -instance [Max α] : Max (Option α) where max := Option.max - -@[simp] theorem max_some_some [Max α] {a b : α} : max (some a) (some b) = some (max a b) := rfl -@[simp] theorem max_some_none [Max α] {a : α} : max (some a) none = some a := rfl -@[simp] theorem max_none_some [Max α] {b : α} : max none (some b) = some b := rfl -@[simp] theorem max_none_none [Max α] : max (none : Option α) none = none := rfl diff --git a/Std/Data/Option/Init/Lemmas.lean b/Std/Data/Option/Init/Lemmas.lean deleted file mode 100644 index eb5f24300c..0000000000 --- a/Std/Data/Option/Init/Lemmas.lean +++ /dev/null @@ -1,23 +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 --/ - -namespace Option - -/-! -# Bootstrapping theorems for Option - -These are theorems used in the definitions of `Std.Data.List.Basic`. -New theorems should be added to `Std.Data.Option.Lemmas` if they are not needed by the bootstrap. --/ - -@[simp] theorem getD_none : getD none a = a := rfl -@[simp] theorem getD_some : getD (some a) b = a := rfl - -@[simp] theorem map_none' (f : α → β) : none.map f = none := rfl -@[simp] theorem map_some' (a) (f : α → β) : (some a).map f = some (f a) := rfl - -@[simp] theorem none_bind (f : α → Option β) : none.bind f = none := rfl -@[simp] theorem some_bind (a) (f : α → Option β) : (some a).bind f = f a := rfl diff --git a/Std/Data/Option/Lemmas.lean b/Std/Data/Option/Lemmas.lean index 5ef860bbb7..5f682e9464 100644 --- a/Std/Data/Option/Lemmas.lean +++ b/Std/Data/Option/Lemmas.lean @@ -3,234 +3,11 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Data.Option.Init.Lemmas -import Std.Data.Option.Basic -import Std.Tactic.Ext.Attr +import Std.Tactic.Alias namespace Option -theorem mem_iff {a : α} {b : Option α} : a ∈ b ↔ b = a := .rfl +@[deprecated] alias to_list_some := toList_some +@[deprecated] alias to_list_none := toList_none -theorem some_ne_none (x : α) : some x ≠ none := nofun - -protected theorem «forall» {p : Option α → Prop} : (∀ x, p x) ↔ p none ∧ ∀ x, p (some x) := - ⟨fun h => ⟨h _, fun _ => h _⟩, fun h x => Option.casesOn x h.1 h.2⟩ - -protected theorem «exists» {p : Option α → Prop} : (∃ x, p x) ↔ p none ∨ ∃ x, p (some x) := - ⟨fun | ⟨none, hx⟩ => .inl hx | ⟨some x, hx⟩ => .inr ⟨x, hx⟩, - fun | .inl h => ⟨_, h⟩ | .inr ⟨_, hx⟩ => ⟨_, hx⟩⟩ - -theorem get_mem : ∀ {o : Option α} (h : isSome o), o.get h ∈ o - | some _, _ => rfl - -theorem get_of_mem : ∀ {o : Option α} (h : isSome o), a ∈ o → o.get h = a - | _, _, rfl => rfl - -theorem not_mem_none (a : α) : a ∉ (none : Option α) := nofun - -@[simp] theorem some_get : ∀ {x : Option α} (h : isSome x), some (x.get h) = x -| some _, _ => rfl - -@[simp] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl - -theorem getD_of_ne_none {x : Option α} (hx : x ≠ none) (y : α) : some (x.getD y) = x := by - cases x; {contradiction}; rw [getD_some] - -theorem getD_eq_iff {o : Option α} {a b} : o.getD a = b ↔ (o = some b ∨ o = none ∧ a = b) := by - cases o <;> simp - -theorem mem_unique {o : Option α} {a b : α} (ha : a ∈ o) (hb : b ∈ o) : a = b := - some.inj <| ha ▸ hb - -@[ext] theorem ext : ∀ {o₁ o₂ : Option α}, (∀ a, a ∈ o₁ ↔ a ∈ o₂) → o₁ = o₂ - | none, none, _ => rfl - | some _, _, H => ((H _).1 rfl).symm - | _, some _, H => (H _).2 rfl - -theorem eq_none_iff_forall_not_mem : o = none ↔ ∀ a, a ∉ o := - ⟨fun e a h => by rw [e] at h; (cases h), fun h => ext <| by simp; exact h⟩ - -@[simp] theorem isSome_none : @isSome α none = false := rfl - -@[simp] theorem isSome_some : isSome (some a) = true := rfl - -theorem isSome_iff_exists : isSome x ↔ ∃ a, x = some a := by cases x <;> simp [isSome] - -@[simp] theorem isNone_none : @isNone α none = true := rfl - -@[simp] theorem isNone_some : isNone (some a) = false := rfl - -@[simp] theorem not_isSome : isSome a = false ↔ a.isNone = true := by - cases a <;> simp - -theorem eq_some_iff_get_eq : o = some a ↔ ∃ h : o.isSome, o.get h = a := by - cases o <;> simp; nofun - -theorem eq_some_of_isSome : ∀ {o : Option α} (h : o.isSome), o = some (o.get h) - | some _, _ => rfl - -theorem not_isSome_iff_eq_none : ¬o.isSome ↔ o = none := by - cases o <;> simp - -theorem ne_none_iff_isSome : o ≠ none ↔ o.isSome := by cases o <;> simp - -theorem ne_none_iff_exists : o ≠ none ↔ ∃ x, some x = o := by cases o <;> simp - -theorem ne_none_iff_exists' : o ≠ none ↔ ∃ x, o = some x := - ne_none_iff_exists.trans <| exists_congr fun _ => eq_comm - -theorem bex_ne_none {p : Option α → Prop} : (∃ x, ∃ (_ : x ≠ none), p x) ↔ ∃ x, p (some x) := - ⟨fun ⟨x, hx, hp⟩ => ⟨x.get <| ne_none_iff_isSome.1 hx, by rwa [some_get]⟩, - fun ⟨x, hx⟩ => ⟨some x, some_ne_none x, hx⟩⟩ - -theorem ball_ne_none {p : Option α → Prop} : (∀ x (_ : x ≠ none), p x) ↔ ∀ x, p (some x) := - ⟨fun h x => h (some x) (some_ne_none x), - fun h x hx => by - have := h <| x.get <| ne_none_iff_isSome.1 hx - simp [some_get] at this ⊢ - exact this⟩ - -@[simp] theorem pure_def : pure = @some α := rfl - -@[simp] theorem bind_eq_bind : bind = @Option.bind α β := rfl - -@[simp] theorem bind_some (x : Option α) : x.bind some = x := by cases x <;> rfl - -@[simp] theorem bind_none (x : Option α) : x.bind (fun _ => none (α := β)) = none := by - cases x <;> rfl - -@[simp] theorem bind_eq_some : x.bind f = some b ↔ ∃ a, x = some a ∧ f a = some b := by - cases x <;> simp - -@[simp] theorem bind_eq_none {o : Option α} {f : α → Option β} : - o.bind f = none ↔ ∀ a, o = some a → f a = none := by cases o <;> simp - -theorem bind_eq_none' {o : Option α} {f : α → Option β} : - o.bind f = none ↔ ∀ b a, a ∈ o → b ∉ f a := by - simp only [eq_none_iff_forall_not_mem, not_exists, not_and, mem_def, bind_eq_some] - -theorem bind_comm {f : α → β → Option γ} (a : Option α) (b : Option β) : - (a.bind fun x => b.bind (f x)) = b.bind fun y => a.bind fun x => f x y := by - cases a <;> cases b <;> rfl - -theorem bind_assoc (x : Option α) (f : α → Option β) (g : β → Option γ) : - (x.bind f).bind g = x.bind fun y => (f y).bind g := by cases x <;> rfl - -theorem join_eq_some : x.join = some a ↔ x = some (some a) := by - simp - -theorem join_ne_none : x.join ≠ none ↔ ∃ z, x = some (some z) := by - simp only [ne_none_iff_exists', join_eq_some, iff_self] - -theorem join_ne_none' : ¬x.join = none ↔ ∃ z, x = some (some z) := - join_ne_none - -theorem join_eq_none : o.join = none ↔ o = none ∨ o = some none := - match o with | none | some none | some (some _) => by simp - -theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl - -@[simp] theorem map_eq_map : Functor.map f = Option.map f := rfl - -theorem map_none : f <$> none = none := rfl - -theorem map_some : f <$> some a = some (f a) := rfl - -@[simp] theorem map_eq_some' : x.map f = some b ↔ ∃ a, x = some a ∧ f a = b := by cases x <;> simp - -theorem map_eq_some : f <$> x = some b ↔ ∃ a, x = some a ∧ f a = b := map_eq_some' - -@[simp] theorem map_eq_none' : x.map f = none ↔ x = none := by - cases x <;> simp only [map_none', map_some', eq_self_iff_true] - -theorem map_eq_none : f <$> x = none ↔ x = none := map_eq_none' - -theorem map_eq_bind {x : Option α} : x.map f = x.bind (some ∘ f) := by - cases x <;> simp [Option.bind] - -theorem map_congr {x : Option α} (h : ∀ a ∈ x, f a = g a) : x.map f = x.map g := by - cases x <;> simp only [map_none', map_some', h, mem_def] - -@[simp] theorem map_id' : Option.map (@id α) = id := map_id -@[simp] theorem map_id'' {x : Option α} : (x.map fun a => a) = x := congrFun map_id x - -@[simp] theorem map_map (h : β → γ) (g : α → β) (x : Option α) : - (x.map g).map h = x.map (h ∘ g) := by - cases x <;> simp only [map_none', map_some', ·∘·] - -theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘ g) = (x.map g).map h := - (map_map ..).symm - -@[simp] theorem map_comp_map (f : α → β) (g : β → γ) : - Option.map g ∘ Option.map f = Option.map (g ∘ f) := by funext x; simp - -theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some' .. - -theorem bind_map_comm {α β} {x : Option (Option α)} {f : α → β} : - x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp - -theorem join_map_eq_map_join {f : α → β} {x : Option (Option α)} : - (x.map (Option.map f)).join = x.join.map f := by cases x <;> simp - -theorem join_join {x : Option (Option (Option α))} : x.join.join = (x.map join).join := by - cases x <;> simp - -theorem mem_of_mem_join {a : α} {x : Option (Option α)} (h : a ∈ x.join) : some a ∈ x := - h.symm ▸ join_eq_some.1 h - -@[simp] theorem some_orElse (a : α) (x : Option α) : (some a <|> x) = some a := rfl - -@[simp] theorem none_orElse (x : Option α) : (none <|> x) = x := rfl - -@[simp] theorem orElse_none (x : Option α) : (x <|> none) = x := by cases x <;> rfl - -theorem map_orElse {x y : Option α} : (x <|> y).map f = (x.map f <|> y.map f) := by - cases x <;> simp - -@[simp] theorem guard_eq_some [DecidablePred p] : guard p a = some b ↔ a = b ∧ p a := by - by_cases h : p a <;> simp [Option.guard, h] - -theorem liftOrGet_eq_or_eq {f : α → α → α} (h : ∀ a b, f a b = a ∨ f a b = b) : - ∀ o₁ o₂, liftOrGet f o₁ o₂ = o₁ ∨ liftOrGet f o₁ o₂ = o₂ - | none, none => .inl rfl - | some a, none => .inl rfl - | none, some b => .inr rfl - | some a, some b => by have := h a b; simp [liftOrGet] at this ⊢; exact this - -@[simp] theorem liftOrGet_none_left {f} {b : Option α} : liftOrGet f none b = b := by - cases b <;> rfl - -@[simp] theorem liftOrGet_none_right {f} {a : Option α} : liftOrGet f a none = a := by - cases a <;> rfl - -@[simp] theorem liftOrGet_some_some {f} {a b : α} : - liftOrGet f (some a) (some b) = f a b := rfl - -theorem elim_none (x : β) (f : α → β) : none.elim x f = x := rfl - -theorem elim_some (x : β) (f : α → β) (a : α) : (some a).elim x f = f a := rfl - -@[simp] theorem getD_map (f : α → β) (x : α) (o : Option α) : - (o.map f).getD (f x) = f (getD o x) := by cases o <;> rfl - -section - -attribute [local instance] Classical.propDecidable - -/-- An arbitrary `some a` with `a : α` if `α` is nonempty, and otherwise `none`. -/ -noncomputable def choice (α : Type _) : Option α := - if h : Nonempty α then some (Classical.choice h) else none - -theorem choice_eq {α : Type _} [Subsingleton α] (a : α) : choice α = some a := by - simp [choice] - rw [dif_pos (⟨a⟩ : Nonempty α)] - simp; apply Subsingleton.elim - -theorem choice_isSome_iff_nonempty {α : Type _} : (choice α).isSome ↔ Nonempty α := - ⟨fun h => ⟨(choice α).get h⟩, fun h => by simp only [choice, dif_pos h, isSome_some]⟩ - -end - -@[simp] theorem to_list_some (a : α) : (a : Option α).toList = [a] := rfl - -@[simp] theorem to_list_none (α : Type _) : (none : Option α).toList = [] := rfl +end Option diff --git a/Std/Data/Ord.lean b/Std/Data/Ord.lean deleted file mode 100644 index eaa53a9544..0000000000 --- a/Std/Data/Ord.lean +++ /dev/null @@ -1,134 +0,0 @@ -/- -Copyright (c) 2022 Jannis Limperg. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jannis Limperg --/ - -namespace Ordering - -deriving instance DecidableEq for Ordering - -/-- Swaps less and greater ordering results -/ -def swap : Ordering → Ordering - | .lt => .gt - | .eq => .eq - | .gt => .lt - -/-- -If `o₁` and `o₂` are `Ordering`, then `o₁.then o₂` returns `o₁` unless it is `.eq`, -in which case it returns `o₂`. Additionally, it has "short-circuiting" semantics similar to -boolean `x && y`: if `o₁` is not `.eq` then the expression for `o₂` is not evaluated. -This is a useful primitive for constructing lexicographic comparator functions: -``` -structure Person where - name : String - age : Nat - -instance : Ord Person where - compare a b := (compare a.name b.name).then (compare b.age a.age) -``` -This example will sort people first by name (in ascending order) and will sort people with -the same name by age (in descending order). (If all fields are sorted ascending and in the same -order as they are listed in the structure, you can also use `deriving Ord` on the structure -definition for the same effect.) --/ -@[macro_inline] def «then» : Ordering → Ordering → Ordering - | .eq, f => f - | o, _ => o - -/-- -Check whether the ordering is 'equal'. --/ -def isEq : Ordering → Bool - | eq => true - | _ => false - -/-- -Check whether the ordering is 'not equal'. --/ -def isNe : Ordering → Bool - | eq => false - | _ => true - -/-- -Check whether the ordering is 'less than'. --/ -def isLT : Ordering → Bool - | lt => true - | _ => false - -/-- -Check whether the ordering is 'greater than'. --/ -def isGT : Ordering → Bool - | gt => true - | _ => false - -/-- -Check whether the ordering is 'greater than or equal'. --/ -def isGE : Ordering → Bool - | lt => false - | _ => true - -end Ordering - -/-- -Compare `a` and `b` lexicographically by `cmp₁` and `cmp₂`. `a` and `b` are -first compared by `cmp₁`. If this returns 'equal', `a` and `b` are compared -by `cmp₂` to break the tie. --/ -@[inline] def compareLex (cmp₁ cmp₂ : α → β → Ordering) (a : α) (b : β) : Ordering := - (cmp₁ a b).then (cmp₂ a b) - -/-- -Compare `x` and `y` by comparing `f x` and `f y`. --/ -@[inline] def compareOn [ord : Ord β] (f : α → β) (x y : α) : Ordering := - compare (f x) (f y) - - -namespace Ord - -/-- -Derive a `BEq` instance from an `Ord` instance. --/ -protected def toBEq (ord : Ord α) : BEq α where - beq x y := ord.compare x y == .eq - -/-- -Derive an `LT` instance from an `Ord` instance. --/ -protected def toLT (_ : Ord α) : LT α := - ltOfOrd - -/-- -Derive an `LE` instance from an `Ord` instance. --/ -protected def toLE (_ : Ord α) : LE α := - leOfOrd - -/-- -Invert the order of an `Ord` instance. --/ -protected def opposite (ord : Ord α) : Ord α where - compare x y := ord.compare y x - -/-- -`ord.on f` compares `x` and `y` by comparing `f x` and `f y` according to `ord`. --/ -protected def on (ord : Ord β) (f : α → β) : Ord α where - compare := compareOn f - -/-- -Derive the lexicographic order on products `α × β` from orders for `α` and `β`. --/ -protected def lex (_ : Ord α) (_ : Ord β) : Ord (α × β) := - lexOrd - -/-- -Create an order which compares elements first by `ord₁` and then, if this -returns 'equal', by `ord₂`. --/ -protected def lex' (ord₁ ord₂ : Ord α) : Ord α where - compare := compareLex ord₁.compare ord₂.compare diff --git a/Std/Data/PairingHeap.lean b/Std/Data/PairingHeap.lean index fd30bd0c44..8eceda2753 100644 --- a/Std/Data/PairingHeap.lean +++ b/Std/Data/PairingHeap.lean @@ -149,7 +149,7 @@ theorem Heap.size_tail (le) {s : Heap α} (h : s.NoSibling) : (s.tail le).size = simp only [Heap.tail] match eq : s.tail? le with | none => cases s with cases eq | nil => rfl - | some tl => simp [Heap.size_tail? h eq]; rfl + | some tl => simp [Heap.size_tail? h eq] theorem Heap.size_deleteMin_lt {s : Heap α} (eq : s.deleteMin le = some (a, s')) : s'.size < s.size := by diff --git a/Std/Data/RBMap/Alter.lean b/Std/Data/RBMap/Alter.lean index 2d9609ad72..6e6d99b455 100644 --- a/Std/Data/RBMap/Alter.lean +++ b/Std/Data/RBMap/Alter.lean @@ -377,7 +377,7 @@ protected theorem Balanced.alter {t : RBNode α} | .black ha hb => exact ⟨_, _, hp.fill (.black ha hb)⟩ theorem modify_eq_alter (t : RBNode α) : t.modify cut f = t.alter cut (.map f) := by - simp [modify, alter]; split <;> simp [Option.map] + simp [modify, alter] /-- The `modify` function preserves the ordering invariants. -/ protected theorem Ordered.modify {t : RBNode α} diff --git a/Std/Data/Range/Lemmas.lean b/Std/Data/Range/Lemmas.lean index 76bc082c3c..5c2dcc900b 100644 --- a/Std/Data/Range/Lemmas.lean +++ b/Std/Data/Range/Lemmas.lean @@ -58,7 +58,7 @@ theorem forIn'_eq_forIn_range' [Monad m] (r : Std.Range) suffices ∀ H, forIn' [start:stop:step] init f = forIn (L.pmap Subtype.mk H) init f' from this _ intro H; dsimp only [forIn', Range.forIn'] if h : start < stop then - simp [numElems, Nat.not_le.2 h]; split + simp [numElems, Nat.not_le.2 h, L]; split · subst step suffices ∀ n H init, forIn'.loop start stop 0 f n start (Nat.le_refl _) init = @@ -88,7 +88,7 @@ theorem forIn'_eq_forIn_range' [Monad m] (r : Std.Range) have := h2 0; simp at this rw [forIn'.loop]; simp [List.forIn, this, ih]; rfl else - simp [List.range', h, numElems_stop_le_start ⟨start, stop, step⟩ (Nat.not_lt.1 h)] + simp [List.range', h, numElems_stop_le_start ⟨start, stop, step⟩ (Nat.not_lt.1 h), L] cases stop <;> unfold forIn'.loop <;> simp [List.forIn', h] theorem forIn_eq_forIn_range' [Monad m] (r : Std.Range) diff --git a/Std/Data/Rat/Basic.lean b/Std/Data/Rat/Basic.lean index 6f93a3a3c0..d0f5c44f8b 100644 --- a/Std/Data/Rat/Basic.lean +++ b/Std/Data/Rat/Basic.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro -/ import Std.Data.Nat.Gcd import Std.Data.Int.DivMod -import Std.Tactic.Ext /-! # Basics for the Rational Numbers -/ @@ -88,6 +87,8 @@ namespace Rat /-- Embedding of `Int` in the rational numbers. -/ def ofInt (num : Int) : Rat := { num, reduced := Nat.coprime_one_right _ } +instance : NatCast Rat where + natCast n := ofInt n instance : IntCast Rat := ⟨ofInt⟩ instance : OfNat Rat n := ⟨n⟩ diff --git a/Std/Data/Rat/Lemmas.lean b/Std/Data/Rat/Lemmas.lean index 7188542820..3b749f9593 100644 --- a/Std/Data/Rat/Lemmas.lean +++ b/Std/Data/Rat/Lemmas.lean @@ -3,8 +3,8 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Data.Int.Init.Lemmas import Std.Data.Rat.Basic +import Std.Tactic.NormCast.Ext import Std.Tactic.SeqFocus /-! # Additional lemmas about the Rational Numbers -/ diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 74c85883ad..013b21e084 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -7,7 +7,6 @@ import Std.Data.Char import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.String.Basic -import Std.Tactic.Ext.Attr import Std.Tactic.Lint.Misc import Std.Tactic.SeqFocus import Std.Tactic.Simpa diff --git a/Std/Data/Sum/Lemmas.lean b/Std/Data/Sum/Lemmas.lean index 2491660b1a..f7766d2985 100644 --- a/Std/Data/Sum/Lemmas.lean +++ b/Std/Data/Sum/Lemmas.lean @@ -5,7 +5,6 @@ Authors: Mario Carneiro, Yury G. Kudryashov -/ import Std.Data.Sum.Basic -import Std.Tactic.Ext /-! # Disjoint union of types diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index 9cf6bf6b2b..04929fa84e 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 François G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ -import Std.Tactic.Ext.Attr /-! ### UInt8 -/ diff --git a/Std/Lean/Elab/Tactic.lean b/Std/Lean/Elab/Tactic.lean deleted file mode 100644 index 2c0a40b899..0000000000 --- a/Std/Lean/Elab/Tactic.lean +++ /dev/null @@ -1,18 +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 --/ -import Lean.Elab.Tactic.Basic - -/-! -# Tactic combinators in `TacticM`. --/ - -namespace Lean.Elab.Tactic - -/-- Analogue of `liftMetaTactic` for tactics that do not return any goals. -/ -def liftMetaFinishingTactic (tac : MVarId → MetaM Unit) : TacticM Unit := - liftMetaTactic fun g => do tac g; pure [] - -end Lean.Elab.Tactic diff --git a/Std/Lean/Expr.lean b/Std/Lean/Expr.lean index 282b27cecf..2367af3892 100644 --- a/Std/Lean/Expr.lean +++ b/Std/Lean/Expr.lean @@ -128,14 +128,6 @@ def isAppOf' (e : Expr) (n : Name) : Bool := | const c .. => c == n | _ => false -/-- If the expression is a constant, return that name. Otherwise return `Name.anonymous`. -/ -def constName (e : Expr) : Name := - e.constName?.getD Name.anonymous - -/-- Return the function (name) and arguments of an application. -/ -def getAppFnArgs (e : Expr) : Name × Array Expr := - withApp e λ e a => (e.constName, a) - /-- Turns an expression that is a natural number literal into a natural number. -/ def natLit! : Expr → Nat | lit (Literal.natVal v) => v @@ -150,28 +142,3 @@ def intLit! (e : Expr) : Int := .negOfNat e.appArg!.natLit! else panic! "not a raw integer literal" - -/-- -Checks if an expression is a "natural number in normal form", -i.e. of the form `OfNat n`, where `n` matches `.lit (.natVal lit)` for some `lit`. -and if so returns `lit`. --/ --- Note that an `Expr.lit (.natVal n)` is not considered in normal form! -def nat? (e : Expr) : Option Nat := do - guard <| e.isAppOfArity ``OfNat.ofNat 3 - let lit (.natVal n) := e.appFn!.appArg! | none - n - -/-- -Checks if an expression is an "integer in normal form", -i.e. either a natural number in normal form, or the negation of a positive natural number, -and if so returns the integer. --/ -def int? (e : Expr) : Option Int := - if e.isAppOfArity ``Neg.neg 3 then - match e.appArg!.nat? with - | none => none - | some 0 => none - | some n => some (-n) - else - e.nat? diff --git a/Std/Lean/HashSet.lean b/Std/Lean/HashSet.lean index 272ea4dab0..0dedb7cd4f 100644 --- a/Std/Lean/HashSet.lean +++ b/Std/Lean/HashSet.lean @@ -73,11 +73,3 @@ protected def ofArray [BEq α] [Hashable α] (as : Array α) : HashSet α := @[inline] protected def ofList [BEq α] [Hashable α] (as : List α) : HashSet α := HashSet.empty.insertMany as - -/-- -`O(|t|)` amortized. Merge two `HashSet`s. --/ -@[inline] -def merge {α : Type u} [BEq α] [Hashable α] (s t : HashSet α) : HashSet α := - t.fold (init := s) fun s a => s.insert a - -- We don't use `insertMany` here because it gives weird universes. diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index c6bbb8bac5..8bdaecf130 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -231,10 +231,6 @@ annotations. -/ def getTypeCleanup (mvarId : MVarId) : MetaM Expr := return (← instantiateMVars (← mvarId.getType)).cleanupAnnotations -/-- Short-hand for applying a constant to the goal. -/ -def applyConst (mvar : MVarId) (c : Name) (cfg : ApplyConfig := {}) : MetaM (List MVarId) := do - mvar.apply (← mkConstWithFreshMVarLevels c) cfg - end MVarId @@ -289,13 +285,6 @@ where | none => acc.modify fun s => s.push goal | some goals => goals.forM (go acc) -/-- Return local hypotheses which are not "implementation detail", as `Expr`s. -/ -def getLocalHyps [Monad m] [MonadLCtx m] : m (Array Expr) := do - let mut hs := #[] - for d in ← getLCtx do - if !d.isImplementationDetail then hs := hs.push d.toExpr - return hs - /-- Given a monadic function `F` that takes a type and a term of that type and produces a new term, lifts this to the monadic function that opens a `∀` telescope, applies `F` to the body, diff --git a/Std/Lean/Meta/DiscrTree.lean b/Std/Lean/Meta/DiscrTree.lean index b14f1bd356..1984950963 100644 --- a/Std/Lean/Meta/DiscrTree.lean +++ b/Std/Lean/Meta/DiscrTree.lean @@ -6,7 +6,6 @@ Authors: Jannis Limperg, Scott Morrison import Lean.Meta.DiscrTree import Std.Data.Array.Merge -import Std.Data.Ord import Std.Lean.Meta.Expr import Std.Lean.PersistentHashMap diff --git a/Std/Lean/Position.lean b/Std/Lean/Position.lean index 8574d846f1..f2bc155886 100644 --- a/Std/Lean/Position.lean +++ b/Std/Lean/Position.lean @@ -3,7 +3,9 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ +import Lean.Syntax import Lean.Meta.Tactic.TryThis +import Lean.Data.Lsp.Utf16 /-- Gets the LSP range of syntax `stx`. -/ def Lean.FileMap.rangeOfStx? (text : FileMap) (stx : Syntax) : Option Lsp.Range := diff --git a/Std/Tactic/Congr.lean b/Std/Tactic/Congr.lean index ebdaf0488d..eaa1b808b3 100644 --- a/Std/Tactic/Congr.lean +++ b/Std/Tactic/Congr.lean @@ -5,7 +5,7 @@ Authors: Mario Carneiro, Miyahara Kō -/ import Lean.Meta.Tactic.Congr import Lean.Elab.Tactic.Config -import Std.Tactic.Ext +import Lean.Elab.Tactic.Ext /-! # `congr with` tactic, `rcongr` tactic -/ diff --git a/Std/Tactic/Ext.lean b/Std/Tactic/Ext.lean deleted file mode 100644 index 6681cc2385..0000000000 --- a/Std/Tactic/Ext.lean +++ /dev/null @@ -1,234 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro --/ -import Lean.Elab.Tactic.RCases -import Lean.Linter.Util -import Std.Tactic.Init -import Std.Tactic.Ext.Attr - -namespace Std.Tactic.Ext -open Lean Meta Elab Tactic - -/-- -Constructs the hypotheses for the extensionality lemma. -Calls the continuation `k` with the list of parameters to the structure, -two structure variables `x` and `y`, and a list of pairs `(field, ty)` -where `ty` is `x.field = y.field` or `HEq x.field y.field`. --/ -def withExtHyps (struct : Name) (flat : Term) - (k : Array Expr → (x y : Expr) → Array (Name × Expr) → MetaM α) : MetaM α := do - let flat ← match flat with - | `(true) => pure true - | `(false) => pure false - | _ => throwErrorAt flat "expected 'true' or 'false'" - unless isStructure (← getEnv) struct do throwError "not a structure: {struct}" - let structC ← mkConstWithLevelParams struct - forallTelescope (← inferType structC) fun params _ => do - withNewBinderInfos (params.map (·.fvarId!, BinderInfo.implicit)) do - withLocalDeclD `x (mkAppN structC params) fun x => do - withLocalDeclD `y (mkAppN structC params) fun y => do - let mut hyps := #[] - let fields := if flat then - getStructureFieldsFlattened (← getEnv) struct (includeSubobjectFields := false) - else - getStructureFields (← getEnv) struct - for field in fields do - let x_f ← mkProjection x field - let y_f ← mkProjection y field - if ← isProof x_f then - pure () - else if ← isDefEq (← inferType x_f) (← inferType y_f) then - hyps := hyps.push (field, ← mkEq x_f y_f) - else - hyps := hyps.push (field, ← mkHEq x_f y_f) - k params x y hyps - -/-- -Creates the type of the extensionality lemma for the given structure, -elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example. --/ -scoped elab "ext_type% " flat:term:max ppSpace struct:ident : term => do - withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do - let ty := hyps.foldr (init := ← mkEq x y) fun (f, h) ty => - mkForall f BinderInfo.default h ty - mkForallFVars (params |>.push x |>.push y) ty - -/-- Make an `Iff` application. -/ -def mkIff (p q : Expr) : Expr := mkApp2 (mkConst ``Iff) p q - -/-- Make an n-ary `And` application. `mkAndN []` returns `True`. -/ -def mkAndN : List Expr → Expr - | [] => mkConst ``True - | [p] => p - | p :: ps => mkAnd p (mkAndN ps) - -/-- -Creates the type of the iff-variant of the extensionality lemma for the given structure, -elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example. --/ -scoped elab "ext_iff_type% " flat:term:max ppSpace struct:ident : term => do - withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do - mkForallFVars (params |>.push x |>.push y) <| - mkIff (← mkEq x y) <| mkAndN (hyps.map (·.2)).toList - -macro_rules | `(declare_ext_theorems_for $[(flat := $f)]? $struct:ident $(prio)?) => do - let flat := f.getD (mkIdent `true) - let names ← Macro.resolveGlobalName struct.getId.eraseMacroScopes - let name ← match names.filter (·.2.isEmpty) with - | [] => Macro.throwError s!"unknown constant {struct}" - | [(name, _)] => pure name - | _ => Macro.throwError s!"ambiguous name {struct}" - let extName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext" - let extIffName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext_iff" - `(@[ext $(prio)?] protected theorem $extName:ident : ext_type% $flat $struct:ident := - fun {..} {..} => by intros; subst_eqs; rfl - protected theorem $extIffName:ident : ext_iff_type% $flat $struct:ident := - fun {..} {..} => - ⟨fun h => by cases h; split_ands <;> rfl, - fun _ => by (repeat cases ‹_ ∧ _›); subst_eqs; rfl⟩) - -/-- Apply a single extensionality lemma to `goal`. -/ -def applyExtLemma (goal : MVarId) : MetaM (List MVarId) := goal.withContext do - let tgt ← goal.getType' - unless tgt.isAppOfArity ``Eq 3 do - throwError "applyExtLemma only applies to equations, not{indentExpr tgt}" - let ty := tgt.getArg! 0 - let s ← saveState - for lem in ← getExtLemmas ty do - try - -- Note: We have to do this extra check to ensure that we don't apply e.g. - -- funext to a goal `(?a₁ : ?b) = ?a₂` to produce `(?a₁ x : ?b') = ?a₂ x`, - -- since this will loop. - -- We require that the type of the equality is not changed by the `goal.apply c` line - -- TODO: add flag to apply tactic to toggle unification vs. matching - withNewMCtxDepth do - let c ← mkConstWithFreshMVarLevels lem.declName - let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing (← inferType c) - guard (← isDefEq tgt declTy) - -- We use `newGoals := .all` as this is - -- more useful in practice with dependently typed arguments of `@[ext]` lemmas. - return ← goal.apply (cfg := { newGoals := .all }) (← mkConstWithFreshMVarLevels lem.declName) - catch _ => s.restore - throwError "no applicable extensionality lemma found for{indentExpr ty}" - -/-- Apply a single extensionality lemma to the current goal. -/ -elab "apply_ext_lemma" : tactic => liftMetaTactic applyExtLemma - -/-- -Postprocessor for `withExt` which runs `rintro` with the given patterns when the target is a -pi type. --/ -def tryIntros [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat)) - (k : MVarId → List (TSyntax `rcasesPat) → m Nat) : m Nat := do - match pats with - | [] => k (← (g.intros : TermElabM _)).2 [] - | p::ps => - if (← (g.withContext g.getType' : TermElabM _)).isForall then - let mut n := 0 - for g in ← RCases.rintro #[p] none g do - n := n.max (← tryIntros g ps k) - pure (n + 1) - else k g pats - -/-- -Applies a single extensionality lemma, using `pats` to introduce variables in the result. -Runs continuation `k` on each subgoal. --/ -def withExt1 [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat)) - (k : MVarId → List (TSyntax `rcasesPat) → m Nat) : m Nat := do - let mut n := 0 - for g in ← (applyExtLemma g : TermElabM _) do - n := n.max (← tryIntros g pats k) - pure n - -/-- -Applies a extensionality lemmas recursively, using `pats` to introduce variables in the result. -Runs continuation `k` on each subgoal. --/ -def withExtN [Monad m] [MonadLiftT TermElabM m] [MonadExcept Exception m] - (g : MVarId) (pats : List (TSyntax `rcasesPat)) (k : MVarId → List (TSyntax `rcasesPat) → m Nat) - (depth := 1000000) (failIfUnchanged := true) : m Nat := - match depth with - | 0 => k g pats - | depth+1 => do - if failIfUnchanged then - withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false) - else try - withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false) - catch _ => k g pats - -/-- -Apply extensionality lemmas as much as possible, using `pats` to introduce the variables -in extensionality lemmas like `funext`. Returns a list of subgoals. --/ -def extCore (g : MVarId) (pats : List (TSyntax `rcasesPat)) - (depth := 1000000) (failIfUnchanged := true) : - TermElabM (Nat × Array (MVarId × List (TSyntax `rcasesPat))) := do - StateT.run (m := TermElabM) (s := #[]) - (withExtN g pats (fun g qs => modify (·.push (g, qs)) *> pure 0) depth failIfUnchanged) - -/-- -* `ext pat*` applies extensionality lemmas as much as possible, - using `pat*` to introduce the variables in extensionality lemmas using `rintro`. - For example, this names the variables introduced by lemmas such as `funext`. -* `ext` applies extensionality lemmas as much as possible - but introduces anonymous variables whenever needed. -* `ext pat* : n` applies ext lemmas only up to depth `n`. - -The `ext1 pat*` tactic is like `ext pat*` except that it only applies a single extensionality lemma. - -The `ext?` tactic (note: unimplemented) has the same syntax as the `ext` tactic, -and it gives a suggestion of an equivalent tactic to use in place of `ext`. --/ -syntax "ext" (colGt ppSpace rintroPat)* (" : " num)? : tactic -elab_rules : tactic - | `(tactic| ext $pats* $[: $n]?) => do - let pats := RCases.expandRIntroPats pats - let depth := n.map (·.getNat) |>.getD 1000000 - let (used, gs) ← extCore (← getMainGoal) pats.toList depth - if RCases.linter.unusedRCasesPattern.get (← getOptions) then - if used < pats.size then - Linter.logLint RCases.linter.unusedRCasesPattern (mkNullNode pats[used:].toArray) - m!"`ext` did not consume the patterns: {pats[used:]}" - replaceMainGoal <| gs.map (·.1) |>.toList - -/-- -`ext1 pat*` is like `ext pat*` except that it only applies a single extensionality lemma rather -than recursively applying as many extensionality lemmas as possible. - -The `pat*` patterns are processed using the `rintro` tactic. -If no patterns are supplied, then variables are introduced anonymously using the `intros` tactic. - -The `ext1?` tactic (note: unimplemented) has the same syntax as the `ext1?` tactic, -and it gives a suggestion of an equivalent tactic to use in place of `ext1`. --/ -macro "ext1" xs:(colGt ppSpace rintroPat)* : tactic => - if xs.isEmpty then `(tactic| apply_ext_lemma <;> intros) - else `(tactic| apply_ext_lemma <;> rintro $xs*) - --- TODO -/-- `ext1? pat*` is like `ext1 pat*` but gives a suggestion on what pattern to use -/ -syntax "ext1?" (colGt ppSpace rintroPat)* : tactic -/-- `ext? pat*` is like `ext pat*` but gives a suggestion on what pattern to use -/ -syntax "ext?" (colGt ppSpace rintroPat)* (" : " num)? : tactic - -end Std.Tactic.Ext - -attribute [ext] funext propext Subtype.eq - -@[ext] theorem Prod.ext : {x y : Prod α β} → x.fst = y.fst → x.snd = y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl - -@[ext] theorem PProd.ext : {x y : PProd α β} → x.fst = y.fst → x.snd = y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl - -@[ext] theorem Sigma.ext : {x y : Sigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl - -@[ext] theorem PSigma.ext : {x y : PSigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y - | ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl - -@[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl -protected theorem Unit.ext (x y : Unit) : x = y := rfl diff --git a/Std/Tactic/Ext/Attr.lean b/Std/Tactic/Ext/Attr.lean deleted file mode 100644 index 7b9245bc4b..0000000000 --- a/Std/Tactic/Ext/Attr.lean +++ /dev/null @@ -1,109 +0,0 @@ -/- -Copyright (c) 2021 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Mario Carneiro --/ -import Lean.Elab.Command - -namespace Std.Tactic.Ext -open Lean Meta - -/-- `declare_ext_theorems_for A` declares the extensionality theorems for the structure `A`. -/ -syntax "declare_ext_theorems_for " ("(" &"flat" " := " term ") ")? ident (ppSpace prio)? : command - -/-- Information about an extensionality theorem, stored in the environment extension. -/ -structure ExtTheorem where - /-- Declaration name of the extensionality theorem. -/ - declName : Name - /-- Priority of the extensionality theorem. -/ - priority : Nat - /-- Key in the discrimination tree. -/ - keys : Array DiscrTree.Key - deriving Inhabited, Repr, BEq, Hashable - -/-- The state of the `ext` extension environment -/ -structure ExtTheorems where - /-- The tree of `ext` extensions. -/ - tree : DiscrTree ExtTheorem := {} - /-- Erased `ext`s. -/ - erased : PHashSet Name := {} - deriving Inhabited - -/-- Discrimation tree settings for the `ext` extension. -/ -def extExt.config : WhnfCoreConfig := {} - -/-- The environment extension to track `@[ext]` lemmas. -/ -initialize extExtension : - SimpleScopedEnvExtension ExtTheorem ExtTheorems ← - registerSimpleScopedEnvExtension { - addEntry := fun { tree, erased } thm => - { tree := tree.insertCore thm.keys thm, erased := erased.erase thm.declName } - initial := {} - } - -/-- Get the list of `@[ext]` lemmas corresponding to the key `ty`, -ordered from high priority to low. -/ -@[inline] def getExtLemmas (ty : Expr) : MetaM (Array ExtTheorem) := do - let extTheorems := extExtension.getState (← getEnv) - let arr ← extTheorems.tree.getMatch ty extExt.config - let erasedArr := arr.filter fun thm => !extTheorems.erased.contains thm.declName - -- Using insertion sort because it is stable and the list of matches should be mostly sorted. - -- Most ext lemmas have default priority. - return erasedArr.insertionSort (·.priority < ·.priority) |>.reverse - -/-- Erases a name marked `ext` by adding it to the state's `erased` field and - removing it from the state's list of `Entry`s. -/ -def ExtTheorems.eraseCore (d : ExtTheorems) (declName : Name) : ExtTheorems := - { d with erased := d.erased.insert declName } - -/-- - Erase a name marked as a `ext` attribute. - Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem` - found somewhere in the state's tree, and is not erased. --/ -def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Name) : - m ExtTheorems := do - unless d.tree.containsValueP (·.declName == declName) && !d.erased.contains declName do - throwError "'{declName}' does not have [ext] attribute" - return d.eraseCore declName - -/-- Registers an extensionality lemma. - -* When `@[ext]` is applied to a structure, it generates `.ext` and `.ext_iff` theorems and registers - them for the `ext` tactic. - -* When `@[ext]` is applied to a theorem, the theorem is registered for the `ext` tactic. - -* You can use `@[ext 9000]` to specify a priority for the attribute. - -* You can use the flag `@[ext (flat := false)]` to prevent flattening all fields of parent - structures in the generated extensionality lemmas. -/ -syntax (name := ext) "ext" (" (" &"flat" " := " term ")")? (ppSpace prio)? : attr - -initialize registerBuiltinAttribute { - name := `ext - descr := "Marks a lemma as extensionality lemma" - add := fun declName stx kind => do - let `(attr| ext $[(flat := $f)]? $(prio)?) := stx - | throwError "unexpected @[ext] attribute {stx}" - if isStructure (← getEnv) declName then - liftCommandElabM <| Elab.Command.elabCommand <| - ← `(declare_ext_theorems_for $[(flat := $f)]? $(mkCIdentFrom stx declName) $[$prio]?) - else MetaM.run' do - if let some flat := f then - throwErrorAt flat "unexpected 'flat' config on @[ext] lemma" - let declTy := (← getConstInfo declName).type - let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing declTy - let failNotEq := throwError - "@[ext] attribute only applies to structures or lemmas proving x = y, got {declTy}" - let some (ty, lhs, rhs) := declTy.eq? | failNotEq - unless lhs.isMVar && rhs.isMVar do failNotEq - let keys ← withReducible <| DiscrTree.mkPath ty extExt.config - let priority ← liftCommandElabM do Elab.liftMacroM do - evalPrio (prio.getD (← `(prio| default))) - extExtension.add {declName, keys, priority} kind - erase := fun declName => do - let s := extExtension.getState (← getEnv) - let s ← s.erase declName - modifyEnv fun env => extExtension.modifyState env fun _ => s -} diff --git a/Std/Tactic/FalseOrByContra.lean b/Std/Tactic/FalseOrByContra.lean index bcf9a9e125..8a3a8d0763 100644 --- a/Std/Tactic/FalseOrByContra.lean +++ b/Std/Tactic/FalseOrByContra.lean @@ -5,6 +5,7 @@ Authors: Scott Morrison -/ import Lean.Elab.Tactic.Basic import Std.Lean.Meta.Basic +import Lean.Meta.Tactic.Util /-! # `false_or_by_contra` tactic @@ -23,9 +24,11 @@ open Lean Changes the goal to `False`, retaining as much information as possible: If the goal is `False`, do nothing. -If the goal is an implication or a function type, introduce the argument. -(If the goal is `x ≠ y`, introduce `x = y`.) -Otherwise, for a propositional goal `P`, replace it with `¬ ¬ P` and introduce `¬ P`. +If the goal is an implication or a function type, introduce the argument and restart. +(In particular, if the goal is `x ≠ y`, introduce `x = y`.) +Otherwise, for a propositional goal `P`, replace it with `¬ ¬ P` +(attempt to find a `Decidable` instance, but otherwise falling back to working classically) +and introduce `¬ P`. For a non-propositional goal use `False.elim`. -/ syntax (name := false_or_by_contra) "false_or_by_contra" : tactic @@ -58,6 +61,5 @@ partial def falseOrByContra (g : MVarId) (useClassical : Option Bool := none) : let [g] ← g.applyConst ``False.elim | panic! "expected one sugoal" pure g - @[inherit_doc falseOrByContra] elab "false_or_by_contra" : tactic => liftMetaTactic1 (falseOrByContra ·) diff --git a/Std/Tactic/GuardMsgs.lean b/Std/Tactic/GuardMsgs.lean index f425891424..f0f3ab7568 100644 --- a/Std/Tactic/GuardMsgs.lean +++ b/Std/Tactic/GuardMsgs.lean @@ -3,9 +3,7 @@ Copyright (c) 2023 Kyle Miller. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kyle Miller -/ -import Lean.Elab.Command -import Lean.Meta.Tactic.TryThis -import Std.CodeAction.Basic +import Std.CodeAction.Attr import Std.Lean.Position /-! `#guard_msgs` command for testing commands diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean index 7fb1ffcc22..104c8c67f3 100644 --- a/Std/Tactic/LibrarySearch.lean +++ b/Std/Tactic/LibrarySearch.lean @@ -9,7 +9,6 @@ import Std.Lean.Expr import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Parser -import Std.Data.Option.Basic import Std.Tactic.SolveByElim import Std.Util.Pickle diff --git a/Std/Tactic/NormCast.lean b/Std/Tactic/NormCast.lean index e79a0971a6..034c16497c 100644 --- a/Std/Tactic/NormCast.lean +++ b/Std/Tactic/NormCast.lean @@ -6,6 +6,7 @@ Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner import Lean.Elab.Tactic.Conv.Simp import Std.Lean.Meta.Simp import Std.Tactic.NormCast.Ext +import Std.Tactic.NormCast.Lemmas import Std.Classes.Cast /-! @@ -15,6 +16,23 @@ import Std.Classes.Cast open Lean Meta Simp open Std.Tactic.NormCast +namespace Int + +/- These will be attached to definitions once norm_cast is in core. -/ +attribute [norm_cast] Nat.cast_ofNat_Int +attribute [norm_cast] ofNat_add +attribute [norm_cast] ofNat_sub +attribute [norm_cast] ofNat_mul +attribute [norm_cast] ofNat_inj +attribute [norm_cast] ofNat_ediv +attribute [norm_cast] ofNat_emod +attribute [norm_cast] ofNat_dvd +attribute [norm_cast] ofNat_le +attribute [norm_cast] ofNat_lt +attribute [norm_cast] ofNat_pos + +end Int + namespace Std.Tactic.NormCast initialize registerTraceClass `Tactic.norm_cast diff --git a/Std/Tactic/Omega.lean b/Std/Tactic/Omega.lean deleted file mode 100644 index aa637bf4dd..0000000000 --- a/Std/Tactic/Omega.lean +++ /dev/null @@ -1,192 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.Frontend - -/-! -# `omega` - -This is an implementation of the `omega` algorithm, currently without "dark" and "grey" shadows, -although the framework should be compatible with adding that part of the algorithm later. - -The implementation closely follows William Pugh's -"The omega test: a fast and practical integer programming algorithm for dependence analysis" -https://doi.org/10.1145/125826.125848. - -The `MetaM` level `omega` tactic takes a `List Expr` of facts, -and tries to discharge the goal by proving `False`. - -The user-facing `omega` tactic first calls `false_or_by_contra`, and then invokes the `omega` tactic -on all hypotheses. - -### Pre-processing - -In the `false_or_by_contra` step, we: -* if the goal is `False`, do nothing, -* if the goal is `¬ P`, introduce `P`, -* if the goal is `x ≠ y`, introduce `x = y`, -* otherwise, for a goal `P`, replace it with `¬ ¬ P` and introduce `¬ P`. - -The `omega` tactic pre-processes the hypotheses in the following ways: -* Replace `x > y` for `x y : Nat` or `x y : Int` with `x ≥ y + 1`. -* Given `x ≥ y` for `x : Nat`, replace it with `(x : Int) ≥ (y : Int)`. -* Push `Nat`-to-`Int` coercions inwards across `+`, `*`, `/`, `%`. -* Replace `k ∣ x` for a literal `k : Nat` with `x % k = 0`, - and replace `¬ k ∣ x` with `x % k > 0`. -* If `x / m` appears, for some `x : Int` and literal `m : Nat`, - replace `x / m` with a new variable `α` and add the constraints - `0 ≤ - m * α + x ≤ m - 1`. -* If `x % m` appears, similarly, introduce the same new contraints - but replace `x % m` with `- m * α + x`. -* Split conjunctions, existentials, and subtypes. -* Record, for each appearance of `(a - b : Int)` with `a b : Nat`, the disjunction - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0`. - We don't immediately split this; see the discussion below for how disjunctions are handled. - -After this preprocessing stage, we have a collection of linear inequalities -(all using `≤` rather than `<`) and equalities in some set of atoms. - -TODO: We should identify atoms up to associativity and commutativity, -so that `omega` can handle problems such as `a * b < 0 && b * a > 0 → False`. -This should be a relatively easy modification of the `lookup` function in `OmegaM`. -After doing so, we could allow the preprocessor to distribute multiplication over addition. - -### Normalization - -Throughout the remainder of the algorithm, we apply the following normalization steps to -all linear constraints: -* Make the leading coefficient positive (thus giving us both upper and lower bounds). -* Divide through by the GCD of the coefficients, rounding the constant terms appropriately. -* Whenever we have both an upper and lower bound for the same coefficients, - check they are compatible. If they are tight, mark the pair of constraints as an equality. - If they are inconsistent, stop further processing. - -### Solving equalities - -The next step is to solve all equalities. - -We first solve any equalities that have a `±1` coefficient; -these allow us to eliminate that variable. - -After this, there may be equalities remaining with all coefficients having absolute value greater -than one. We select an equality `c₀ + ∑ cᵢ * xᵢ = 0` with smallest minimal absolute value -of the `cᵢ`, breaking ties by preferring equalities with smallest maximal absolute value. -We let `m = ∣cⱼ| + 1` where `cⱼ` is the coefficient with smallest absolute value.. -We then add the new equality `(bmod c₀ m) + ∑ (bmod cᵢ m) xᵢ = m α` with `α` being a new variable. -Here `bmod` is "balanced mod", taking values in `[- m/2, (m - 1)/2]`. -This equality holds (for some value of `α`) because the left hand side differs from the left hand -side of the original equality by a multiple of `m`. -Moreover, in this equality the coefficient of `xⱼ` is `±1`, so we can solve and eliminate `xⱼ`. - -So far this isn't progress: we've introduced a new variable and eliminated a variable. -However, this process terminates, as the pair `(c, C)` lexicographically decreases, -where `c` is the smallest minimal absolute value and `C` is the smallest maximal absolute value -amongst those equalities with minimal absolute value `c`. -(Happily because we're running this in metaprogramming code, we don't actually need to prove this -termination! If we later want to upgrade to a decision procedure, or to produce counterexamples -we would need to do this. It's certainly possible, and existed in an earlier prototype version.) - -### Solving inequalities - -After solving all equalities, we turn to the inequalities. - -We need to select a variable to eliminate; this choice is discussed below. - -#### Shadows - -The omega algorithm indicates we should consider three subproblems, -called the "real", "dark", and "grey" shadows. -(In fact the "grey" shadow is a disjunction of potentially many problems.) -Our problem is satisfiable if and only if the real shadow is satisfiable -and either the dark or grey shadow is satisfiable. - -Currently we do not implement either the dark or grey shadows, and thus if the real shadow is -satisfiable we must fail, and report that we couldn't find a contradiction, even though the -problem may be unsatisfiable. - -In practical problems, it appears to be relatively rare that we fail because of not handling the -dark and grey shadows. - -Fortunately, in many cases it is possible to choose a variable to eliminate such that -the real and dark shadows coincide, and the grey shadows are empty. In this situation -we don't lose anything by ignoring the dark and grey shadows. -We call this situation an exact elimination. -A sufficient condition for exactness is that either all upper bounds on `xᵢ` have unit coefficient, -or all lower bounds on `xᵢ` have unit coefficient. -We always prefer to select the value of `i` so that this condition holds, if possible. -We break ties by preferring to select a value of `i` that minimizes the number of new constraints -introduced in the real shadow. - -#### The real shadow: Fourier-Motzkin elimination - -The real shadow for a variable `i` is just the Fourier-Motzkin elimination. - -We begin by discarding all inequalities involving the variable `i`. - -Then, for each pair of constraints `f ≤ c * xᵢ` and `c' * xᵢ ≤ f'` -with both `c` and `c'` positive (i.e. for each pair of an lower and upper bound on `xᵢ`) -we introduce the new constraint `c * f' - c' * f ≥ 0`. - -(Note that if there are only upper bounds on `xᵢ`, or only lower bounds on `xᵢ` this step -simply discards inequalities.) - -#### The dark and grey shadows - -For each such new constraint `c' * f - c * f' ≤ 0`, we either have the strengthening -`c * f' - c' * f ≥ c * c' - c - c' + 1` -or we do not, i.e. -`c * f' - c' * f ≤ c * c' - c - c'`. -In the latter case, combining this inequality with `f' ≥ c' * xᵢ` we obtain -`c' * (c * xᵢ - f) ≤ c * c' - c - c'` -and as we already have `c * xᵢ - f ≥ 0`, -we conclude that `c * xᵢ - f = j` for some `j = 0, 1, ..., (c * c' - c - c')/c'` -(with, as usual the division rounded down). - -Note that the largest possible value of `j` occurs with `c'` is as large as possible. - -Thus the "dark" shadow is the variant of the real shadow where we replace each new inequality -with its strengthening. -The "grey" shadows are the union of the problems obtained by taking -a lower bound `f ≤ c * xᵢ` for `xᵢ` and some `j = 0, 1, ..., (c * m - c - m)/m`, where `m` -is the largest coefficient `c'` appearing in an upper bound `c' * xᵢ ≤ f'` for `xᵢ`, -and adding to the original problem (i.e. without doing any Fourier-Motzkin elimination) the single -new equation `c * xᵢ - f = j`, and the inequalities -`c * xᵢ - f > (c * m - c - m)/m` for each previously considered lower bound. - -As stated above, the satisfiability of the original problem is in fact equivalent to -the satisfiability of the real shadow, *and* the satisfiability of *either* the dark shadow, -or at least one of the grey shadows. - -TODO: implement the dark and grey shadows! - -### Disjunctions - -The omega algorithm as described above accumulates various disjunctions, -either coming from natural subtraction, or from the dark and grey shadows. - -When we encounter such a disjunction, we store it in a list of disjunctions, -but do not immediately split it. - -Instead we first try to find a contradiction (i.e. by eliminating equalities and inequalities) -without the disjunctive hypothesis. -If this fails, we then retrieve the first disjunction from the list, split it, -and try to find a contradiction in both branches. - -(Note that we make no attempt to optimize the order in which we split disjunctions: -it's currently on a first in first out basis.) - -The work done eliminating equalities can be reused when splitting disjunctions, -but we need to redo all the work eliminating inequalities in each branch. - -## Future work -* Implementation of dark and grey shadows. -* Identification of atoms up to associativity and commutativity of monomials. -* Further optimization. - * Some data is recomputed unnecessarily, e.g. the GCDs of coefficients. -* Sparse representation of coefficients. - * I have a branch in which this is implemented, modulo some proofs about algebraic operations - on sparse arrays. -* Case splitting on `Int.abs`? --/ diff --git a/Std/Tactic/Omega/Coeffs/IntList.lean b/Std/Tactic/Omega/Coeffs/IntList.lean deleted file mode 100644 index 94be9e134c..0000000000 --- a/Std/Tactic/Omega/Coeffs/IntList.lean +++ /dev/null @@ -1,108 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.IntList -import Std.Data.List.Basic - -/-! -# `Coeffs` as a wrapper for `IntList` - -Currently `omega` uses a dense representation for coefficients. -However, we can swap this out for a sparse representation. - -This file sets up `Coeffs` as a type synonym for `IntList`, -and abbreviations for the functions in the `IntList` namespace which we need to use in the -`omega` algorithm. - -There is an equivalent file setting up `Coeffs` as a type synonym for `AssocList Nat Int`, -currently in a private branch. -Not all the theorems about the algebraic operations on that representation have been proved yet. -When they are ready, we can replace the implementation in `omega` simply by importing -`Std.Tactic.Omega.Coeffs.IntDict` instead of `Std.Tactic.Omega.Coeffs.IntList`. - -For small problems, the sparse representation is actually slightly slower, -so it is not urgent to make this replacement. --/ - -namespace Std.Tactic.Omega - -/-- Type synonym for `IntList := List Int`. -/ -abbrev Coeffs := IntList - -namespace Coeffs - -/-- Identity, turning `Coeffs` into `List Int`. -/ -abbrev toList (xs : Coeffs) : List Int := xs -/-- Identity, turning `List Int` into `Coeffs`. -/ -abbrev ofList (xs : List Int) : Coeffs := xs -/-- Are the coefficients all zero? -/ -abbrev isZero (xs : Coeffs) : Prop := ∀ x, x ∈ xs → x = 0 -/-- Shim for `IntList.set`. -/ -abbrev set (xs : Coeffs) (i : Nat) (y : Int) : Coeffs := IntList.set xs i y -/-- Shim for `IntList.get`. -/ -abbrev get (xs : Coeffs) (i : Nat) : Int := IntList.get xs i -/-- Shim for `IntList.gcd`. -/ -abbrev gcd (xs : Coeffs) : Nat := IntList.gcd xs -/-- Shim for `IntList.smul`. -/ -abbrev smul (xs : Coeffs) (g : Int) : Coeffs := IntList.smul xs g -/-- Shim for `IntList.sdiv`. -/ -abbrev sdiv (xs : Coeffs) (g : Int) : Coeffs := IntList.sdiv xs g -/-- Shim for `IntList.dot`. -/ -abbrev dot (xs ys : Coeffs) : Int := IntList.dot xs ys -/-- Shim for `IntList.add`. -/ -abbrev add (xs ys : Coeffs) : Coeffs := IntList.add xs ys -/-- Shim for `IntList.sub`. -/ -abbrev sub (xs ys : Coeffs) : Coeffs := IntList.sub xs ys -/-- Shim for `IntList.neg`. -/ -abbrev neg (xs : Coeffs) : Coeffs := IntList.neg xs -/-- Shim for `IntList.combo`. -/ -abbrev combo (a : Int) (xs : Coeffs) (b : Int) (ys : Coeffs) : Coeffs := IntList.combo a xs b ys -/-- Shim for `List.length`. -/ -abbrev length (xs : Coeffs) := List.length xs -/-- Shim for `IntList.leading`. -/ -abbrev leading (xs : Coeffs) : Int := IntList.leading xs -/-- Shim for `List.map`. -/ -abbrev map (f : Int → Int) (xs : Coeffs) : Coeffs := List.map f xs -/-- Shim for `.enum.find?`. -/ -abbrev findIdx? (f : Int → Bool) (xs : Coeffs) : Option Nat := - List.findIdx? f xs - -- We could avoid `Std.Data.List.Basic` by using the less efficient: - -- xs.enum.find? (f ·.2) |>.map (·.1) -/-- Shim for `IntList.bmod`. -/ -abbrev bmod (x : Coeffs) (m : Nat) : Coeffs := IntList.bmod x m -/-- Shim for `IntList.bmod_dot_sub_dot_bmod`. -/ -abbrev bmod_dot_sub_dot_bmod (m : Nat) (a b : Coeffs) : Int := - IntList.bmod_dot_sub_dot_bmod m a b -theorem bmod_length (x : Coeffs) (m : Nat) : (bmod x m).length ≤ x.length := - IntList.bmod_length x m -theorem dvd_bmod_dot_sub_dot_bmod (m : Nat) (xs ys : Coeffs) : - (m : Int) ∣ bmod_dot_sub_dot_bmod m xs ys := IntList.dvd_bmod_dot_sub_dot_bmod m xs ys - -theorem get_of_length_le {i : Nat} {xs : Coeffs} (h : length xs ≤ i) : get xs i = 0 := - IntList.get_of_length_le h -theorem dot_set_left (xs ys : Coeffs) (i : Nat) (z : Int) : - dot (set xs i z) ys = dot xs ys + (z - get xs i) * get ys i := - IntList.dot_set_left xs ys i z -theorem dot_sdiv_left (xs ys : Coeffs) {d : Int} (h : d ∣ xs.gcd) : - dot (xs.sdiv d) ys = (dot xs ys) / d := - IntList.dot_sdiv_left xs ys h -theorem dot_smul_left (xs ys : Coeffs) (i : Int) : dot (i * xs) ys = i * dot xs ys := - IntList.dot_smul_left xs ys i -theorem dot_distrib_left (xs ys zs : Coeffs) : (xs + ys).dot zs = xs.dot zs + ys.dot zs := - IntList.dot_distrib_left xs ys zs -theorem sub_eq_add_neg (xs ys : Coeffs) : xs - ys = xs + -ys := - IntList.sub_eq_add_neg xs ys -theorem combo_eq_smul_add_smul (a : Int) (xs : Coeffs) (b : Int) (ys : Coeffs) : - combo a xs b ys = (a * xs) + (b * ys) := - IntList.combo_eq_smul_add_smul a xs b ys -theorem gcd_dvd_dot_left (xs ys : Coeffs) : (gcd xs : Int) ∣ dot xs ys := - IntList.gcd_dvd_dot_left xs ys -theorem map_length {xs : Coeffs} : (xs.map f).length ≤ xs.length := - Nat.le_of_eq (List.length_map xs f) - -theorem dot_nil_right {xs : Coeffs} : dot xs .nil = 0 := IntList.dot_nil_right -theorem get_nil : get .nil i = 0 := IntList.get_nil -theorem dot_neg_left (xs ys : IntList) : dot (-xs) ys = -dot xs ys := - IntList.dot_neg_left xs ys diff --git a/Std/Tactic/Omega/Config.lean b/Std/Tactic/Omega/Config.lean deleted file mode 100644 index eda2b57b7c..0000000000 --- a/Std/Tactic/Omega/Config.lean +++ /dev/null @@ -1,44 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Lean.Elab.Tactic.Config - -namespace Std.Tactic.Omega - -/-- Configures the behaviour of the `omega` tactic. -/ -structure OmegaConfig where - /-- - Split disjunctions in the context. - - Note that with `splitDisjunctions := false` omega will not be able to solve `x = y` goals - as these are usually handled by introducing `¬ x = y` as a hypothesis, then replacing this with - `x < y ∨ x > y`. - - On the other hand, `omega` does not currently detect disjunctions which, when split, - introduce no new useful information, so the presence of irrelevant disjunctions in the context - can significantly increase run time. - -/ - splitDisjunctions : Bool := true - /-- - Whenever `((a - b : Nat) : Int)` is found, register the disjunction - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0` - for later splitting. - -/ - splitNatSub : Bool := true - /-- - Whenever `Int.natAbs a` is found, register the disjunction - `0 ≤ a ∧ Int.natAbs a = a ∨ a < 0 ∧ Int.natAbs a = - a` for later splitting. - -/ - splitNatAbs : Bool := true - /-- - Whenever `min a b` or `max a b` is found, rewrite in terms of the definition - `if a ≤ b ...`, for later case splitting. - -/ - splitMinMax : Bool := true - -/-- -Allow elaboration of `OmegaConfig` arguments to tactics. --/ -declare_config_elab elabOmegaConfig OmegaConfig diff --git a/Std/Tactic/Omega/Constraint.lean b/Std/Tactic/Omega/Constraint.lean deleted file mode 100644 index 1bdcb00fd6..0000000000 --- a/Std/Tactic/Omega/Constraint.lean +++ /dev/null @@ -1,253 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Classes.Order -import Std.Data.Option.Lemmas -import Std.Tactic.Omega.Coeffs.IntList -/-! -A `Constraint` consists of an optional lower and upper bound (inclusive), -constraining a value to a set of the form `∅`, `{x}`, `[x, y]`, `[x, ∞)`, `(-∞, y]`, or `(-∞, ∞)`. --/ - -namespace Std.Tactic.Omega - -/-- An optional lower bound on a integer. -/ -abbrev LowerBound : Type := Option Int -/-- An optional upper bound on a integer. -/ -abbrev UpperBound : Type := Option Int - -/-- A lower bound at `x` is satisfied at `t` if `x ≤ t`. -/ -abbrev LowerBound.sat (b : LowerBound) (t : Int) := b.all fun x => x ≤ t -/-- A upper bound at `y` is satisfied at `t` if `t ≤ y`. -/ -abbrev UpperBound.sat (b : UpperBound) (t : Int) := b.all fun y => t ≤ y - -/-- -A `Constraint` consists of an optional lower and upper bound (inclusive), -constraining a value to a set of the form `∅`, `{x}`, `[x, y]`, `[x, ∞)`, `(-∞, y]`, or `(-∞, ∞)`. --/ -structure Constraint where - /-- A lower bound. -/ - lowerBound : LowerBound - /-- An upper bound. -/ - upperBound : UpperBound -deriving BEq, DecidableEq, Repr - -namespace Constraint - -open Lean in -instance : ToExpr Constraint where - toExpr s := - (Expr.const ``Constraint.mk []).app (toExpr s.lowerBound) |>.app (toExpr s.upperBound) - toTypeExpr := .const ``Constraint [] - -instance : ToString Constraint where - toString := fun - | ⟨none, none⟩ => "(-∞, ∞)" - | ⟨none, some y⟩ => s!"(-∞, {y}]" - | ⟨some x, none⟩ => s!"[{x}, ∞)" - | ⟨some x, some y⟩ => - if y < x then "∅" else if x = y then s!"\{{x}}" else s!"[{x}, {y}]" - -/-- A constraint is satisfied at `t` is both the lower bound and upper bound are satisfied. -/ -def sat (c : Constraint) (t : Int) : Bool := c.lowerBound.sat t ∧ c.upperBound.sat t - -/-- Apply a function to both the lower bound and upper bound. -/ -def map (c : Constraint) (f : Int → Int) : Constraint where - lowerBound := c.lowerBound.map f - upperBound := c.upperBound.map f - -/-- Translate a constraint. -/ -def translate (c : Constraint) (t : Int) : Constraint := c.map (· + t) - -theorem translate_sat : {c : Constraint} → {v : Int} → sat c v → sat (c.translate t) (v + t) := by - rintro ⟨_ | l, _ | u⟩ v w <;> simp_all [sat, translate, map] - · exact Int.add_le_add_right w t - · exact Int.add_le_add_right w t - · rcases w with ⟨w₁, w₂⟩; constructor - · exact Int.add_le_add_right w₁ t - · exact Int.add_le_add_right w₂ t - -/-- -Flip a constraint. -This operation is not useful by itself, but is used to implement `neg` and `scale`. --/ -def flip (c : Constraint) : Constraint where - lowerBound := c.upperBound - upperBound := c.lowerBound - -/-- -Negate a constraint. `[x, y]` becomes `[-y, -x]`. --/ -def neg (c : Constraint) : Constraint := c.flip.map (- ·) - -theorem neg_sat : {c : Constraint} → {v : Int} → sat c v → sat (c.neg) (-v) := by - rintro ⟨_ | l, _ | u⟩ v w <;> simp_all [sat, neg, flip, map] - · exact Int.neg_le_neg w - · exact Int.neg_le_neg w - · rcases w with ⟨w₁, w₂⟩; constructor - · exact Int.neg_le_neg w₂ - · exact Int.neg_le_neg w₁ - -/-- The trivial constraint, satisfied everywhere. -/ -def trivial : Constraint := ⟨none, none⟩ -/-- The impossible constraint, unsatisfiable. -/ -def impossible : Constraint := ⟨some 1, some 0⟩ -/-- An exact constraint. -/ -def exact (r : Int) : Constraint := ⟨some r, some r⟩ - -@[simp] theorem trivial_say : trivial.sat t := by - simp [sat, trivial] - -@[simp] theorem exact_sat (r : Int) (t : Int) : (exact r).sat t = decide (r = t) := by - simp only [sat, exact, Option.all_some, decide_eq_true_eq, decide_eq_decide] - exact Int.eq_iff_le_and_ge.symm - -/-- Check if a constraint is unsatisfiable. -/ -def isImpossible : Constraint → Bool - | ⟨some x, some y⟩ => y < x - | _ => false - -/-- Check if a constraint requires an exact value. -/ -def isExact : Constraint → Bool - | ⟨some x, some y⟩ => x = y - | _ => false - -theorem not_sat_of_isImpossible (h : isImpossible c) {t} : ¬ c.sat t := by - rcases c with ⟨_ | l, _ | u⟩ <;> simp [isImpossible, sat] at h ⊢ - intro w - rw [Int.not_le] - exact Int.lt_of_lt_of_le h w - -/-- -Scale a constraint by multiplying by an integer. -* If `k = 0` this is either impossible, if the original constraint was impossible, - or the `= 0` exact constraint. -* If `k` is positive this takes `[x, y]` to `[k * x, k * y]` -* If `k` is negative this takes `[x, y]` to `[k * y, k * x]`. --/ -def scale (k : Int) (c : Constraint) : Constraint := - if k = 0 then - if c.isImpossible then c else ⟨some 0, some 0⟩ - else if 0 < k then - c.map (k * ·) - else - c.flip.map (k * ·) - -theorem scale_sat {c : Constraint} (k) (w : c.sat t) : (scale k c).sat (k * t) := by - simp [scale] - split - · split - · simp_all [not_sat_of_isImpossible] - · simp_all [sat] - · rcases c with ⟨_ | l, _ | u⟩ <;> split <;> rename_i h <;> simp_all [sat, flip, map] - · replace h := Int.le_of_lt h - exact Int.mul_le_mul_of_nonneg_left w h - · rw [Int.not_lt] at h - exact Int.mul_le_mul_of_nonpos_left h w - · replace h := Int.le_of_lt h - exact Int.mul_le_mul_of_nonneg_left w h - · rw [Int.not_lt] at h - exact Int.mul_le_mul_of_nonpos_left h w - · constructor - · exact Int.mul_le_mul_of_nonneg_left w.1 (Int.le_of_lt h) - · exact Int.mul_le_mul_of_nonneg_left w.2 (Int.le_of_lt h) - · replace h := Int.not_lt.mp h - constructor - · exact Int.mul_le_mul_of_nonpos_left h w.2 - · exact Int.mul_le_mul_of_nonpos_left h w.1 - -/-- The sum of two constraints. `[a, b] + [c, d] = [a + c, b + d]`. -/ -def add (x y : Constraint) : Constraint where - lowerBound := x.lowerBound.bind fun a => y.lowerBound.map fun b => a + b - upperBound := x.upperBound.bind fun a => y.upperBound.map fun b => a + b - -theorem add_sat (w₁ : c₁.sat x₁) (w₂ : c₂.sat x₂) : (add c₁ c₂).sat (x₁ + x₂) := by - rcases c₁ with ⟨_ | l₁, _ | u₁⟩ <;> rcases c₂ with ⟨_ | l₂, _ | u₂⟩ - <;> simp [sat, LowerBound.sat, UpperBound.sat, add] at * - · exact Int.add_le_add w₁ w₂ - · exact Int.add_le_add w₁ w₂.2 - · exact Int.add_le_add w₁ w₂ - · exact Int.add_le_add w₁ w₂.1 - · exact Int.add_le_add w₁.2 w₂ - · exact Int.add_le_add w₁.1 w₂ - · constructor - · exact Int.add_le_add w₁.1 w₂.1 - · exact Int.add_le_add w₁.2 w₂.2 - -/-- A linear combination of two constraints. -/ -def combo (a : Int) (x : Constraint) (b : Int) (y : Constraint) : Constraint := - add (scale a x) (scale b y) - -theorem combo_sat (a) (w₁ : c₁.sat x₁) (b) (w₂ : c₂.sat x₂) : - (combo a c₁ b c₂).sat (a * x₁ + b * x₂) := - add_sat (scale_sat a w₁) (scale_sat b w₂) - -/-- The conjunction of two constraints. -/ -def combine (x y : Constraint) : Constraint where - lowerBound := max x.lowerBound y.lowerBound - upperBound := min x.upperBound y.upperBound - -theorem combine_sat : (c : Constraint) → (c' : Constraint) → (t : Int) → - (c.combine c').sat t = (c.sat t ∧ c'.sat t) := by - rintro ⟨_ | l₁, _ | u₁⟩ <;> rintro ⟨_ | l₂, _ | u₂⟩ t - <;> simp [sat, LowerBound.sat, UpperBound.sat, combine, Int.le_min, Int.max_le] at * - · rw [And.comm] - · rw [← and_assoc, And.comm (a := l₂ ≤ t), and_assoc] - · rw [and_assoc] - · rw [and_assoc] - · rw [and_assoc, and_assoc, And.comm (a := l₂ ≤ t)] - · rw [and_assoc, ← and_assoc (a := l₂ ≤ t), And.comm (a := l₂ ≤ t), and_assoc, and_assoc] - -/-- -Dividing a constraint by a natural number, and tightened to integer bounds. -Thus the lower bound is rounded up, and the upper bound is rounded down. --/ -def div (c : Constraint) (k : Nat) : Constraint where - lowerBound := c.lowerBound.map fun x => (- ((- x) / k)) - upperBound := c.upperBound.map fun y => y / k - -theorem div_sat (c : Constraint) (t : Int) (k : Nat) (n : k ≠ 0) (h : (k : Int) ∣ t) (w : c.sat t) : - (c.div k).sat (t / k) := by - replace n : (k : Int) > 0 := Int.ofNat_lt.mpr (Nat.pos_of_ne_zero n) - rcases c with ⟨_ | l, _ | u⟩ - · simp_all [sat, div] - · simp [sat, div] at w ⊢ - apply Int.le_of_sub_nonneg - rw [← Int.sub_ediv_of_dvd _ h, ← ge_iff_le, Int.div_nonneg_iff_of_pos n] - exact Int.sub_nonneg_of_le w - · simp [sat, div] at w ⊢ - apply Int.le_of_sub_nonneg - rw [Int.sub_neg, ← Int.add_ediv_of_dvd_left h, ← ge_iff_le, - Int.div_nonneg_iff_of_pos n] - exact Int.sub_nonneg_of_le w - · simp [sat, div] at w ⊢ - constructor - · apply Int.le_of_sub_nonneg - rw [Int.sub_neg, ← Int.add_ediv_of_dvd_left h, ← ge_iff_le, - Int.div_nonneg_iff_of_pos n] - exact Int.sub_nonneg_of_le w.1 - · apply Int.le_of_sub_nonneg - rw [← Int.sub_ediv_of_dvd _ h, ← ge_iff_le, Int.div_nonneg_iff_of_pos n] - exact Int.sub_nonneg_of_le w.2 - -/-- -It is convenient below to say that a constraint is satisfied at the dot product of two vectors, -so we make an abbreviation `sat'` for this. --/ -abbrev sat' (c : Constraint) (x y : Coeffs) := c.sat (Coeffs.dot x y) - -theorem combine_sat' {s t : Constraint} {x y} (ws : s.sat' x y) (wt : t.sat' x y) : - (s.combine t).sat' x y := (combine_sat _ _ _).mpr ⟨ws, wt⟩ - -theorem div_sat' {c : Constraint} {x y} (h : Coeffs.gcd x ≠ 0) (w : c.sat (Coeffs.dot x y)) : - (c.div (Coeffs.gcd x)).sat' (Coeffs.sdiv x (Coeffs.gcd x)) y := by - dsimp [sat'] - rw [Coeffs.dot_sdiv_left _ _ (Int.dvd_refl _)] - exact div_sat c _ (Coeffs.gcd x) h (Coeffs.gcd_dvd_dot_left x y) w - -theorem not_sat'_of_isImpossible (h : isImpossible c) {x y} : ¬ c.sat' x y := - not_sat_of_isImpossible h - -end Constraint diff --git a/Std/Tactic/Omega/Core.lean b/Std/Tactic/Omega/Core.lean deleted file mode 100644 index fd5738f601..0000000000 --- a/Std/Tactic/Omega/Core.lean +++ /dev/null @@ -1,691 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.OmegaM -import Std.Tactic.Omega.Constraint -import Std.Tactic.Omega.MinNatAbs - -open Lean (HashMap HashSet) - -namespace Std.Tactic.Omega - -open Lean (Expr) -open Lean.Meta - -/-- -A delayed proof that a constraint is satisfied at the atoms. --/ -abbrev Proof : Type := OmegaM Expr - -/-- -Normalize a constraint, by dividing through by the GCD. - -Return `none` if there is nothing to do, to avoid adding unnecessary steps to the proof term. --/ -def normalize? : Constraint × Coeffs → Option (Constraint × Coeffs) - | ⟨s, x⟩ => - let gcd := Coeffs.gcd x -- TODO should we be caching this? - if gcd = 0 then - if s.sat 0 then - some (.trivial, x) - else - some (.impossible, x) - else if gcd = 1 then - none - else - some (s.div gcd, Coeffs.sdiv x gcd) - -/-- Normalize a constraint, by dividing through by the GCD. -/ -def normalize (p : Constraint × Coeffs) : Constraint × Coeffs := - normalize? p |>.getD p - -/-- Shorthand for the first component of `normalize`. -/ --- This `noncomputable` (and others below) is a safeguard that we only use this in proofs. -noncomputable abbrev normalizeConstraint (s : Constraint) (x : Coeffs) : Constraint := - (normalize (s, x)).1 -/-- Shorthand for the second component of `normalize`. -/ -noncomputable abbrev normalizeCoeffs (s : Constraint) (x : Coeffs) : Coeffs := - (normalize (s, x)).2 - -theorem normalize?_eq_some (w : normalize? (s, x) = some (s', x')) : - normalizeConstraint s x = s' ∧ normalizeCoeffs s x = x' := by - simp_all [normalizeConstraint, normalizeCoeffs, normalize] - -theorem normalize_sat {s x v} (w : s.sat' x v) : - (normalizeConstraint s x).sat' (normalizeCoeffs s x) v := by - dsimp [normalizeConstraint, normalizeCoeffs, normalize, normalize?] - split <;> rename_i h - · split - · simp - · dsimp [Constraint.sat'] at w - simp_all - · split - · exact w - · exact Constraint.div_sat' h w - -/-- Multiply by `-1` if the leading coefficient is negative, otherwise return `none`. -/ -def positivize? : Constraint × Coeffs → Option (Constraint × Coeffs) - | ⟨s, x⟩ => - if 0 ≤ x.leading then - none - else - (s.neg, Coeffs.smul x (-1)) - -/-- Multiply by `-1` if the leading coefficient is negative, otherwise do nothing. -/ -noncomputable def positivize (p : Constraint × Coeffs) : Constraint × Coeffs := - positivize? p |>.getD p - -/-- Shorthand for the first component of `positivize`. -/ -noncomputable abbrev positivizeConstraint (s : Constraint) (x : Coeffs) : Constraint := - (positivize (s, x)).1 -/-- Shorthand for the second component of `positivize`. -/ -noncomputable abbrev positivizeCoeffs (s : Constraint) (x : Coeffs) : Coeffs := - (positivize (s, x)).2 - -theorem positivize?_eq_some (w : positivize? (s, x) = some (s', x')) : - positivizeConstraint s x = s' ∧ positivizeCoeffs s x = x' := by - simp_all [positivizeConstraint, positivizeCoeffs, positivize] - -theorem positivize_sat {s x v} (w : s.sat' x v) : - (positivizeConstraint s x).sat' (positivizeCoeffs s x) v := by - dsimp [positivizeConstraint, positivizeCoeffs, positivize, positivize?] - split - · exact w - · simp [Constraint.sat'] - erw [Coeffs.dot_smul_left, ← Int.neg_eq_neg_one_mul] - exact Constraint.neg_sat w - -/-- `positivize` and `normalize`, returning `none` if neither does anything. -/ -def tidy? : Constraint × Coeffs → Option (Constraint × Coeffs) - | ⟨s, x⟩ => - match positivize? (s, x) with - | none => match normalize? (s, x) with - | none => none - | some (s', x') => some (s', x') - | some (s', x') => normalize (s', x') - -/-- `positivize` and `normalize` -/ -def tidy (p : Constraint × Coeffs) : Constraint × Coeffs := - tidy? p |>.getD p - -/-- Shorthand for the first component of `tidy`. -/ -abbrev tidyConstraint (s : Constraint) (x : Coeffs) : Constraint := (tidy (s, x)).1 -/-- Shorthand for the second component of `tidy`. -/ -abbrev tidyCoeffs (s : Constraint) (x : Coeffs) : Coeffs := (tidy (s, x)).2 - -theorem tidy_sat {s x v} (w : s.sat' x v) : (tidyConstraint s x).sat' (tidyCoeffs s x) v := by - dsimp [tidyConstraint, tidyCoeffs, tidy, tidy?] - split <;> rename_i hp - · split <;> rename_i hn - · simp_all - · rcases normalize?_eq_some hn with ⟨rfl, rfl⟩ - exact normalize_sat w - · rcases positivize?_eq_some hp with ⟨rfl, rfl⟩ - exact normalize_sat (positivize_sat w) - -theorem combo_sat' (s t : Constraint) - (a : Int) (x : Coeffs) (b : Int) (y : Coeffs) (v : Coeffs) - (wx : s.sat' x v) (wy : t.sat' y v) : - (Constraint.combo a s b t).sat' (Coeffs.combo a x b y) v := by - rw [Constraint.sat', Coeffs.combo_eq_smul_add_smul, Coeffs.dot_distrib_left, - Coeffs.dot_smul_left, Coeffs.dot_smul_left] - exact Constraint.combo_sat a wx b wy - -/-- The value of the new variable introduced when solving a hard equality. -/ -abbrev bmod_div_term (m : Nat) (a b : Coeffs) : Int := Coeffs.bmod_dot_sub_dot_bmod m a b / m - -/-- The coefficients of the new equation generated when solving a hard equality. -/ -def bmod_coeffs (m : Nat) (i : Nat) (x : Coeffs) : Coeffs := - Coeffs.set (Coeffs.bmod x m) i m - -theorem bmod_sat (m : Nat) (r : Int) (i : Nat) (x v : Coeffs) - (h : x.length ≤ i) -- during proof reconstruction this will be by `decide` - (p : Coeffs.get v i = bmod_div_term m x v) -- and this will be by `rfl` - (w : (Constraint.exact r).sat' x v) : - (Constraint.exact (Int.bmod r m)).sat' (bmod_coeffs m i x) v := by - simp at w - simp only [p, bmod_coeffs, Constraint.exact_sat, Coeffs.dot_set_left, decide_eq_true_eq] - replace h := Nat.le_trans (Coeffs.bmod_length x m) h - rw [Coeffs.get_of_length_le h, Int.sub_zero, - Int.mul_ediv_cancel' (Coeffs.dvd_bmod_dot_sub_dot_bmod _ _ _), w, - ← Int.add_sub_assoc, Int.add_comm, Int.add_sub_assoc, Int.sub_self, Int.add_zero] - -/-- -Our internal representation of argument "justifying" that a constraint holds on some coefficients. -We'll use this to construct the proof term once a contradiction is found. --/ -inductive Justification : Constraint → Coeffs → Type - /-- - `Problem.assumptions[i]` generates a proof that `s.sat' coeffs atoms` - -/ - | assumption (s : Constraint) (x : Coeffs) (i : Nat) : Justification s x - /-- The result of `tidy` on another `Justification`. -/ - | tidy (j : Justification s c) : Justification (tidyConstraint s c) (tidyCoeffs s c) - /-- The result of `combine` on two `Justifications`. -/ - | combine {s t c} (j : Justification s c) (k : Justification t c) : Justification (s.combine t) c - /-- A linear `combo` of two `Justifications`. -/ - | combo {s t x y} (a : Int) (j : Justification s x) (b : Int) (k : Justification t y) : - Justification (Constraint.combo a s b t) (Coeffs.combo a x b y) - /-- - The justification for the constraing constructed using "balanced mod" while - eliminating an equality. - -/ - | bmod (m : Nat) (r : Int) (i : Nat) {x} (j : Justification (.exact r) x) : - Justification (.exact (Int.bmod r m)) (bmod_coeffs m i x) - -/-- Wrapping for `Justification.tidy` when `tidy?` is nonempty. -/ -nonrec def Justification.tidy? (j : Justification s c) : Option (Σ s' c', Justification s' c') := - match tidy? (s, c) with - | some _ => some ⟨_, _, tidy j⟩ - | none => none - -namespace Justification - -private def bullet (s : String) := "• " ++ s.replace "\n" "\n " - -/-- Print a `Justification` as an indented tree structure. -/ -def toString : Justification s x → String - | assumption _ _ i => s!"{x} ∈ {s}: assumption {i}" - | @tidy s' x' j => - if s == s' && x == x' then j.toString else s!"{x} ∈ {s}: tidying up:\n" ++ bullet j.toString - | combine j k => - s!"{x} ∈ {s}: combination of:\n" ++ bullet j.toString ++ "\n" ++ bullet k.toString - | combo a j b k => - s!"{x} ∈ {s}: {a} * x + {b} * y combo of:\n" ++ bullet j.toString ++ "\n" ++ bullet k.toString - | bmod m _ i j => - s!"{x} ∈ {s}: bmod with m={m} and i={i} of:\n" ++ bullet j.toString - -instance : ToString (Justification s x) where toString := toString - -open Lean - -/-- Construct the proof term associated to a `tidy` step. -/ -def tidyProof (s : Constraint) (x : Coeffs) (v : Expr) (prf : Expr) : Expr := - mkApp4 (.const ``tidy_sat []) (toExpr s) (toExpr x) v prf - -/-- Construct the proof term associated to a `combine` step. -/ -def combineProof (s t : Constraint) (x : Coeffs) (v : Expr) (ps pt : Expr) : Expr := - mkApp6 (.const ``Constraint.combine_sat' []) (toExpr s) (toExpr t) (toExpr x) v ps pt - -/-- Construct the proof term associated to a `combo` step. -/ -def comboProof (s t : Constraint) (a : Int) (x : Coeffs) (b : Int) (y : Coeffs) - (v : Expr) (px py : Expr) : Expr := - mkApp9 (.const ``combo_sat' []) (toExpr s) (toExpr t) (toExpr a) (toExpr x) (toExpr b) (toExpr y) - v px py - -/-- Construct the proof term associated to a `bmod` step. -/ -def bmodProof (m : Nat) (r : Int) (i : Nat) (x : Coeffs) (v : Expr) (w : Expr) : MetaM Expr := do - let m := toExpr m - let r := toExpr r - let i := toExpr i - let x := toExpr x - let h ← mkDecideProof (mkApp4 (.const ``LE.le [.zero]) (.const ``Nat []) (.const ``instLENat []) - (.app (.const ``Coeffs.length []) x) i) - let lhs := mkApp2 (.const ``Coeffs.get []) v i - let rhs := mkApp3 (.const ``bmod_div_term []) m x v - let p ← mkEqReflWithExpectedType lhs rhs - return mkApp8 (.const ``bmod_sat []) m r i x v h p w - --- TODO could we increase sharing in the proof term here? - -/-- Constructs a proof that `s.sat' c v = true` -/ -def proof (v : Expr) (assumptions : Array Proof) : Justification s c → Proof - | assumption s c i => assumptions[i]! - | @tidy s c j => return tidyProof s c v (← proof v assumptions j) - | @combine s t c j k => - return combineProof s t c v (← proof v assumptions j) (← proof v assumptions k) - | @combo s t x y a j b k => - return comboProof s t a x b y v (← proof v assumptions j) (← proof v assumptions k) - | @bmod m r i x j => do bmodProof m r i x v (← proof v assumptions j) - -end Justification - -/-- A `Justification` bundled together with its parameters. -/ -structure Fact where - /-- The coefficients of a constraint. -/ - coeffs : Coeffs - /-- The constraint. -/ - constraint : Constraint - /-- The justification of a derived fact. -/ - justification : Justification constraint coeffs - -namespace Fact - -instance : ToString Fact where - toString f := toString f.justification - -/-- `tidy`, implemented on `Fact`. -/ -def tidy (f : Fact) : Fact := - match f.justification.tidy? with - | some ⟨_, _, justification⟩ => { justification } - | none => f - -/-- `combo`, implemented on `Fact`. -/ -def combo (a : Int) (f : Fact) (b : Int) (g : Fact) : Fact := - { justification := .combo a f.justification b g.justification } - -end Fact - -/-- -A `omega` problem. - -This is a hybrid structure: -it contains both `Expr` objects giving proofs of the "ground" assumptions -(or rather continuations which will produce the proofs when needed) -and internal representations of the linear constraints that we manipulate in the algorithm. - -While the algorithm is running we do not synthesize any new `Expr` proofs: proof extraction happens -only once we've found a contradiction. --/ -structure Problem where - /-- The ground assumptions that the algorithm starts from. -/ - assumptions : Array Proof := ∅ - /-- The number of variables in the problem. -/ - numVars : Nat := 0 - /-- The current constraints, indexed by their coefficients. -/ - constraints : HashMap Coeffs Fact := ∅ - /-- - The coefficients for which `constraints` contains an exact constraint (i.e. an equality). - -/ - equalities : HashSet Coeffs := ∅ - /-- - Equations that have already been used to eliminate variables, - along with the variable which was removed, and its coefficient (either `1` or `-1`). - The earlier elements are more recent, - so if these are being reapplied it is essential to use `List.foldr`. - -/ - eliminations : List (Fact × Nat × Int) := [] - /-- Whether the problem is possible. -/ - possible : Bool := true - /-- If the problem is impossible, then `proveFalse?` will contain a proof of `False`. -/ - proveFalse? : Option Proof := none - /-- Invariant between `possible` and `proveFalse?`. -/ - proveFalse?_spec : possible || proveFalse?.isSome := by rfl - /-- - If we have found a contradiction, - `explanation?` will contain a human readable account of the deriviation. - -/ - explanation? : Thunk String := "" - -namespace Problem - -/-- Check if a problem has no constraints. -/ -def isEmpty (p : Problem) : Bool := p.constraints.isEmpty - -instance : ToString Problem where - toString p := - if p.possible then - if p.isEmpty then - "trivial" - else - "\n".intercalate <| - (p.constraints.toList.map fun ⟨coeffs, ⟨_, cst, _⟩⟩ => s!"{coeffs} ∈ {cst}") - else - "impossible" - -open Lean in -/-- -Takes a proof that `s.sat' x v` for some `s` such that `s.isImpossible`, -and constructs a proof of `False`. --/ -def proveFalse {s x} (j : Justification s x) (assumptions : Array Proof) : Proof := do - let v := ← atomsCoeffs - let prf ← j.proof v assumptions - let x := toExpr x - let s := toExpr s - let impossible ← - mkDecideProof (← mkEq (mkApp (.const ``Constraint.isImpossible []) s) (.const ``true [])) - return mkApp5 (.const ``Constraint.not_sat'_of_isImpossible []) s impossible x v prf - -/-- -Insert a constraint into the problem, -without checking if there is already a constraint for these coefficients. --/ -def insertConstraint (p : Problem) : Fact → Problem - | f@⟨x, s, j⟩ => - if s.isImpossible then - { p with - possible := false - proveFalse? := some (proveFalse j p.assumptions) - explanation? := Thunk.mk fun _ => j.toString - proveFalse?_spec := rfl } - else - { p with - numVars := max p.numVars x.length - constraints := p.constraints.insert x f - proveFalse?_spec := p.proveFalse?_spec - equalities := - if f.constraint.isExact then - p.equalities.insert x - else - p.equalities } - -/-- -Add a constraint into the problem, -combining it with any existing constraints for the same coefficients. --/ -def addConstraint (p : Problem) : Fact → Problem - | f@⟨x, s, j⟩ => - if p.possible then - match p.constraints.find? x with - | none => - match s with - | .trivial => p - | _ => p.insertConstraint f - | some ⟨x', t, k⟩ => - if h : x = x' then - let r := s.combine t - if r = t then - -- No need to overwrite the existing fact - -- with the same fact with a more complicated justification - p - else - if r = s then - -- The new constraint is strictly stronger, no need to combine with the old one: - p.insertConstraint ⟨x, s, j⟩ - else - p.insertConstraint ⟨x, s.combine t, j.combine (h ▸ k)⟩ - else - p -- unreachable - else - p - -/-- -Walk through the equalities, finding either the first equality with minimal coefficient `±1`, -or otherwise the equality with minimal `(r.minNatAbs, r.maxNatAbs)` (ordered lexicographically). - -Returns the coefficients of the equality, along with the value of `minNatAbs`. - -Although we don't need to run a termination proof here, it's nevertheless important that we use this -ordering so the algorithm terminates in practice! --/ -def selectEquality (p : Problem) : Option (Coeffs × Nat) := - p.equalities.fold (init := none) fun - | none, c => (c, c.minNatAbs) - | some (r, m), c => - if 2 ≤ m then - let m' := c.minNatAbs - if (m' < m || m' = m && c.maxNatAbs < r.maxNatAbs) then - (c, m') - else - (r, m) - else - (r, m) - -/-- -If we have already solved some equalities, apply those to some new `Fact`. --/ -def replayEliminations (p : Problem) (f : Fact) : Fact := - p.eliminations.foldr (init := f) fun (f, i, s) g => - match Coeffs.get g.coeffs i with - | 0 => g - | y => Fact.combo (-1 * s * y) f 1 g - -/-- -Solve an "easy" equality, i.e. one with a coefficient that is `±1`. - -After solving, the variable will have been eliminated from all constraints. --/ -def solveEasyEquality (p : Problem) (c : Coeffs) : Problem := - let i := c.findIdx? (·.natAbs = 1) |>.getD 0 -- findIdx? is always some - let sign := c.get i |> Int.sign - match p.constraints.find? c with - | some f => - let init := - { assumptions := p.assumptions - eliminations := (f, i, sign) :: p.eliminations } - p.constraints.fold (init := init) fun p' coeffs g => - match Coeffs.get coeffs i with - | 0 => - p'.addConstraint g - | ci => - let k := -1 * sign * ci - p'.addConstraint (Fact.combo k f 1 g).tidy - | _ => p -- unreachable - -open Lean in -/-- -We deal with a hard equality by introducing a new easy equality. - -After solving the easy equality, -the minimum lexicographic value of `(c.minNatAbs, c.maxNatAbs)` will have been reduced. --/ -def dealWithHardEquality (p : Problem) (c : Coeffs) : OmegaM Problem := - match p.constraints.find? c with - | some ⟨_, ⟨some r, some r'⟩, j⟩ => do - let m := c.minNatAbs + 1 - -- We have to store the valid value of the newly introduced variable in the atoms. - let x := mkApp3 (.const ``bmod_div_term []) (toExpr m) (toExpr c) (← atomsCoeffs) - let (i, facts?) ← lookup x - if hr : r' = r then - match facts? with - | none => throwError "When solving hard equality, new atom had been seen before!" - | some facts => if ! facts.isEmpty then - throwError "When solving hard equality, there were unexpected new facts!" - return p.addConstraint { coeffs := _, constraint := _, justification := (hr ▸ j).bmod m r i } - else - throwError "Invalid constraint, expected an equation." -- unreachable - | _ => - return p -- unreachable - -/-- -Solve an equality, by deciding whether it is easy (has a `±1` coefficient) or hard, -and delegating to the appropriate function. --/ -def solveEquality (p : Problem) (c : Coeffs) (m : Nat) : OmegaM Problem := - if m = 1 then - return p.solveEasyEquality c - else - p.dealWithHardEquality c - -/-- Recursively solve all equalities. -/ -partial def solveEqualities (p : Problem) : OmegaM Problem := - if p.possible then - match p.selectEquality with - | some (c, m) => do (← p.solveEquality c m).solveEqualities - | none => return p - else return p - -theorem addInequality_sat (w : c + Coeffs.dot x y ≥ 0) : - Constraint.sat' { lowerBound := some (-c), upperBound := none } x y := by - simp [Constraint.sat', Constraint.sat] - rw [← Int.zero_sub c] - exact Int.sub_left_le_of_le_add w - -open Lean in -/-- Constructing the proof term for `addInequality`. -/ -def addInequality_proof (c : Int) (x : Coeffs) (p : Proof) : Proof := do - return mkApp4 (.const ``addInequality_sat []) (toExpr c) (toExpr x) (← atomsCoeffs) (← p) - -theorem addEquality_sat (w : c + Coeffs.dot x y = 0) : - Constraint.sat' { lowerBound := some (-c), upperBound := some (-c) } x y := by - simp [Constraint.sat', Constraint.sat] - rw [Int.eq_iff_le_and_ge] at w - rwa [Int.add_le_zero_iff_le_neg', Int.add_nonnneg_iff_neg_le', and_comm] at w - -open Lean in -/-- Constructing the proof term for `addEquality`. -/ -def addEquality_proof (c : Int) (x : Coeffs) (p : Proof) : Proof := do - return mkApp4 (.const ``addEquality_sat []) (toExpr c) (toExpr x) (← atomsCoeffs) (← p) - -/-- -Helper function for adding an inequality of the form `const + Coeffs.dot coeffs atoms ≥ 0` -to a `Problem`. - -(This is only used while initializing a `Problem`. During elimination we use `addConstraint`.) --/ --- We are given `prf? : const + Coeffs.dot coeffs atoms ≥ 0`, --- and need to transform this to `Coeffs.dot coeffs atoms ≥ -const`. -def addInequality (p : Problem) (const : Int) (coeffs : Coeffs) (prf? : Option Proof) : Problem := - let prf := prf?.getD (do mkSorry (← mkFreshExprMVar none) false) - let i := p.assumptions.size - let p' := { p with assumptions := p.assumptions.push (addInequality_proof const coeffs prf) } - let f : Fact := - { coeffs - constraint := { lowerBound := some (-const), upperBound := none } - justification := .assumption _ _ i } - let f := p.replayEliminations f - let f := f.tidy - p'.addConstraint f - -/-- -Helper function for adding an equality of the form `const + Coeffs.dot coeffs atoms = 0` -to a `Problem`. - -(This is only used while initializing a `Problem`. During elimination we use `addConstraint`.) --/ -def addEquality (p : Problem) (const : Int) (coeffs : Coeffs) (prf? : Option Proof) : Problem := - let prf := prf?.getD (do mkSorry (← mkFreshExprMVar none) false) - let i := p.assumptions.size - let p' := { p with assumptions := p.assumptions.push (addEquality_proof const coeffs prf) } - let f : Fact := - { coeffs - constraint := { lowerBound := some (-const), upperBound := some (-const) } - justification := .assumption _ _ i } - let f := p.replayEliminations f - let f := f.tidy - p'.addConstraint f - -/-- Folding `addInequality` over a list. -/ -def addInequalities (p : Problem) (ineqs : List (Int × Coeffs × Option Proof)) : Problem := - ineqs.foldl (init := p) fun p ⟨const, coeffs, prf?⟩ => p.addInequality const coeffs prf? - -/-- Folding `addEquality` over a list. -/ -def addEqualities (p : Problem) (eqs : List (Int × Coeffs × Option Proof)) : Problem := - eqs.foldl (init := p) fun p ⟨const, coeffs, prf?⟩ => p.addEquality const coeffs prf? - -/-- Representation of the data required to run Fourier-Motzkin elimination on a variable. -/ -structure FourierMotzkinData where - /-- Which variable is being eliminated. -/ - var : Nat - /-- The "irrelevant" facts which do not involve the target variable. -/ - irrelevant : List Fact := [] - /-- - The facts which give a lower bound on the target variable, - and the coefficient of the target variable in each. - -/ - lowerBounds : List (Fact × Int) := [] - /-- - The facts which give an upper bound on the target variable, - and the coefficient of the target variable in each. - -/ - upperBounds : List (Fact × Int) := [] - /-- - Whether the elimination would be exact, because all of the lower bound coefficients are `±1`. - -/ - lowerExact : Bool := true - /-- - Whether the elimination would be exact, because all of the upper bound coefficients are `±1`. - -/ - upperExact : Bool := true -deriving Inhabited - -instance : ToString FourierMotzkinData where - toString d := - let irrelevant := d.irrelevant.map fun ⟨x, s, _⟩ => s!"{x} ∈ {s}" - let lowerBounds := d.lowerBounds.map fun ⟨⟨x, s, _⟩, _⟩ => s!"{x} ∈ {s}" - let upperBounds := d.upperBounds.map fun ⟨⟨x, s, _⟩, _⟩ => s!"{x} ∈ {s}" - s!"Fourier-Motzkin elimination data for variable {d.var}\n" - ++ s!"• irrelevant: {irrelevant}\n" - ++ s!"• lowerBounds: {lowerBounds}\n" - ++ s!"• upperBounds: {upperBounds}" - -/-- Is a Fourier-Motzkin elimination empty (i.e. there are no relevant constraints). -/ -def FourierMotzkinData.isEmpty (d : FourierMotzkinData) : Bool := - d.lowerBounds.isEmpty && d.upperBounds.isEmpty -/-- The number of new constraints that would be introduced by Fourier-Motzkin elimination. -/ -def FourierMotzkinData.size (d : FourierMotzkinData) : Nat := - d.lowerBounds.length * d.upperBounds.length -/-- Is the Fourier-Motzkin elimination known to be exact? -/ -def FourierMotzkinData.exact (d : FourierMotzkinData) : Bool := d.lowerExact || d.upperExact - -/-- Prepare the Fourier-Motzkin elimination data for each variable. -/ --- TODO we could short-circuit here, if we find one with `size = 0`. -def fourierMotzkinData (p : Problem) : Array FourierMotzkinData := Id.run do - let n := p.numVars - let mut data : Array FourierMotzkinData := - (List.range p.numVars).foldl (fun a i => a.push { var := i}) #[] - for (_, f@⟨xs, s, _⟩) in p.constraints.toList do -- We could make a forIn instance for HashMap - for i in [0:n] do - let x := Coeffs.get xs i - data := data.modify i fun d => - if x = 0 then - { d with irrelevant := f :: d.irrelevant } - else Id.run do - let s' := s.scale x - let mut d' := d - if s'.lowerBound.isSome then - d' := { d' with - lowerBounds := (f, x) :: d'.lowerBounds - lowerExact := d'.lowerExact && x.natAbs = 1 } - if s'.upperBound.isSome then - d' := { d' with - upperBounds := (f, x) :: d'.upperBounds - upperExact := d'.upperExact && x.natAbs = 1 } - return d' - return data - -/-- -Decides which variable to run Fourier-Motzkin elimination on, and returns the associated data. - -We prefer eliminations which introduce no new inequalities, or otherwise exact eliminations, -and break ties by the number of new inequalities introduced. --/ -def fourierMotzkinSelect (data : Array FourierMotzkinData) : FourierMotzkinData := Id.run do - let data := data.filter fun d => ¬ d.isEmpty - let mut bestIdx := 0 - let mut bestSize := data[0]!.size - let mut bestExact := data[0]!.exact - if bestSize = 0 then return data[0]! - for i in [1:data.size] do - let exact := data[i]!.exact - let size := data[i]!.size - if size = 0 || !bestExact && exact || size < bestSize then - if size = 0 then return data[i]! - bestIdx := i - bestExact := exact - bestSize := size - return data[bestIdx]! - -/-- -Run Fourier-Motzkin elimination on one variable. --/ -def fourierMotzkin (p : Problem) : Problem := Id.run do - let data := p.fourierMotzkinData - -- Now perform the elimination. - let ⟨_, irrelevant, lower, upper, _, _⟩ := fourierMotzkinSelect data - let mut r : Problem := { assumptions := p.assumptions, eliminations := p.eliminations } - for f in irrelevant do - r := r.insertConstraint f - for ⟨f, b⟩ in lower do - for ⟨g, a⟩ in upper do - r := r.addConstraint (Fact.combo a f (-b) g).tidy - return r - -mutual - -/-- -Run the `omega` algorithm (for now without dark and grey shadows!) on a problem. --/ -partial def runOmega (p : Problem) : OmegaM Problem := do - trace[omega] "Running omega on:\n{p}" - if p.possible then - let p' ← p.solveEqualities - elimination p' - else - return p - -/-- As for `runOmega`, but assuming the first round of solving equalities has already happened. -/ -partial def elimination (p : Problem) : OmegaM Problem := - if p.possible then - if p.isEmpty then - return p - else do - trace[omega] "Running Fourier-Motzkin elimination on:\n{p}" - runOmega p.fourierMotzkin - else - return p - -end diff --git a/Std/Tactic/Omega/Frontend.lean b/Std/Tactic/Omega/Frontend.lean deleted file mode 100644 index 7ed447c428..0000000000 --- a/Std/Tactic/Omega/Frontend.lean +++ /dev/null @@ -1,570 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.Core -import Std.Tactic.Omega.LinearCombo -import Std.Tactic.Omega.Logic -import Std.Tactic.Omega.Int -import Std.Tactic.FalseOrByContra -import Std.Lean.Meta.Basic -import Std.Lean.Elab.Tactic - -/-! -# Frontend to the `omega` tactic. - -See `Std.Tactic.Omega` for an overview of the tactic. --/ - -open Lean Meta - -namespace Std.Tactic.Omega - -/-- -A partially processed `omega` context. - -We have: -* a `Problem` representing the integer linear constraints extracted so far, and their proofs -* the unprocessed `facts : List Expr` taken from the local context, -* the unprocessed `disjunctions : List Expr`, - which will only be split one at a time if we can't otherwise find a contradiction. - -We begin with `facts := ← getLocalHyps` and `problem := .trivial`, -and progressively process the facts. - -As we process the facts, we may generate additional facts -(e.g. about coercions and integer divisions). -To avoid duplicates, we maintain a `HashSet` of previously processed facts. --/ -structure MetaProblem where - /-- An integer linear arithmetic problem. -/ - problem : Problem := {} - /-- Pending facts which have not been processed yet. -/ - facts : List Expr := [] - /-- - Pending disjunctions, which we will case split one at a time if we can't get a contradiction. - -/ - disjunctions : List Expr := [] - /-- Facts which have already been processed; we keep these to avoid duplicates. -/ - processedFacts : HashSet Expr := ∅ - -/-- Construct the `rfl` proof that `lc.eval atoms = e`. -/ -def mkEvalRflProof (e : Expr) (lc : LinearCombo) : OmegaM Expr := do - mkEqReflWithExpectedType e (mkApp2 (.const ``LinearCombo.eval []) (toExpr lc) (← atomsCoeffs)) - -/-- If `e : Expr` is the `n`-th atom, construct the proof that -`e = (coordinate n).eval atoms`. -/ -def mkCoordinateEvalAtomsEq (e : Expr) (n : Nat) : OmegaM Expr := do - if n < 10 then - let atoms := (← getThe State).atoms - let tail ← mkListLit (.const ``Int []) atoms[n+1:].toArray.toList - let lem := .str ``LinearCombo s!"coordinate_eval_{n}" - mkEqSymm (mkAppN (.const lem []) (atoms[:n+1].toArray.push tail)) - else - let atoms ← atomsCoeffs - let n := toExpr n - -- Construct the `rfl` proof that `e = (atoms.get? n).getD 0` - let eq ← mkEqReflWithExpectedType e (mkApp2 (.const ``Coeffs.get []) atoms n) - mkEqTrans eq (← mkEqSymm (mkApp2 (.const ``LinearCombo.coordinate_eval []) n atoms)) - -/-- Construct the linear combination (and its associated proof and new facts) for an atom. -/ -def mkAtomLinearCombo (e : Expr) : OmegaM (LinearCombo × OmegaM Expr × HashSet Expr) := do - let (n, facts) ← lookup e - return ⟨LinearCombo.coordinate n, mkCoordinateEvalAtomsEq e n, facts.getD ∅⟩ - --- This has been PR'd as --- https://github.com/leanprover/lean4/pull/2900 --- and can be removed when that is merged. -@[inherit_doc mkAppN] -local macro_rules - | `(mkAppN $f #[$xs,*]) => (xs.getElems.foldlM (fun x e => `(Expr.app $x $e)) f : MacroM Term) - -mutual - -/-- -Wrapper for `asLinearComboImpl`, -using a cache for previously visited expressions. - -Gives a small (10%) speedup in testing. -I tried using a pointer based cache, -but there was never enough subexpression sharing to make it effective. --/ -partial def asLinearCombo (e : Expr) : OmegaM (LinearCombo × OmegaM Expr × HashSet Expr) := do - let cache ← get - match cache.find? e with - | some (lc, prf) => - trace[omega] "Found in cache: {e}" - return (lc, prf, ∅) - | none => - let r ← asLinearComboImpl e - modifyThe Cache fun cache => (cache.insert e (r.1, r.2.1.run' cache)) - pure r - -/-- -Translates an expression into a `LinearCombo`. -Also returns: -* a proof that this linear combo evaluated at the atoms is equal to the original expression -* a list of new facts which should be recorded: - * for each new atom `a` of the form `((x : Nat) : Int)`, the fact that `0 ≤ a` - * for each new atom `a` of the form `x / k`, for `k` a positive numeral, the facts that - `k * a ≤ x < (k + 1) * a` - * for each new atom of the form `((a - b : Nat) : Int)`, the fact: - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0` - -We also transform the expression as we descend into it: -* pushing coercions: `↑(x + y)`, `↑(x * y)`, `↑(x / k)`, `↑(x % k)`, `↑k` -* unfolding `emod`: `x % k` → `x - x / k` --/ -partial def asLinearComboImpl (e : Expr) : OmegaM (LinearCombo × OmegaM Expr × HashSet Expr) := do - trace[omega] "processing {e}" - match e.int? with - | some i => - let lc := {const := i} - return ⟨lc, mkEvalRflProof e lc, ∅⟩ - | none => - if e.isFVar then - if let some v ← e.fvarId!.getValue? then - rewrite e (← mkEqReflWithExpectedType e v) - else - mkAtomLinearCombo e - else match e.getAppFnArgs with - | (``HAdd.hAdd, #[_, _, _, _, e₁, e₂]) => do - let (l₁, prf₁, facts₁) ← asLinearCombo e₁ - let (l₂, prf₂, facts₂) ← asLinearCombo e₂ - let prf : OmegaM Expr := do - let add_eval := - mkApp3 (.const ``LinearCombo.add_eval []) (toExpr l₁) (toExpr l₂) (← atomsCoeffs) - mkEqTrans - (← mkAppM ``Int.add_congr #[← prf₁, ← prf₂]) - (← mkEqSymm add_eval) - pure (l₁ + l₂, prf, facts₁.merge facts₂) - | (``HSub.hSub, #[_, _, _, _, e₁, e₂]) => do - let (l₁, prf₁, facts₁) ← asLinearCombo e₁ - let (l₂, prf₂, facts₂) ← asLinearCombo e₂ - let prf : OmegaM Expr := do - let sub_eval := - mkApp3 (.const ``LinearCombo.sub_eval []) (toExpr l₁) (toExpr l₂) (← atomsCoeffs) - mkEqTrans - (← mkAppM ``Int.sub_congr #[← prf₁, ← prf₂]) - (← mkEqSymm sub_eval) - pure (l₁ - l₂, prf, facts₁.merge facts₂) - | (``Neg.neg, #[_, _, e']) => do - let (l, prf, facts) ← asLinearCombo e' - let prf' : OmegaM Expr := do - let neg_eval := mkApp2 (.const ``LinearCombo.neg_eval []) (toExpr l) (← atomsCoeffs) - mkEqTrans - (← mkAppM ``Int.neg_congr #[← prf]) - (← mkEqSymm neg_eval) - pure (-l, prf', facts) - | (``HMul.hMul, #[_, _, _, _, x, y]) => - -- If we decide not to expand out the multiplication, - -- we have to revert the `OmegaM` state so that any new facts about the factors - -- can still be reported when they are visited elsewhere. - let r? ← commitWhen do - let (xl, xprf, xfacts) ← asLinearCombo x - let (yl, yprf, yfacts) ← asLinearCombo y - if xl.coeffs.isZero ∨ yl.coeffs.isZero then - let prf : OmegaM Expr := do - let h ← mkDecideProof (mkApp2 (.const ``Or []) - (.app (.const ``Coeffs.isZero []) (toExpr xl.coeffs)) - (.app (.const ``Coeffs.isZero []) (toExpr yl.coeffs))) - let mul_eval := - mkApp4 (.const ``LinearCombo.mul_eval []) (toExpr xl) (toExpr yl) (← atomsCoeffs) h - mkEqTrans - (← mkAppM ``Int.mul_congr #[← xprf, ← yprf]) - (← mkEqSymm mul_eval) - pure (some (LinearCombo.mul xl yl, prf, xfacts.merge yfacts), true) - else - pure (none, false) - match r? with - | some r => pure r - | none => mkAtomLinearCombo e - | (``HMod.hMod, #[_, _, _, _, n, k]) => - match natCast? k with - | some _ => rewrite e (mkApp2 (.const ``Int.emod_def []) n k) - | none => mkAtomLinearCombo e - | (``HDiv.hDiv, #[_, _, _, _, x, z]) => - match intCast? z with - | some 0 => rewrite e (mkApp (.const ``Int.ediv_zero []) x) - | some i => - if i < 0 then - rewrite e (mkApp2 (.const ``Int.ediv_neg []) x (toExpr (-i))) - else - mkAtomLinearCombo e - | _ => mkAtomLinearCombo e - | (``Min.min, #[_, _, a, b]) => - if (← cfg).splitMinMax then - rewrite e (mkApp2 (.const ``Int.min_def []) a b) - else - mkAtomLinearCombo e - | (``Max.max, #[_, _, a, b]) => - if (← cfg).splitMinMax then - rewrite e (mkApp2 (.const ``Int.max_def []) a b) - else - mkAtomLinearCombo e - | (``Nat.cast, #[.const ``Int [], i, n]) => - match n with - | .fvar h => - if let some v ← h.getValue? then - rewrite e (← mkEqReflWithExpectedType e - (mkApp3 (.const ``Nat.cast [0]) (.const ``Int []) i v)) - else - mkAtomLinearCombo e - | _ => match n.getAppFnArgs with - | (``Nat.succ, #[n]) => rewrite e (.app (.const ``Int.ofNat_succ []) n) - | (``HAdd.hAdd, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_add []) a b) - | (``HMul.hMul, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_mul []) a b) - | (``HDiv.hDiv, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_ediv []) a b) - | (``OfNat.ofNat, #[_, n, _]) => rewrite e (.app (.const ``Int.natCast_ofNat []) n) - | (``HMod.hMod, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_emod []) a b) - | (``HSub.hSub, #[_, _, _, _, mkAppN (.const ``HSub.hSub _) #[_, _, _, _, a, b], c]) => - rewrite e (mkApp3 (.const ``Int.ofNat_sub_sub []) a b c) - | (``Prod.fst, #[_, β, p]) => match p with - | .app (.app (.app (.app (.const ``Prod.mk [0, v]) _) _) x) y => - rewrite e (mkApp3 (.const ``Int.ofNat_fst_mk [v]) β x y) - | _ => mkAtomLinearCombo e - | (``Prod.snd, #[α, _, p]) => match p with - | .app (.app (.app (.app (.const ``Prod.mk [u, 0]) _) _) x) y => - rewrite e (mkApp3 (.const ``Int.ofNat_snd_mk [u]) α x y) - | _ => mkAtomLinearCombo e - | (``Min.min, #[_, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_min []) a b) - | (``Max.max, #[_, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_max []) a b) - | (``Int.natAbs, #[n]) => - if (← cfg).splitNatAbs then - rewrite e (mkApp (.const ``Int.ofNat_natAbs []) n) - else - mkAtomLinearCombo e - | _ => mkAtomLinearCombo e - | (``Prod.fst, #[α, β, p]) => match p with - | .app (.app (.app (.app (.const ``Prod.mk [u, v]) _) _) x) y => - rewrite e (mkApp4 (.const ``Prod.fst_mk [u, v]) α x β y) - | _ => mkAtomLinearCombo e - | (``Prod.snd, #[α, β, p]) => match p with - | .app (.app (.app (.app (.const ``Prod.mk [u, v]) _) _) x) y => - rewrite e (mkApp4 (.const ``Prod.snd_mk [u, v]) α x β y) - | _ => mkAtomLinearCombo e - | _ => mkAtomLinearCombo e -where - /-- - Apply a rewrite rule to an expression, and interpret the result as a `LinearCombo`. - (We're not rewriting any subexpressions here, just the top level, for efficiency.) - -/ - rewrite (lhs rw : Expr) : OmegaM (LinearCombo × OmegaM Expr × HashSet Expr) := do - trace[omega] "rewriting {lhs} via {rw} : {← inferType rw}" - match (← inferType rw).eq? with - | some (_, _lhs', rhs) => - let (lc, prf, facts) ← asLinearCombo rhs - let prf' : OmegaM Expr := do mkEqTrans rw (← prf) - pure (lc, prf', facts) - | none => panic! "Invalid rewrite rule in 'asLinearCombo'" - -end -namespace MetaProblem - -/-- The trivial `MetaProblem`, with no facts to processs and a trivial `Problem`. -/ -def trivial : MetaProblem where - problem := {} - -instance : Inhabited MetaProblem := ⟨trivial⟩ - -/-- -Add an integer equality to the `Problem`. - -We solve equalities as they are discovered, as this often results in an earlier contradiction. --/ -def addIntEquality (p : MetaProblem) (h x : Expr) : OmegaM MetaProblem := do - let (lc, prf, facts) ← asLinearCombo x - let newFacts : HashSet Expr := facts.fold (init := ∅) fun s e => - if p.processedFacts.contains e then s else s.insert e - trace[omega] "Adding proof of {lc} = 0" - pure <| - { p with - facts := newFacts.toList ++ p.facts - problem := ← (p.problem.addEquality lc.const lc.coeffs - (some do mkEqTrans (← mkEqSymm (← prf)) h)) |>.solveEqualities } - -/-- -Add an integer inequality to the `Problem`. - -We solve equalities as they are discovered, as this often results in an earlier contradiction. --/ -def addIntInequality (p : MetaProblem) (h y : Expr) : OmegaM MetaProblem := do - let (lc, prf, facts) ← asLinearCombo y - let newFacts : HashSet Expr := facts.fold (init := ∅) fun s e => - if p.processedFacts.contains e then s else s.insert e - trace[omega] "Adding proof of {lc} ≥ 0" - pure <| - { p with - facts := newFacts.toList ++ p.facts - problem := ← (p.problem.addInequality lc.const lc.coeffs - (some do mkAppM ``le_of_le_of_eq #[h, (← prf)])) |>.solveEqualities } - -/-- Given a fact `h` with type `¬ P`, return a more useful fact obtained by pushing the negation. -/ -def pushNot (h P : Expr) : MetaM (Option Expr) := do - let P ← whnfR P - match P with - | .forallE _ t b _ => - if (← isProp t) && (← isProp b) then - return some (mkApp4 (.const ``Decidable.and_not_of_not_imp []) t b - (.app (.const ``Classical.propDecidable []) t) h) - else - return none - | .app _ _ => - match P.getAppFnArgs with - | (``LT.lt, #[.const ``Int [], _, x, y]) => - return some (mkApp3 (.const ``Int.le_of_not_lt []) x y h) - | (``LE.le, #[.const ``Int [], _, x, y]) => - return some (mkApp3 (.const ``Int.lt_of_not_le []) x y h) - | (``LT.lt, #[.const ``Nat [], _, x, y]) => - return some (mkApp3 (.const ``Nat.le_of_not_lt []) x y h) - | (``LE.le, #[.const ``Nat [], _, x, y]) => - return some (mkApp3 (.const ``Nat.lt_of_not_le []) x y h) - | (``Eq, #[.const ``Nat [], x, y]) => - return some (mkApp3 (.const ``Nat.lt_or_gt_of_ne []) x y h) - | (``Eq, #[.const ``Int [], x, y]) => - return some (mkApp3 (.const ``Int.lt_or_gt_of_ne []) x y h) - | (``Prod.Lex, _) => return some (← mkAppM ``Prod.of_not_lex #[h]) - | (``Dvd.dvd, #[.const ``Nat [], _, k, x]) => - return some (mkApp3 (.const ``Nat.emod_pos_of_not_dvd []) k x h) - | (``Dvd.dvd, #[.const ``Int [], _, k, x]) => - -- This introduces a disjunction that could be avoided by checking `k ≠ 0`. - return some (mkApp3 (.const ``Int.emod_pos_of_not_dvd []) k x h) - | (``Or, #[P₁, P₂]) => return some (mkApp3 (.const ``and_not_not_of_not_or []) P₁ P₂ h) - | (``And, #[P₁, P₂]) => - return some (mkApp5 (.const ``Decidable.or_not_not_of_not_and []) P₁ P₂ - (.app (.const ``Classical.propDecidable []) P₁) - (.app (.const ``Classical.propDecidable []) P₂) h) - | (``Not, #[P']) => - return some (mkApp3 (.const ``Decidable.of_not_not []) P' - (.app (.const ``Classical.propDecidable []) P') h) - | (``Iff, #[P₁, P₂]) => - return some (mkApp5 (.const ``Decidable.and_not_or_not_and_of_not_iff []) P₁ P₂ - (.app (.const ``Classical.propDecidable []) P₁) - (.app (.const ``Classical.propDecidable []) P₂) h) - | _ => return none - | _ => return none - -/-- -Parse an `Expr` and extract facts, also returning the number of new facts found. --/ -partial def addFact (p : MetaProblem) (h : Expr) : OmegaM (MetaProblem × Nat) := do - if ! p.problem.possible then - return (p, 0) - else - let t ← instantiateMVars (← whnfR (← inferType h)) - trace[omega] "adding fact: {t}" - match t with - | .forallE _ x y _ => - if (← isProp x) && (← isProp y) then - p.addFact (mkApp4 (.const ``Decidable.not_or_of_imp []) x y - (.app (.const ``Classical.propDecidable []) x) h) - else - return (p, 0) - | .app _ _ => - match t.getAppFnArgs with - | (``Eq, #[.const ``Int [], x, y]) => - match y.int? with - | some 0 => pure (← p.addIntEquality h x, 1) - | _ => p.addFact (mkApp3 (.const ``Int.sub_eq_zero_of_eq []) x y h) - | (``LE.le, #[.const ``Int [], _, x, y]) => - match x.int? with - | some 0 => pure (← p.addIntInequality h y, 1) - | _ => p.addFact (mkApp3 (.const ``Int.sub_nonneg_of_le []) y x h) - | (``LT.lt, #[.const ``Int [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.add_one_le_of_lt []) x y h) - | (``GT.gt, #[.const ``Int [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.lt_of_gt []) x y h) - | (``GE.ge, #[.const ``Int [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.le_of_ge []) x y h) - | (``GT.gt, #[.const ``Nat [], _, x, y]) => - p.addFact (mkApp3 (.const ``Nat.lt_of_gt []) x y h) - | (``GE.ge, #[.const ``Nat [], _, x, y]) => - p.addFact (mkApp3 (.const ``Nat.le_of_ge []) x y h) - | (``Ne, #[.const ``Nat [], x, y]) => - p.addFact (mkApp3 (.const ``Nat.lt_or_gt_of_ne []) x y h) - | (``Not, #[P]) => match ← pushNot h P with - | none => return (p, 0) - | some h' => p.addFact h' - | (``Eq, #[.const ``Nat [], x, y]) => - p.addFact (mkApp3 (.const ``Int.ofNat_congr []) x y h) - | (``LT.lt, #[.const ``Nat [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.ofNat_lt_of_lt []) x y h) - | (``LE.le, #[.const ``Nat [], _, x, y]) => - p.addFact (mkApp3 (.const ``Int.ofNat_le_of_le []) x y h) - | (``Ne, #[.const ``Int [], x, y]) => - p.addFact (mkApp3 (.const ``Int.lt_or_gt_of_ne []) x y h) - | (``Prod.Lex, _) => p.addFact (← mkAppM ``Prod.of_lex #[h]) - | (``Dvd.dvd, #[.const ``Nat [], _, k, x]) => - p.addFact (mkApp3 (.const ``Nat.mod_eq_zero_of_dvd []) k x h) - | (``Dvd.dvd, #[.const ``Int [], _, k, x]) => - p.addFact (mkApp3 (.const ``Int.emod_eq_zero_of_dvd []) k x h) - | (``And, #[t₁, t₂]) => do - let (p₁, n₁) ← p.addFact (mkApp3 (.const ``And.left []) t₁ t₂ h) - let (p₂, n₂) ← p₁.addFact (mkApp3 (.const ``And.right []) t₁ t₂ h) - return (p₂, n₁ + n₂) - | (``Exists, #[α, P]) => - p.addFact (mkApp3 (.const ``Exists.choose_spec [← getLevel α]) α P h) - | (``Subtype, #[α, P]) => - p.addFact (mkApp3 (.const ``Subtype.property [← getLevel α]) α P h) - | (``Iff, #[P₁, P₂]) => - p.addFact (mkApp4 (.const ``Decidable.and_or_not_and_not_of_iff []) - P₁ P₂ (.app (.const ``Classical.propDecidable []) P₂) h) - | (``Or, #[_, _]) => - if (← cfg).splitDisjunctions then - return ({ p with disjunctions := p.disjunctions.insert h }, 1) - else - return (p, 0) - | _ => pure (p, 0) - | _ => pure (p, 0) - -/-- -Process all the facts in a `MetaProblem`, returning the new problem, and the number of new facts. - -This is partial because new facts may be generated along the way. --/ -partial def processFacts (p : MetaProblem) : OmegaM (MetaProblem × Nat) := do - match p.facts with - | [] => pure (p, 0) - | h :: t => - if p.processedFacts.contains h then - processFacts { p with facts := t } - else - let (p₁, n₁) ← MetaProblem.addFact { p with - facts := t - processedFacts := p.processedFacts.insert h } h - let (p₂, n₂) ← p₁.processFacts - return (p₂, n₁ + n₂) - -end MetaProblem - -/-- -Given `p : P ∨ Q` (or any inductive type with two one-argument constructors), -split the goal into two subgoals: -one containing the hypothesis `h : P` and another containing `h : Q`. --/ -def cases₂ (mvarId : MVarId) (p : Expr) (hName : Name := `h) : - MetaM ((MVarId × FVarId) × (MVarId × FVarId)) := do - let mvarId ← mvarId.assert `hByCases (← inferType p) p - let (fvarId, mvarId) ← mvarId.intro1 - let #[s₁, s₂] ← mvarId.cases fvarId #[{ varNames := [hName] }, { varNames := [hName] }] | - throwError "'cases' tactic failed, unexpected number of subgoals" - let #[Expr.fvar f₁ ..] ← pure s₁.fields - | throwError "'cases' tactic failed, unexpected new hypothesis" - let #[Expr.fvar f₂ ..] ← pure s₂.fields - | throwError "'cases' tactic failed, unexpected new hypothesis" - return ((s₁.mvarId, f₁), (s₂.mvarId, f₂)) - - -mutual - -/-- -Split a disjunction in a `MetaProblem`, and if we find a new usable fact -call `omegaImpl` in both branches. --/ -partial def splitDisjunction (m : MetaProblem) (g : MVarId) : OmegaM Unit := g.withContext do - match m.disjunctions with - | [] => throwError "omega did not find a contradiction:\n{m.problem}" - | h :: t => - trace[omega] "Case splitting on {← inferType h}" - let ctx ← getMCtx - let (⟨g₁, h₁⟩, ⟨g₂, h₂⟩) ← cases₂ g h - trace[omega] "Adding facts:\n{← g₁.withContext <| inferType (.fvar h₁)}" - let m₁ := { m with facts := [.fvar h₁], disjunctions := t } - let r ← withoutModifyingState do - let (m₁, n) ← g₁.withContext m₁.processFacts - if 0 < n then - omegaImpl m₁ g₁ - pure true - else - pure false - if r then - trace[omega] "Adding facts:\n{← g₂.withContext <| inferType (.fvar h₂)}" - let m₂ := { m with facts := [.fvar h₂], disjunctions := t } - omegaImpl m₂ g₂ - else - trace[omega] "No new facts found." - setMCtx ctx - splitDisjunction { m with disjunctions := t } g - -/-- Implementation of the `omega` algorithm, and handling disjunctions. -/ -partial def omegaImpl (m : MetaProblem) (g : MVarId) : OmegaM Unit := g.withContext do - let (m, _) ← m.processFacts - guard m.facts.isEmpty - let p := m.problem - trace[omega] "Extracted linear arithmetic problem:\nAtoms: {← atomsList}\n{p}" - let p' ← if p.possible then p.elimination else pure p - trace[omega] "After elimination:\nAtoms: {← atomsList}\n{p'}" - match p'.possible, p'.proveFalse?, p'.proveFalse?_spec with - | true, _, _ => - splitDisjunction m g - | false, .some prf, _ => - trace[omega] "Justification:\n{p'.explanation?.get}" - let prf ← instantiateMVars (← prf) - trace[omega] "omega found a contradiction, proving {← inferType prf}" - trace[omega] "{prf}" - g.assign prf - -end - -/-- -Given a collection of facts, try prove `False` using the omega algorithm, -and close the goal using that. --/ -def omega (facts : List Expr) (g : MVarId) (cfg : OmegaConfig := {}) : MetaM Unit := - OmegaM.run (omegaImpl { facts } g) cfg - -open Lean Elab Tactic Parser.Tactic - -/-- The `omega` tactic, for resolving integer and natural linear arithmetic problems. -/ -def omegaTactic (cfg : OmegaConfig) : TacticM Unit := do - liftMetaFinishingTactic fun g => do - let g ← falseOrByContra g - (useClassical := false) -- because all the hypotheses we can make use of are decidable - g.withContext do - let hyps := (← getLocalHyps).toList - trace[omega] "analyzing {hyps.length} hypotheses:\n{← hyps.mapM inferType}" - omega hyps g cfg - -/-- The `omega` tactic, for resolving integer and natural linear arithmetic problems. This -`TacticM Unit` frontend with default configuration can be used as an Aesop rule, for example via -the tactic call `aesop (add 50% tactic Std.Tactic.Omega.omegaDefault)`. -/ -def omegaDefault : TacticM Unit := omegaTactic {} - -/-- -The `omega` tactic, for resolving integer and natural linear arithmetic problems. - -It is not yet a full decision procedure (no "dark" or "grey" shadows), -but should be effective on many problems. - -We handle hypotheses of the form `x = y`, `x < y`, `x ≤ y`, and `k ∣ x` for `x y` in `Nat` or `Int` -(and `k` a literal), along with negations of these statements. - -We decompose the sides of the inequalities as linear combinations of atoms. - -If we encounter `x / k` or `x % k` for literal integers `k` we introduce new auxiliary variables -and the relevant inequalities. - -On the first pass, we do not perform case splits on natural subtraction. -If `omega` fails, we recursively perform a case split on -a natural subtraction appearing in a hypothesis, and try again. - -The options -``` -omega (config := - { splitDisjunctions := true, splitNatSub := true, splitNatAbs := true, splitMinMax := true }) -``` -can be used to: -* `splitDisjunctions`: split any disjunctions found in the context, - if the problem is not otherwise solvable. -* `splitNatSub`: for each appearance of `((a - b : Nat) : Int)`, split on `a ≤ b` if necessary. -* `splitNatAbs`: for each appearance of `Int.natAbs a`, split on `0 ≤ a` if necessary. -* `splitMinMax`: for each occurrence of `min a b`, split on `min a b = a ∨ min a b = b` -Currently, all of these are on by default. --/ -syntax (name := omegaSyntax) "omega" (config)? : tactic - -elab_rules : tactic | - `(tactic| omega $[$cfg]?) => do - let cfg ← elabOmegaConfig (mkOptionalNode cfg) - omegaTactic cfg diff --git a/Std/Tactic/Omega/Int.lean b/Std/Tactic/Omega/Int.lean deleted file mode 100644 index 15615fba7c..0000000000 --- a/Std/Tactic/Omega/Int.lean +++ /dev/null @@ -1,155 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Classes.Order -import Std.Data.Int.Init.Order - -/-! -# Lemmas about `Nat` and `Int` needed internally by `omega`. - -These statements are useful for constructing proof expressions, -but unlikely to be widely useful, so are inside the `Std.Tactic.Omega` namespace. - -If you do find a use for them, please move them into the appropriate file and namespace! --/ - -namespace Std.Tactic.Omega.Int - -theorem ofNat_pow (a b : Nat) : ((a ^ b : Nat) : Int) = (a : Int) ^ b := by - induction b with - | zero => rfl - | succ b ih => rw [Nat.pow_succ, Int.ofNat_mul, ih]; rfl - -theorem pos_pow_of_pos (a : Int) (b : Nat) (h : 0 < a) : 0 < a ^ b := by - rw [Int.eq_natAbs_of_zero_le (Int.le_of_lt h), ← Int.ofNat_zero, ← Int.ofNat_pow, Int.ofNat_lt] - exact Nat.pos_pow_of_pos _ (Int.natAbs_pos.mpr (Int.ne_of_gt h)) - -theorem ofNat_pos {a : Nat} : 0 < (a : Int) ↔ 0 < a := by - rw [← Int.ofNat_zero, Int.ofNat_lt] - -alias ⟨_, ofNat_pos_of_pos⟩ := Int.ofNat_pos - -theorem natCast_ofNat {x : Nat} : - @Nat.cast Int instNatCastInt (no_index (OfNat.ofNat x)) = OfNat.ofNat x := rfl - -alias ⟨_, ofNat_lt_of_lt⟩ := Int.ofNat_lt -alias ⟨_, ofNat_le_of_le⟩ := Int.ofNat_le -protected alias ⟨lt_of_not_ge, _⟩ := Int.not_le -protected alias ⟨lt_of_not_le, not_le_of_lt⟩ := Int.not_le -protected alias ⟨_, lt_le_asymm⟩ := Int.not_le - -protected alias ⟨le_of_not_gt, not_lt_of_ge⟩ := Int.not_lt -protected alias ⟨le_of_not_lt, not_lt_of_le⟩ := Int.not_lt -protected alias ⟨_, le_lt_asymm⟩ := Int.not_lt - -theorem add_congr {a b c d : Int} (h₁ : a = b) (h₂ : c = d) : a + c = b + d := by - subst h₁; subst h₂; rfl - -theorem mul_congr {a b c d : Int} (h₁ : a = b) (h₂ : c = d) : a * c = b * d := by - subst h₁; subst h₂; rfl - -theorem mul_congr_left {a b : Int} (h₁ : a = b) (c : Int) : a * c = b * c := by - subst h₁; rfl - -theorem sub_congr {a b c d : Int} (h₁ : a = b) (h₂ : c = d) : a - c = b - d := by - subst h₁; subst h₂; rfl - -theorem neg_congr {a b : Int} (h₁ : a = b) : -a = -b := by - subst h₁; rfl - -theorem lt_of_gt {x y : Int} (h : x > y) : y < x := gt_iff_lt.mp h -theorem le_of_ge {x y : Int} (h : x ≥ y) : y ≤ x := ge_iff_le.mp h - -theorem ofNat_sub_eq_zero {b a : Nat} (h : ¬ b ≤ a) : ((a - b : Nat) : Int) = 0 := - Int.ofNat_eq_zero.mpr (Nat.sub_eq_zero_of_le (Nat.le_of_lt (Nat.not_le.mp h))) - -theorem ofNat_sub_dichotomy {a b : Nat} : - b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0 := by - by_cases h : b ≤ a - · left - simpa [Int.ofNat_sub h] - · right - simpa [Int.ofNat_sub_eq_zero h] using (Nat.not_le.mp h) - -theorem ofNat_congr {a b : Nat} (h : a = b) : (a : Int) = (b : Int) := congrArg _ h - -theorem ofNat_sub_sub {a b c : Nat} : ((a - b - c : Nat) : Int) = ((a - (b + c) : Nat) : Int) := - congrArg _ (Nat.sub_sub _ _ _) - -theorem ofNat_min (a b : Nat) : ((min a b : Nat) : Int) = min (a : Int) (b : Int) := by - simp only [Nat.min_def, Int.min_def, Int.ofNat_le] - split <;> rfl - -theorem ofNat_max (a b : Nat) : ((max a b : Nat) : Int) = max (a : Int) (b : Int) := by - simp only [Nat.max_def, Int.max_def, Int.ofNat_le] - split <;> rfl - -theorem ofNat_natAbs (a : Int) : (a.natAbs : Int) = if 0 ≤ a then a else -a := by - rw [Int.natAbs] - split <;> rename_i n - · simp only [Int.ofNat_eq_coe] - rw [if_pos (Int.ofNat_nonneg n)] - · simp; rfl - -theorem natAbs_dichotomy {a : Int} : 0 ≤ a ∧ a.natAbs = a ∨ a < 0 ∧ a.natAbs = -a := by - by_cases h : 0 ≤ a - · left - simp_all [Int.natAbs_of_nonneg] - · right - rw [Int.not_le] at h - rw [Int.ofNat_natAbs_of_nonpos (Int.le_of_lt h)] - simp_all - -theorem neg_le_natAbs {a : Int} : -a ≤ a.natAbs := by - simpa using Int.le_natAbs (a := -a) - -theorem add_le_iff_le_sub (a b c : Int) : a + b ≤ c ↔ a ≤ c - b := by - conv => - lhs - rw [← Int.add_zero c, ← Int.sub_self (-b), Int.sub_eq_add_neg, ← Int.add_assoc, Int.neg_neg, - Int.add_le_add_iff_right] - -theorem le_add_iff_sub_le (a b c : Int) : a ≤ b + c ↔ a - c ≤ b := by - conv => - lhs - rw [← Int.neg_neg c, ← Int.sub_eq_add_neg, ← add_le_iff_le_sub] - -theorem add_le_zero_iff_le_neg (a b : Int) : a + b ≤ 0 ↔ a ≤ - b := by - rw [add_le_iff_le_sub, Int.zero_sub] -theorem add_le_zero_iff_le_neg' (a b : Int) : a + b ≤ 0 ↔ b ≤ -a := by - rw [Int.add_comm, add_le_zero_iff_le_neg] -theorem add_nonnneg_iff_neg_le (a b : Int) : 0 ≤ a + b ↔ -b ≤ a := by - rw [le_add_iff_sub_le, Int.zero_sub] -theorem add_nonnneg_iff_neg_le' (a b : Int) : 0 ≤ a + b ↔ -a ≤ b := by - rw [Int.add_comm, add_nonnneg_iff_neg_le] - -theorem ofNat_fst_mk {β} {x : Nat} {y : β} : (Prod.mk x y).fst = (x : Int) := rfl -theorem ofNat_snd_mk {α} {x : α} {y : Nat} : (Prod.mk x y).snd = (y : Int) := rfl - - -end Int - -namespace Nat - -theorem lt_of_gt {x y : Nat} (h : x > y) : y < x := gt_iff_lt.mp h -theorem le_of_ge {x y : Nat} (h : x ≥ y) : y ≤ x := ge_iff_le.mp h - -end Nat - -namespace Prod - -theorem of_lex (w : Prod.Lex r s p q) : r p.fst q.fst ∨ p.fst = q.fst ∧ s p.snd q.snd := - (Prod.lex_def r s).mp w - -theorem of_not_lex {α} {r : α → α → Prop} [DecidableEq α] {β} {s : β → β → Prop} - {p q : α × β} (w : ¬ Prod.Lex r s p q) : - ¬ r p.fst q.fst ∧ (p.fst ≠ q.fst ∨ ¬ s p.snd q.snd) := by - rw [Prod.lex_def, not_or, Decidable.not_and_iff_or_not_not] at w - exact w - -theorem fst_mk : (Prod.mk x y).fst = x := rfl -theorem snd_mk : (Prod.mk x y).snd = y := rfl - -end Prod diff --git a/Std/Tactic/Omega/IntList.lean b/Std/Tactic/Omega/IntList.lean deleted file mode 100644 index b4392fe543..0000000000 --- a/Std/Tactic/Omega/IntList.lean +++ /dev/null @@ -1,408 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Data.List.Init.Lemmas -import Std.Data.Int.Init.DivMod -import Std.Data.Option.Init.Lemmas -import Std.Tactic.Simpa - -/-- -A type synonym for `List Int`, used by `omega` for dense representation of coefficients. - -We define algebraic operations, -interpreting `List Int` as a finitely supported function `Nat → Int`. --/ -abbrev IntList := List Int - -namespace IntList - -/-- Get the `i`-th element (interpreted as `0` if the list is not long enough). -/ -def get (xs : IntList) (i : Nat) : Int := (xs.get? i).getD 0 - -@[simp] theorem get_nil : get ([] : IntList) i = 0 := rfl -@[simp] theorem get_cons_zero : get (x :: xs) 0 = x := rfl -@[simp] theorem get_cons_succ : get (x :: xs) (i+1) = get xs i := rfl - -theorem get_map {xs : IntList} (h : f 0 = 0) : get (xs.map f) i = f (xs.get i) := by - simp only [get, List.get?_map] - cases xs.get? i <;> simp_all - -theorem get_of_length_le {xs : IntList} (h : xs.length ≤ i) : xs.get i = 0 := by - rw [get, List.get?_eq_none.mpr h] - rfl - --- theorem lt_length_of_get_nonzero {xs : IntList} (h : xs.get i ≠ 0) : i < xs.length := by --- revert h --- simpa using mt get_of_length_le - -/-- Like `List.set`, but right-pad with zeroes as necessary first. -/ -def set (xs : IntList) (i : Nat) (y : Int) : IntList := - match xs, i with - | [], 0 => [y] - | [], (i+1) => 0 :: set [] i y - | _ :: xs, 0 => y :: xs - | x :: xs, (i+1) => x :: set xs i y - -@[simp] theorem set_nil_zero : set [] 0 y = [y] := rfl -@[simp] theorem set_nil_succ : set [] (i+1) y = 0 :: set [] i y := rfl -@[simp] theorem set_cons_zero : set (x :: xs) 0 y = y :: xs := rfl -@[simp] theorem set_cons_succ : set (x :: xs) (i+1) y = x :: set xs i y := rfl - -/-- Returns the leading coefficient, i.e. the first non-zero entry. -/ -def leading (xs : IntList) : Int := xs.find? (! · == 0) |>.getD 0 - -/-- Implementation of `+` on `IntList`. -/ -def add (xs ys : IntList) : IntList := - List.zipWithAll (fun x y => x.getD 0 + y.getD 0) xs ys - -instance : Add IntList := ⟨add⟩ - -theorem add_def (xs ys : IntList) : - xs + ys = List.zipWithAll (fun x y => x.getD 0 + y.getD 0) xs ys := - rfl - -@[simp] theorem add_get (xs ys : IntList) (i : Nat) : (xs + ys).get i = xs.get i + ys.get i := by - simp only [add_def, get, List.zipWithAll_get?, List.get?_eq_none] - cases xs.get? i <;> cases ys.get? i <;> simp - -@[simp] theorem add_nil (xs : IntList) : xs + [] = xs := by simp [add_def] -@[simp] theorem nil_add (xs : IntList) : [] + xs = xs := by simp [add_def] -@[simp] theorem cons_add_cons (x) (xs : IntList) (y) (ys : IntList) : - (x :: xs) + (y :: ys) = (x + y) :: (xs + ys) := by simp [add_def] - -/-- Implementation of `*` on `IntList`. -/ -def mul (xs ys : IntList) : IntList := List.zipWith (· * ·) xs ys - -instance : Mul IntList := ⟨mul⟩ - -theorem mul_def (xs ys : IntList) : xs * ys = List.zipWith (· * ·) xs ys := - rfl - -@[simp] theorem mul_get (xs ys : IntList) (i : Nat) : (xs * ys).get i = xs.get i * ys.get i := by - simp only [mul_def, get, List.zipWith_get?] - cases xs.get? i <;> cases ys.get? i <;> simp - -@[simp] theorem mul_nil_left : ([] : IntList) * ys = [] := rfl -@[simp] theorem mul_nil_right : xs * ([] : IntList) = [] := List.zipWith_nil_right -@[simp] theorem mul_cons₂ : (x::xs : IntList) * (y::ys) = (x * y) :: (xs * ys) := rfl - -/-- Implementation of negation on `IntList`. -/ -def neg (xs : IntList) : IntList := xs.map fun x => -x - -instance : Neg IntList := ⟨neg⟩ - -theorem neg_def (xs : IntList) : - xs = xs.map fun x => -x := rfl - -@[simp] theorem neg_get (xs : IntList) (i : Nat) : (- xs).get i = - xs.get i := by - simp only [neg_def, get, List.get?_map] - cases xs.get? i <;> simp - -@[simp] theorem neg_nil : (- ([] : IntList)) = [] := rfl -@[simp] theorem neg_cons : (- (x::xs : IntList)) = -x :: -xs := rfl - -/-- Implementation of subtraction on `IntList`. -/ -def sub (xs ys : IntList) : IntList := - List.zipWithAll (fun x y => x.getD 0 - y.getD 0) xs ys - -instance : Sub IntList := ⟨sub⟩ - -theorem sub_def (xs ys : IntList) : - xs - ys = List.zipWithAll (fun x y => x.getD 0 - y.getD 0) xs ys := - rfl - -/-- Implementation of scalar multiplication by an integer on `IntList`. -/ -def smul (xs : IntList) (i : Int) : IntList := - xs.map fun x => i * x - -instance : HMul Int IntList IntList where - hMul i xs := xs.smul i - -theorem smul_def (xs : IntList) (i : Int) : i * xs = xs.map fun x => i * x := rfl - -@[simp] theorem smul_get (xs : IntList) (a : Int) (i : Nat) : (a * xs).get i = a * xs.get i := by - simp only [smul_def, get, List.get?_map] - cases xs.get? i <;> simp - -@[simp] theorem smul_nil {i : Int} : i * ([] : IntList) = [] := rfl -@[simp] theorem smul_cons {i : Int} : i * (x::xs : IntList) = i * x :: i * xs := rfl - -/-- A linear combination of two `IntList`s. -/ -def combo (a : Int) (xs : IntList) (b : Int) (ys : IntList) : IntList := - List.zipWithAll (fun x y => a * x.getD 0 + b * y.getD 0) xs ys - -theorem combo_eq_smul_add_smul (a : Int) (xs : IntList) (b : Int) (ys : IntList) : - combo a xs b ys = a * xs + b * ys := by - dsimp [combo] - induction xs generalizing ys with - | nil => simp; rfl - | cons x xs ih => - cases ys with - | nil => simp; rfl - | cons y ys => simp_all - -attribute [local simp] add_def mul_def in -theorem mul_distrib_left (xs ys zs : IntList) : (xs + ys) * zs = xs * zs + ys * zs := by - induction xs generalizing ys zs with - | nil => - cases ys with - | nil => simp - | cons _ _ => - cases zs with - | nil => simp - | cons _ _ => simp_all [Int.add_mul] - | cons x xs ih₁ => - cases ys with - | nil => simp_all - | cons _ _ => - cases zs with - | nil => simp - | cons _ _ => simp_all [Int.add_mul] - -theorem mul_neg_left (xs ys : IntList) : (-xs) * ys = -(xs * ys) := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.neg_mul] - -attribute [local simp] add_def neg_def sub_def in -theorem sub_eq_add_neg (xs ys : IntList) : xs - ys = xs + (-ys) := by - induction xs generalizing ys with - | nil => simp; rfl - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.sub_eq_add_neg] - -@[simp] theorem mul_smul_left {i : Int} {xs ys : IntList} : (i * xs) * ys = i * (xs * ys) := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.mul_assoc] - -/-- The sum of the entries of an `IntList`. -/ -def sum (xs : IntList) : Int := xs.foldr (· + ·) 0 - -@[simp] theorem sum_nil : sum ([] : IntList) = 0 := rfl -@[simp] theorem sum_cons : sum (x::xs : IntList) = x + sum xs := rfl - -attribute [local simp] sum add_def in -theorem sum_add (xs ys : IntList) : (xs + ys).sum = xs.sum + ys.sum := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.add_assoc, Int.add_left_comm] - -@[simp] -theorem sum_neg (xs : IntList) : (-xs).sum = -(xs.sum) := by - induction xs with - | nil => simp - | cons x xs ih => simp_all [Int.neg_add] - -@[simp] -theorem sum_smul (i : Int) (xs : IntList) : (i * xs).sum = i * (xs.sum) := by - induction xs with - | nil => simp - | cons x xs ih => simp_all [Int.mul_add] - -/-- The dot product of two `IntList`s. -/ -def dot (xs ys : IntList) : Int := (xs * ys).sum - -example : IntList.dot [a, b, c] [x, y, z] = IntList.dot [a, b, c, d] [x, y, z] := rfl -example : IntList.dot [a, b, c] [x, y, z] = IntList.dot [a, b, c] [x, y, z, w] := rfl - -@[local simp] theorem dot_nil_left : dot ([] : IntList) ys = 0 := rfl -@[simp] theorem dot_nil_right : dot xs ([] : IntList) = 0 := by simp [dot] -@[simp] theorem dot_cons₂ : dot (x::xs) (y::ys) = x * y + dot xs ys := rfl - --- theorem dot_comm (xs ys : IntList) : dot xs ys = dot ys xs := by --- rw [dot, dot, mul_comm] - -@[simp] theorem dot_set_left (xs ys : IntList) (i : Nat) (z : Int) : - dot (xs.set i z) ys = dot xs ys + (z - xs.get i) * ys.get i := by - induction xs generalizing i ys with - | nil => - induction i generalizing ys with - | zero => cases ys <;> simp - | succ i => cases ys <;> simp_all - | cons x xs ih => - induction i generalizing ys with - | zero => - cases ys with - | nil => simp - | cons y ys => - simp only [Nat.zero_eq, set_cons_zero, dot_cons₂, get_cons_zero, Int.sub_mul] - rw [Int.add_right_comm, Int.add_comm (x * y), Int.sub_add_cancel] - | succ i => - cases ys with - | nil => simp - | cons y ys => simp_all [Int.add_assoc] - -theorem dot_distrib_left (xs ys zs : IntList) : (xs + ys).dot zs = xs.dot zs + ys.dot zs := by - simp [dot, mul_distrib_left, sum_add] - -@[simp] theorem dot_neg_left (xs ys : IntList) : (-xs).dot ys = -(xs.dot ys) := by - simp [dot, mul_neg_left] - -@[simp] theorem dot_smul_left (xs ys : IntList) (i : Int) : (i * xs).dot ys = i * xs.dot ys := by - simp [dot] - -theorem dot_of_left_zero (w : ∀ x, x ∈ xs → x = 0) : dot xs ys = 0 := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => - rw [dot_cons₂, w x (by simp), ih] - · simp - · intro x m - apply w - exact List.mem_cons_of_mem _ m - -/-- Division of an `IntList` by a integer. -/ -def sdiv (xs : IntList) (g : Int) : IntList := xs.map fun x => x / g - -@[simp] theorem sdiv_nil : sdiv [] g = [] := rfl -@[simp] theorem sdiv_cons : sdiv (x::xs) g = (x / g) :: sdiv xs g := rfl - -/-- The gcd of the absolute values of the entries of an `IntList`. -/ -def gcd (xs : IntList) : Nat := xs.foldr (fun x g => Nat.gcd x.natAbs g) 0 - -@[simp] theorem gcd_nil : gcd [] = 0 := rfl -@[simp] theorem gcd_cons : gcd (x :: xs) = Nat.gcd x.natAbs (gcd xs) := rfl - -theorem gcd_cons_div_left : (gcd (x::xs) : Int) ∣ x := by - simp only [gcd, List.foldr_cons, Int.ofNat_dvd_left] - apply Nat.gcd_dvd_left - -theorem gcd_cons_div_right : gcd (x::xs) ∣ gcd xs := by - simp only [gcd, List.foldr_cons] - apply Nat.gcd_dvd_right - -theorem gcd_cons_div_right' : (gcd (x::xs) : Int) ∣ (gcd xs : Int) := by - rw [Int.ofNat_dvd_left, Int.natAbs_ofNat] - exact gcd_cons_div_right - -theorem gcd_dvd (xs : IntList) {a : Int} (m : a ∈ xs) : (xs.gcd : Int) ∣ a := by - rw [Int.ofNat_dvd_left] - induction m with - | head => - simp only [gcd_cons] - apply Nat.gcd_dvd_left - | tail b m ih => -- FIXME: why is the argument of tail implicit? - simp only [gcd_cons] - exact Nat.dvd_trans (Nat.gcd_dvd_right _ _) ih - -theorem dvd_gcd (xs : IntList) (c : Nat) (w : ∀ {a : Int}, a ∈ xs → (c : Int) ∣ a) : - c ∣ xs.gcd := by - simp only [Int.ofNat_dvd_left] at w - induction xs with - | nil => simpa using Nat.dvd_zero c - | cons x xs ih => - simp - apply Nat.dvd_gcd - · apply w - simp - · apply ih - intro b m - apply w - exact List.mem_cons_of_mem x m - -theorem gcd_eq_iff (xs : IntList) (g : Nat) : - xs.gcd = g ↔ - (∀ {a : Int}, a ∈ xs → (g : Int) ∣ a) ∧ - (∀ (c : Nat), (∀ {a : Int}, a ∈ xs → (c : Int) ∣ a) → c ∣ g) := by - constructor - · rintro rfl - exact ⟨gcd_dvd _, dvd_gcd _⟩ - · rintro ⟨hi, hg⟩ - apply Nat.dvd_antisymm - · apply hg - intro i m - exact gcd_dvd xs m - · exact dvd_gcd xs g hi - -attribute [simp] Int.zero_dvd - -@[simp] theorem gcd_eq_zero (xs : IntList) : xs.gcd = 0 ↔ ∀ x ∈ xs, x = 0 := by - simp [gcd_eq_iff, Nat.dvd_zero] - -@[simp] theorem dot_mod_gcd_left (xs ys : IntList) : dot xs ys % xs.gcd = 0 := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => - rw [dot_cons₂, Int.add_emod, - ← Int.emod_emod_of_dvd (x * y) (gcd_cons_div_left), - ← Int.emod_emod_of_dvd (dot xs ys) (Int.ofNat_dvd.mpr gcd_cons_div_right)] - simp_all - -theorem gcd_dvd_dot_left (xs ys : IntList) : (xs.gcd : Int) ∣ dot xs ys := - Int.dvd_of_emod_eq_zero (dot_mod_gcd_left xs ys) - -@[simp] -theorem dot_eq_zero_of_left_eq_zero {xs ys : IntList} (h : ∀ x ∈ xs, x = 0) : dot xs ys = 0 := by - induction xs generalizing ys with - | nil => rfl - | cons x xs ih => - cases ys with - | nil => rfl - | cons y ys => - rw [dot_cons₂, h x (List.mem_cons_self _ _), ih (fun x m => h x (List.mem_cons_of_mem _ m)), - Int.zero_mul, Int.add_zero] - -theorem dot_sdiv_left (xs ys : IntList) {d : Int} (h : d ∣ xs.gcd) : - dot (xs.sdiv d) ys = (dot xs ys) / d := by - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => - have wx : d ∣ x := Int.dvd_trans h (gcd_cons_div_left) - have wxy : d ∣ x * y := Int.dvd_trans wx (Int.dvd_mul_right x y) - have w : d ∣ (IntList.gcd xs : Int) := Int.dvd_trans h (gcd_cons_div_right') - simp_all [Int.add_ediv_of_dvd_left, Int.mul_ediv_assoc'] - -/-- Apply "balanced mod" to each entry in an `IntList`. -/ -abbrev bmod (x : IntList) (m : Nat) : IntList := x.map (Int.bmod · m) - -theorem bmod_length (x : IntList) (m) : (bmod x m).length ≤ x.length := - Nat.le_of_eq (List.length_map _ _) - -/-- -The difference between the balanced mod of a dot product, -and the dot product with balanced mod applied to each entry of the left factor. --/ -abbrev bmod_dot_sub_dot_bmod (m : Nat) (a b : IntList) : Int := - (Int.bmod (dot a b) m) - dot (bmod a m) b - -theorem dvd_bmod_dot_sub_dot_bmod (m : Nat) (xs ys : IntList) : - (m : Int) ∣ bmod_dot_sub_dot_bmod m xs ys := by - dsimp [bmod_dot_sub_dot_bmod] - rw [Int.dvd_iff_emod_eq_zero] - induction xs generalizing ys with - | nil => simp - | cons x xs ih => - cases ys with - | nil => simp - | cons y ys => - simp only [IntList.dot_cons₂, List.map_cons] - specialize ih ys - rw [Int.sub_emod, Int.bmod_emod] at ih - rw [Int.sub_emod, Int.bmod_emod, Int.add_emod, Int.add_emod (Int.bmod x m * y), - ← Int.sub_emod, ← Int.sub_sub, Int.sub_eq_add_neg, Int.sub_eq_add_neg, - Int.add_assoc (x * y % m), Int.add_comm (IntList.dot _ _ % m), ← Int.add_assoc, - Int.add_assoc, ← Int.sub_eq_add_neg, ← Int.sub_eq_add_neg, Int.add_emod, ih, Int.add_zero, - Int.emod_emod, Int.mul_emod, Int.mul_emod (Int.bmod x m), Int.bmod_emod, Int.sub_self, - Int.zero_emod] diff --git a/Std/Tactic/Omega/LinearCombo.lean b/Std/Tactic/Omega/LinearCombo.lean deleted file mode 100644 index 379dee9db5..0000000000 --- a/Std/Tactic/Omega/LinearCombo.lean +++ /dev/null @@ -1,183 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ - --- replace `IntList` with `IntDict` here to use sparse representations -import Std.Tactic.Omega.Coeffs.IntList - -/-! -# Linear combinations - -We use this data structure while processing hypotheses. - --/ - -initialize Lean.registerTraceClass `omega - -namespace Std.Tactic.Omega - -/-- Internal representation of a linear combination of atoms, and a constant term. -/ -structure LinearCombo where - /-- Constant term. -/ - const : Int := 0 - /-- Coefficients of the atoms. -/ - coeffs : Coeffs := [] -deriving DecidableEq, Repr - -namespace LinearCombo - -instance : ToString LinearCombo where - toString lc := - s!"{lc.const}{String.join <| lc.coeffs.toList.enum.map fun ⟨i, c⟩ => s!" + {c} * x{i+1}"}" - -open Lean in -instance : ToExpr LinearCombo where - toExpr lc := - (Expr.const ``LinearCombo.mk []).app (toExpr lc.const) |>.app (toExpr lc.coeffs) - toTypeExpr := .const ``LinearCombo [] - -instance : Inhabited LinearCombo := ⟨{const := 1}⟩ - -theorem ext {a b : LinearCombo} (w₁ : a.const = b.const) (w₂ : a.coeffs = b.coeffs) : - a = b := by - cases a; cases b - subst w₁; subst w₂ - congr - -/-- -Evaluate a linear combination `⟨r, [c_1, …, c_k]⟩` at values `[v_1, …, v_k]` to obtain -`r + (c_1 * x_1 + (c_2 * x_2 + ... (c_k * x_k + 0))))`. --/ -def eval (lc : LinearCombo) (values : Coeffs) : Int := - lc.const + lc.coeffs.dot values - -@[simp] theorem eval_nil : (lc : LinearCombo).eval .nil = lc.const := by - simp [eval] - -/-- The `i`-th coordinate function. -/ -def coordinate (i : Nat) : LinearCombo where - const := 0 - coeffs := Coeffs.set .nil i 1 - -@[simp] theorem coordinate_eval (i : Nat) (v : Coeffs) : - (coordinate i).eval v = v.get i := by - simp [eval, coordinate] - -theorem coordinate_eval_0 : (coordinate 0).eval (.ofList (a0 :: t)) = a0 := by simp -theorem coordinate_eval_1 : (coordinate 1).eval (.ofList (a0 :: a1 :: t)) = a1 := by simp -theorem coordinate_eval_2 : (coordinate 2).eval (.ofList (a0 :: a1 :: a2 :: t)) = a2 := by simp -theorem coordinate_eval_3 : - (coordinate 3).eval (.ofList (a0 :: a1 :: a2 :: a3 :: t)) = a3 := by simp -theorem coordinate_eval_4 : - (coordinate 4).eval (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: t)) = a4 := by simp -theorem coordinate_eval_5 : - (coordinate 5).eval (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: t)) = a5 := by simp -theorem coordinate_eval_6 : - (coordinate 6).eval (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: t)) = a6 := by simp -theorem coordinate_eval_7 : - (coordinate 7).eval - (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: a7 :: t)) = a7 := by simp -theorem coordinate_eval_8 : - (coordinate 8).eval - (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: a7 :: a8 :: t)) = a8 := by simp -theorem coordinate_eval_9 : - (coordinate 9).eval - (.ofList (a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: a7 :: a8 :: a9 :: t)) = a9 := by simp - -/-- Implementation of addition on `LinearCombo`. -/ -def add (l₁ l₂ : LinearCombo) : LinearCombo where - const := l₁.const + l₂.const - coeffs := l₁.coeffs + l₂.coeffs - -instance : Add LinearCombo := ⟨add⟩ - -@[simp] theorem add_const {l₁ l₂ : LinearCombo} : (l₁ + l₂).const = l₁.const + l₂.const := rfl -@[simp] theorem add_coeffs {l₁ l₂ : LinearCombo} : (l₁ + l₂).coeffs = l₁.coeffs + l₂.coeffs := rfl - -/-- Implementation of subtraction on `LinearCombo`. -/ -def sub (l₁ l₂ : LinearCombo) : LinearCombo where - const := l₁.const - l₂.const - coeffs := l₁.coeffs - l₂.coeffs - -instance : Sub LinearCombo := ⟨sub⟩ - -@[simp] theorem sub_const {l₁ l₂ : LinearCombo} : (l₁ - l₂).const = l₁.const - l₂.const := rfl -@[simp] theorem sub_coeffs {l₁ l₂ : LinearCombo} : (l₁ - l₂).coeffs = l₁.coeffs - l₂.coeffs := rfl - -/-- Implementation of negation on `LinearCombo`. -/ -def neg (lc : LinearCombo) : LinearCombo where - const := -lc.const - coeffs := -lc.coeffs - -instance : Neg LinearCombo := ⟨neg⟩ - -@[simp] theorem neg_const {l : LinearCombo} : (-l).const = -l.const := rfl -@[simp] theorem neg_coeffs {l : LinearCombo} : (-l).coeffs = -l.coeffs := rfl - -theorem sub_eq_add_neg (l₁ l₂ : LinearCombo) : l₁ - l₂ = l₁ + -l₂ := by - rcases l₁ with ⟨a₁, c₁⟩; rcases l₂ with ⟨a₂, c₂⟩ - apply ext - · simp [Int.sub_eq_add_neg] - · simp [Coeffs.sub_eq_add_neg] - -/-- Implementation of scalar multiplication of a `LinearCombo` by an `Int`. -/ -def smul (lc : LinearCombo) (i : Int) : LinearCombo where - const := i * lc.const - coeffs := lc.coeffs.smul i - -instance : HMul Int LinearCombo LinearCombo := ⟨fun i lc => lc.smul i⟩ - -@[simp] theorem smul_const {lc : LinearCombo} {i : Int} : (i * lc).const = i * lc.const := rfl -@[simp] theorem smul_coeffs {lc : LinearCombo} {i : Int} : (i * lc).coeffs = i * lc.coeffs := rfl - -@[simp] theorem add_eval (l₁ l₂ : LinearCombo) (v : Coeffs) : - (l₁ + l₂).eval v = l₁.eval v + l₂.eval v := by - rcases l₁ with ⟨r₁, c₁⟩; rcases l₂ with ⟨r₂, c₂⟩ - simp only [eval, add_const, add_coeffs, Int.add_assoc, Int.add_left_comm] - congr - exact Coeffs.dot_distrib_left c₁ c₂ v - -@[simp] theorem neg_eval (lc : LinearCombo) (v : Coeffs) : (-lc).eval v = - lc.eval v := by - rcases lc with ⟨a, coeffs⟩ - simp [eval, Int.neg_add] - -@[simp] theorem sub_eval (l₁ l₂ : LinearCombo) (v : Coeffs) : - (l₁ - l₂).eval v = l₁.eval v - l₂.eval v := by - simp [sub_eq_add_neg, Int.sub_eq_add_neg] - -@[simp] theorem smul_eval (lc : LinearCombo) (i : Int) (v : Coeffs) : - (i * lc).eval v = i * lc.eval v := by - rcases lc with ⟨a, coeffs⟩ - simp [eval, Int.mul_add] - -theorem smul_eval_comm (lc : LinearCombo) (i : Int) (v : Coeffs) : - (i * lc).eval v = lc.eval v * i := by - simp [Int.mul_comm] - -/-- -Multiplication of two linear combinations. -This is useful only if at least one of the linear combinations is constant, -and otherwise should be considered as a junk value. --/ -def mul (l₁ l₂ : LinearCombo) : LinearCombo := - l₂.const * l₁ + l₁.const * l₂ - { const := l₁.const * l₂.const } - -theorem mul_eval_of_const_left (l₁ l₂ : LinearCombo) (v : Coeffs) (w : l₁.coeffs.isZero) : - (mul l₁ l₂).eval v = l₁.eval v * l₂.eval v := by - have : Coeffs.dot l₁.coeffs v = 0 := IntList.dot_of_left_zero w - simp [mul, eval, this, Coeffs.sub_eq_add_neg, Coeffs.dot_distrib_left, Int.add_mul, Int.mul_add, - Int.mul_comm] - -theorem mul_eval_of_const_right (l₁ l₂ : LinearCombo) (v : Coeffs) (w : l₂.coeffs.isZero) : - (mul l₁ l₂).eval v = l₁.eval v * l₂.eval v := by - have : Coeffs.dot l₂.coeffs v = 0 := IntList.dot_of_left_zero w - simp [mul, eval, this, Coeffs.sub_eq_add_neg, Coeffs.dot_distrib_left, Int.add_mul, Int.mul_add, - Int.mul_comm] - -theorem mul_eval (l₁ l₂ : LinearCombo) (v : Coeffs) (w : l₁.coeffs.isZero ∨ l₂.coeffs.isZero) : - (mul l₁ l₂).eval v = l₁.eval v * l₂.eval v := by - rcases w with w | w - · rw [mul_eval_of_const_left _ _ _ w] - · rw [mul_eval_of_const_right _ _ _ w] diff --git a/Std/Tactic/Omega/Logic.lean b/Std/Tactic/Omega/Logic.lean deleted file mode 100644 index 86a695df0b..0000000000 --- a/Std/Tactic/Omega/Logic.lean +++ /dev/null @@ -1,31 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ - -import Std.Tactic.Alias - -/-! -# Specializations of basic logic lemmas - -These are useful for `omega` while constructing proofs, but not considered generally useful -so are hidden in the `Std.Tactic.Omega` namespace. - -If you find yourself needing them elsewhere, please move them first to another file. --/ - -namespace Std.Tactic.Omega - -alias ⟨and_not_not_of_not_or, _⟩ := not_or -alias ⟨Decidable.or_not_not_of_not_and, _⟩ := Decidable.not_and_iff_or_not - -alias ⟨Decidable.and_or_not_and_not_of_iff, _⟩ := Decidable.iff_iff_and_or_not_and_not - -theorem Decidable.not_iff_iff_and_not_or_not_and [Decidable a] [Decidable b] : - (¬ (a ↔ b)) ↔ (a ∧ ¬ b) ∨ ((¬ a) ∧ b) := by - by_cases b <;> simp_all [Decidable.not_not] - -alias ⟨Decidable.and_not_or_not_and_of_not_iff, _⟩ := Decidable.not_iff_iff_and_not_or_not_and - -alias ⟨Decidable.and_not_of_not_imp, _⟩ := Decidable.not_imp_iff_and_not diff --git a/Std/Tactic/Omega/MinNatAbs.lean b/Std/Tactic/Omega/MinNatAbs.lean deleted file mode 100644 index 88621f0709..0000000000 --- a/Std/Tactic/Omega/MinNatAbs.lean +++ /dev/null @@ -1,135 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Data.List.Init.Lemmas -import Std.Data.Int.Init.Order -import Std.Data.Option.Lemmas -import Std.Tactic.Init - -/-! -# `List.nonzeroMinimum`, `List.minNatAbs`, `List.maxNatAbs` - -`List.minNatAbs` computes the minimum non-zero absolute value of a `List Int`. -This is not generally useful outside of the implementation of the `omega` tactic, -so we keep it in the `Std/Tactic/Omega` directory -(although the definitions are in the `List` namespace). - --/ - - -namespace List - -/-- -The minimum non-zero entry in a list of natural numbers, or zero if all entries are zero. - -We completely characterize the function via -`nonzeroMinimum_eq_zero_iff` and `nonzeroMinimum_eq_nonzero_iff` below. --/ -def nonzeroMinimum (xs : List Nat) : Nat := xs.filter (· ≠ 0) |>.minimum? |>.getD 0 - -open Classical in -@[simp] theorem nonzeroMinimum_eq_zero_iff {xs : List Nat} : - xs.nonzeroMinimum = 0 ↔ ∀ x ∈ xs, x = 0 := by - simp [nonzeroMinimum, Option.getD_eq_iff, minimum?_eq_none_iff, minimum?_eq_some_iff', - filter_eq_nil, mem_filter] - -theorem nonzeroMinimum_mem {xs : List Nat} (w : xs.nonzeroMinimum ≠ 0) : - xs.nonzeroMinimum ∈ xs := by - dsimp [nonzeroMinimum] at * - generalize h : (xs.filter (· ≠ 0) |>.minimum?) = m at * - match m, w with - | some (m+1), _ => simp_all [minimum?_eq_some_iff', mem_filter] - -theorem nonzeroMinimum_pos {xs : List Nat} (m : a ∈ xs) (h : a ≠ 0) : 0 < xs.nonzeroMinimum := - Nat.pos_iff_ne_zero.mpr fun w => h (nonzeroMinimum_eq_zero_iff.mp w _ m) - -theorem nonzeroMinimum_le {xs : List Nat} (m : a ∈ xs) (h : a ≠ 0) : xs.nonzeroMinimum ≤ a := by - have : (xs.filter (· ≠ 0) |>.minimum?) = some xs.nonzeroMinimum := by - have w := nonzeroMinimum_pos m h - dsimp [nonzeroMinimum] at * - generalize h : (xs.filter (· ≠ 0) |>.minimum?) = m? at * - match m?, w with - | some m?, _ => rfl - rw [minimum?_eq_some_iff'] at this - apply this.2 - simp [List.mem_filter] - exact ⟨m, h⟩ - -theorem nonzeroMinimum_eq_nonzero_iff {xs : List Nat} {y : Nat} (h : y ≠ 0) : - xs.nonzeroMinimum = y ↔ y ∈ xs ∧ (∀ x ∈ xs, y ≤ x ∨ x = 0) := by - constructor - · rintro rfl - constructor - exact nonzeroMinimum_mem h - intro y m - by_cases w : y = 0 - · right; exact w - · left; apply nonzeroMinimum_le m w - · rintro ⟨m, w⟩ - apply Nat.le_antisymm - · exact nonzeroMinimum_le m h - · have nz : xs.nonzeroMinimum ≠ 0 := by - apply Nat.pos_iff_ne_zero.mp - apply nonzeroMinimum_pos m h - specialize w (nonzeroMinimum xs) (nonzeroMinimum_mem nz) - cases w with - | inl h => exact h - | inr h => exfalso; exact nz h - -theorem nonzeroMinimum_eq_of_nonzero {xs : List Nat} (h : xs.nonzeroMinimum ≠ 0) : - ∃ x ∈ xs, xs.nonzeroMinimum = x := - ⟨xs.nonzeroMinimum, ((nonzeroMinimum_eq_nonzero_iff h).mp rfl).1, rfl⟩ - -theorem nonzeroMinimum_le_iff {xs : List Nat} {y : Nat} : - xs.nonzeroMinimum ≤ y ↔ xs.nonzeroMinimum = 0 ∨ ∃ x ∈ xs, x ≤ y ∧ x ≠ 0 := by - refine ⟨fun h => ?_, fun h => ?_⟩ - · rw [Classical.or_iff_not_imp_right] - simp only [ne_eq, not_exists, not_and, Classical.not_not, nonzeroMinimum_eq_zero_iff] - intro w - apply nonzeroMinimum_eq_zero_iff.mp - if p : xs.nonzeroMinimum = 0 then - exact p - else - exact w _ (nonzeroMinimum_mem p) h - · match h with - | .inl h => simp [h] - | .inr ⟨x, m, le, ne⟩ => exact Nat.le_trans (nonzeroMinimum_le m ne) le - -theorem nonzeroMininum_map_le_nonzeroMinimum (f : α → β) (p : α → Nat) (q : β → Nat) (xs : List α) - (h : ∀ a, a ∈ xs → (p a = 0 ↔ q (f a) = 0)) - (w : ∀ a, a ∈ xs → p a ≠ 0 → q (f a) ≤ p a) : - ((xs.map f).map q).nonzeroMinimum ≤ (xs.map p).nonzeroMinimum := by - rw [nonzeroMinimum_le_iff] - if z : (xs.map p).nonzeroMinimum = 0 then - rw [nonzeroMinimum_eq_zero_iff] - simp_all - else - have := nonzeroMinimum_eq_of_nonzero z - simp only [mem_map] at this - obtain ⟨x, ⟨a, m, rfl⟩, eq⟩ := this - refine .inr ⟨q (f a), List.mem_map_of_mem _ (List.mem_map_of_mem _ m), ?_, ?_⟩ - · rw [eq] at z ⊢ - apply w _ m z - · rwa [Ne, ← h _ m, ← eq] - -/-- -The minimum absolute value of a nonzero entry, or zero if all entries are zero. - -We completely characterize the function via -`minNatAbs_eq_zero_iff` and `minNatAbs_eq_nonzero_iff` below. --/ -def minNatAbs (xs : List Int) : Nat := xs.map Int.natAbs |>.nonzeroMinimum - -@[simp] theorem minNatAbs_eq_zero_iff {xs : List Int} : xs.minNatAbs = 0 ↔ ∀ y ∈ xs, y = 0 := by - simp [minNatAbs] - -theorem minNatAbs_eq_nonzero_iff (xs : List Int) (w : z ≠ 0) : - xs.minNatAbs = z ↔ (∃ y ∈ xs, y.natAbs = z) ∧ (∀ y ∈ xs, z ≤ y.natAbs ∨ y = 0) := by - simp [minNatAbs, nonzeroMinimum_eq_nonzero_iff w] - -@[simp] theorem minNatAbs_nil : ([] : List Int).minNatAbs = 0 := rfl - -/-- The maximum absolute value in a list of integers. -/ -def maxNatAbs (xs : List Int) : Nat := xs.map Int.natAbs |>.maximum? |>.getD 0 diff --git a/Std/Tactic/Omega/OmegaM.lean b/Std/Tactic/Omega/OmegaM.lean deleted file mode 100644 index d4f20ec405..0000000000 --- a/Std/Tactic/Omega/OmegaM.lean +++ /dev/null @@ -1,218 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Tactic.Omega.Int -import Std.Tactic.Omega.LinearCombo -import Std.Tactic.Omega.Config -import Std.Lean.Expr -import Std.Lean.HashSet -import Std.Classes.SetNotation - -/-! -# The `OmegaM` state monad. - -We keep track of the linear atoms (up to defeq) that have been encountered so far, -and also generate new facts as new atoms are recorded. - -The main functions are: -* `atoms : OmegaM (List Expr)` which returns the atoms recorded so far -* `lookup (e : Expr) : OmegaM (Nat × Option (HashSet Expr))` which checks if an `Expr` has - already been recorded as an atom, and records it. - `lookup` return the index in `atoms` for this `Expr`. - The `Option (HashSet Expr)` return value is `none` is the expression has been previously - recorded, and otherwise contains new facts that should be added to the `omega` problem. - * for each new atom `a` of the form `((x : Nat) : Int)`, the fact that `0 ≤ a` - * for each new atom `a` of the form `x / k`, for `k` a positive numeral, the facts that - `k * a ≤ x < k * a + k` - * for each new atom of the form `((a - b : Nat) : Int)`, the fact: - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0` - * for each new atom of the form `min a b`, the facts `min a b ≤ a` and `min a b ≤ b` - (and similarly for `max`) - * for each new atom of the form `if P then a else b`, the disjunction: - `(P ∧ (if P then a else b) = a) ∨ (¬ P ∧ (if P then a else b) = b)` -The `OmegaM` monad also keeps an internal cache of visited expressions -(not necessarily atoms, but arbitrary subexpressions of one side of a linear relation) -to reduce duplication. -The cache maps `Expr`s to pairs consisting of a `LinearCombo`, -and proof that the expression is equal to the evaluation of the `LinearCombo` at the atoms. --/ - -open Lean Meta - -namespace Std.Tactic.Omega - -/-- Context for the `OmegaM` monad, containing the user configurable options. -/ -structure Context where - /-- User configurable options for `omega`. -/ - cfg : OmegaConfig - -/-- The internal state for the `OmegaM` monad, recording previously encountered atoms. -/ -structure State where - /-- The atoms up-to-defeq encountered so far. -/ - atoms : Array Expr := #[] - -/-- An intermediate layer in the `OmegaM` monad. -/ -abbrev OmegaM' := StateRefT State (ReaderT Context MetaM) - -/-- -Cache of expressions that have been visited, and their reflection as a linear combination. --/ -def Cache : Type := HashMap Expr (LinearCombo × OmegaM' Expr) - -/-- -The `OmegaM` monad maintains two pieces of state: -* the linear atoms discovered while processing hypotheses -* a cache mapping subexpressions of one side of a linear inequality to `LinearCombo`s - (and a proof that the `LinearCombo` evaluates at the atoms to the original expression). -/ -abbrev OmegaM := StateRefT Cache OmegaM' - -/-- Run a computation in the `OmegaM` monad, starting with no recorded atoms. -/ -def OmegaM.run (m : OmegaM α) (cfg : OmegaConfig) : MetaM α := - m.run' HashMap.empty |>.run' {} { cfg } - -/-- Retrieve the user-specified configuration options. -/ -def cfg : OmegaM OmegaConfig := do pure (← read).cfg - -/-- Retrieve the list of atoms. -/ -def atoms : OmegaM (List Expr) := return (← getThe State).atoms.toList - -/-- Return the `Expr` representing the list of atoms. -/ -def atomsList : OmegaM Expr := do mkListLit (.const ``Int []) (← atoms) - -/-- Return the `Expr` representing the list of atoms as a `Coeffs`. -/ -def atomsCoeffs : OmegaM Expr := do - return .app (.const ``Coeffs.ofList []) (← atomsList) - -/-- Run an `OmegaM` computation, restoring the state afterwards depending on the result. -/ -def commitWhen (t : OmegaM (α × Bool)) : OmegaM α := do - let state ← getThe State - let cache ← getThe Cache - let (a, r) ← t - if !r then do - modifyThe State fun _ => state - modifyThe Cache fun _ => cache - pure a - -/-- -Run an `OmegaM` computation, restoring the state afterwards. --/ -def withoutModifyingState (t : OmegaM α) : OmegaM α := - commitWhen (do pure (← t, false)) - -/-- Wrapper around `Expr.nat?` that also allows `Nat.cast`. -/ -def natCast? (n : Expr) : Option Nat := - match n.getAppFnArgs with - | (``Nat.cast, #[_, _, n]) => n.nat? - | _ => n.nat? - -/-- Wrapper around `Expr.int?` that also allows `Nat.cast`. -/ -def intCast? (n : Expr) : Option Int := - match n.getAppFnArgs with - | (``Nat.cast, #[_, _, n]) => n.nat? - | _ => n.int? - -theorem ite_disjunction {α : Type u} {P : Prop} [Decidable P] {a b : α} : - (P ∧ (if P then a else b) = a) ∨ (¬ P ∧ (if P then a else b) = b) := by - by_cases P <;> simp_all - -/-- Construct the term with type hint `(Eq.refl a : a = b)`-/ -def mkEqReflWithExpectedType (a b : Expr) : MetaM Expr := do - mkExpectedTypeHint (← mkEqRefl a) (← mkEq a b) - -/-- -Analyzes a newly recorded atom, -returning a collection of interesting facts about it that should be added to the context. --/ -def analyzeAtom (e : Expr) : OmegaM (HashSet Expr) := do - match e.getAppFnArgs with - | (``Nat.cast, #[.const ``Int [], _, e']) => - -- Casts of natural numbers are non-negative. - let mut r := {Expr.app (.const ``Int.ofNat_nonneg []) e'} - match (← cfg).splitNatSub, e'.getAppFnArgs with - | true, (``HSub.hSub, #[_, _, _, _, a, b]) => - -- `((a - b : Nat) : Int)` gives a dichotomy - r := r.insert (mkApp2 (.const ``Int.ofNat_sub_dichotomy []) a b) - | _, (``Int.natAbs, #[x]) => - r := r.insert (mkApp (.const ``Int.le_natAbs []) x) - r := r.insert (mkApp (.const ``Int.neg_le_natAbs []) x) - | _, (``Fin.val, #[n, i]) => - r := r.insert (mkApp2 (.const ``Fin.isLt []) n i) - | _, _ => pure () - return r - | (``HDiv.hDiv, #[_, _, _, _, x, k]) => match natCast? k with - | none - | some 0 => pure ∅ - | some _ => - -- `k * x/k ≤ x < k * x/k + k` - let ne_zero := mkApp3 (.const ``Ne [1]) (.const ``Int []) k (toExpr (0 : Int)) - let pos := mkApp4 (.const ``LT.lt [0]) (.const ``Int []) (.const ``Int.instLTInt []) - (toExpr (0 : Int)) k - pure <| - {mkApp3 (.const ``Int.mul_ediv_self_le []) x k (← mkDecideProof ne_zero), - mkApp3 (.const ``Int.lt_mul_ediv_self_add []) x k (← mkDecideProof pos)} - | (``HMod.hMod, #[_, _, _, _, x, k]) => - match k.getAppFnArgs with - | (``HPow.hPow, #[_, _, _, _, b, exp]) => match natCast? b with - | none - | some 0 => pure ∅ - | some _ => - let b_pos := mkApp4 (.const ``LT.lt [0]) (.const ``Int []) (.const ``Int.instLTInt []) - (toExpr (0 : Int)) b - let pow_pos := mkApp3 (.const ``Int.pos_pow_of_pos []) b exp (← mkDecideProof b_pos) - pure <| - {mkApp3 (.const ``Int.emod_nonneg []) x k - (mkApp3 (.const ``Int.ne_of_gt []) k (toExpr (0 : Int)) pow_pos), - mkApp3 (.const ``Int.emod_lt_of_pos []) x k pow_pos} - | (``Nat.cast, #[.const ``Int [], _, k']) => - match k'.getAppFnArgs with - | (``HPow.hPow, #[_, _, _, _, b, exp]) => match natCast? b with - | none - | some 0 => pure ∅ - | some _ => - let b_pos := mkApp4 (.const ``LT.lt [0]) (.const ``Nat []) (.const ``instLTNat []) - (toExpr (0 : Nat)) b - let pow_pos := mkApp3 (.const ``Nat.pos_pow_of_pos []) b exp (← mkDecideProof b_pos) - let cast_pos := mkApp2 (.const ``Int.ofNat_pos_of_pos []) k' pow_pos - pure <| - {mkApp3 (.const ``Int.emod_nonneg []) x k - (mkApp3 (.const ``Int.ne_of_gt []) k (toExpr (0 : Int)) cast_pos), - mkApp3 (.const ``Int.emod_lt_of_pos []) x k cast_pos} - | _ => pure ∅ - | _ => pure ∅ - | (``Min.min, #[_, _, x, y]) => - pure <| {mkApp2 (.const ``Int.min_le_left []) x y, mkApp2 (.const ``Int.min_le_right []) x y} - | (``Max.max, #[_, _, x, y]) => - pure <| {mkApp2 (.const ``Int.le_max_left []) x y, mkApp2 (.const ``Int.le_max_right []) x y} - | (``ite, #[α, i, dec, t, e]) => - if α == (.const ``Int []) then - pure <| {mkApp5 (.const ``ite_disjunction [0]) α i dec t e} - else - pure {} - | _ => pure ∅ - -/-- -Look up an expression in the atoms, recording it if it has not previously appeared. - -Return its index, and, if it is new, a collection of interesting facts about the atom. -* for each new atom `a` of the form `((x : Nat) : Int)`, the fact that `0 ≤ a` -* for each new atom `a` of the form `x / k`, for `k` a positive numeral, the facts that - `k * a ≤ x < k * a + k` -* for each new atom of the form `((a - b : Nat) : Int)`, the fact: - `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0` --/ -def lookup (e : Expr) : OmegaM (Nat × Option (HashSet Expr)) := do - let c ← getThe State - for h : i in [:c.atoms.size] do - if ← isDefEq e c.atoms[i] then - return (i, none) - trace[omega] "New atom: {e}" - let facts ← analyzeAtom e - if ← isTracingEnabledFor `omega then - unless facts.isEmpty do - trace[omega] "New facts: {← facts.toList.mapM fun e => inferType e}" - let i ← modifyGetThe State fun c => (c.atoms.size, { c with atoms := c.atoms.push e }) - return (i, some facts) - -end Omega diff --git a/Std/Tactic/Relation/Rfl.lean b/Std/Tactic/Relation/Rfl.lean index fb14972946..13a1c7d4c4 100644 --- a/Std/Tactic/Relation/Rfl.lean +++ b/Std/Tactic/Relation/Rfl.lean @@ -3,8 +3,8 @@ Copyright (c) 2022 Newell Jensen. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Newell Jensen, Thomas Murrills -/ -import Std.Lean.Elab.Tactic import Lean.Meta.Tactic.Apply +import Lean.Elab.Tactic.Basic /-! # `rfl` tactic extension for reflexive relations diff --git a/lean-toolchain b/lean-toolchain index cb3c234625..1fbcac3216 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-15 +leanprover/lean4:nightly-2024-02-19 diff --git a/test/congr.lean b/test/congr.lean index 21f327fa43..517c216efd 100644 --- a/test/congr.lean +++ b/test/congr.lean @@ -7,7 +7,7 @@ example (c : Prop → Prop → Prop → Prop) (x x' y z z' : Prop) apply Iff.of_eq -- FIXME: not needed in lean 3 congr · guard_target =ₐ x = x' - apply_ext_lemma + apply_ext_theorem assumption · guard_target =ₐ z = z' ext diff --git a/test/ext.lean b/test/ext.lean index ce730a7a5f..e0799efb90 100644 --- a/test/ext.lean +++ b/test/ext.lean @@ -1,4 +1,3 @@ -import Std.Tactic.Ext import Std.Logic import Std.Tactic.GuardMsgs @@ -36,7 +35,6 @@ example (a b : C' n) : a = b := by guard_target = a.toB = b.toB; exact mySorry guard_target = a.c = b.c; exact mySorry -open Std.Tactic.Ext example (f g : Nat × Nat → Nat) : f = g := by ext ⟨x, y⟩ guard_target = f (x, y) = g (x, y); exact mySorry diff --git a/test/int.lean b/test/int.lean index 3c948d4264..65397bfaca 100644 --- a/test/int.lean +++ b/test/int.lean @@ -1,4 +1,3 @@ -import Std.Data.Int.Basic -- complement #guard ~~~(-1:Int) = 0 diff --git a/test/omega/benchmark.lean b/test/omega/benchmark.lean index 0e6f2b2d15..8df5b77417 100644 --- a/test/omega/benchmark.lean +++ b/test/omega/benchmark.lean @@ -1,4 +1,3 @@ -import Std.Tactic.Omega.Frontend /-! # Benchmarking the `omega` tactic @@ -58,8 +57,6 @@ Benchmark 1: lake env lean test/omega/benchmark.lean -/ -open Std.Tactic.Omega - example : True := by fail_if_success omega trivial diff --git a/test/omega/examples.lean b/test/omega/examples.lean index 3f530b0e19..8e6603435e 100644 --- a/test/omega/examples.lean +++ b/test/omega/examples.lean @@ -1,4 +1,3 @@ -import Std.Tactic.Omega.Frontend -- Turn on `trace.omega` to get detailed information about the processing of hypotheses, -- and the justification of the contradiction found. diff --git a/test/omega/test.lean b/test/omega/test.lean index 095e8f110a..3e136fb1fa 100644 --- a/test/omega/test.lean +++ b/test/omega/test.lean @@ -1,6 +1,3 @@ -import Std.Tactic.Omega.Frontend - -open Std.Tactic.Omega example : True := by fail_if_success omega From 1eef461a3ff8fc7d303807ab1f65f87434164b16 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 24 Feb 2024 09:12:53 +0000 Subject: [PATCH 084/213] chore: bump to nightly-2024-02-24 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index a9ea4c3843..d71105d858 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-23 +leanprover/lean4:nightly-2024-02-24 From aca27e1a0e5c576d43fc0074f560a92781fa6c58 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sun, 25 Feb 2024 17:48:57 +1100 Subject: [PATCH 085/213] adaptations for nightly-2024-02-24 --- Std.lean | 1 - Std/Data/BitVec/Lemmas.lean | 2 +- Std/Lean/Meta/Basic.lean | 17 - Std/Lean/Meta/LazyDiscrTree.lean | 2 +- Std/Tactic/LibrarySearch.lean | 533 ------------------------------- 5 files changed, 2 insertions(+), 553 deletions(-) delete mode 100644 Std/Tactic/LibrarySearch.lean diff --git a/Std.lean b/Std.lean index 38ac463ceb..a8333ad82c 100644 --- a/Std.lean +++ b/Std.lean @@ -84,7 +84,6 @@ import Std.Tactic.FalseOrByContra import Std.Tactic.GuardMsgs import Std.Tactic.Init import Std.Tactic.Instances -import Std.Tactic.LibrarySearch import Std.Tactic.Lint import Std.Tactic.Lint.Basic import Std.Tactic.Lint.Frontend diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index 65983b4fb0..437ab0358e 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -8,7 +8,7 @@ import Std.Data.Fin.Lemmas import Std.Data.Nat.Lemmas import Std.Util.ProofWanted -namespace Std.BitVec +namespace BitVec /-- Replaced 2024-02-07. -/ @[deprecated] alias zero_is_unique := eq_nil diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index cb9a4bc166..3e72809893 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -162,20 +162,3 @@ where match ← tac goal with | none => acc.modify fun s => s.push goal | some goals => goals.forM (go acc) - -/-- -Given a monadic function `F` that takes a type and a term of that type and produces a new term, -lifts this to the monadic function that opens a `∀` telescope, applies `F` to the body, -and then builds the lambda telescope term for the new term. --/ -def mapForallTelescope' (F : Expr → Expr → MetaM Expr) (forallTerm : Expr) : MetaM Expr := do - forallTelescope (← Meta.inferType forallTerm) fun xs ty => do - Meta.mkLambdaFVars xs (← F ty (mkAppN forallTerm xs)) - -/-- -Given a monadic function `F` that takes a term and produces a new term, -lifts this to the monadic function that opens a `∀` telescope, applies `F` to the body, -and then builds the lambda telescope term for the new term. --/ -def mapForallTelescope (F : Expr → MetaM Expr) (forallTerm : Expr) : MetaM Expr := do - mapForallTelescope' (fun _ e => F e) forallTerm diff --git a/Std/Lean/Meta/LazyDiscrTree.lean b/Std/Lean/Meta/LazyDiscrTree.lean index 75818cd497..725896ef99 100644 --- a/Std/Lean/Meta/LazyDiscrTree.lean +++ b/Std/Lean/Meta/LazyDiscrTree.lean @@ -119,7 +119,7 @@ private partial def pushArgsAux (infos : Array ParamInfo) : Nat → Expr → Arr - `Nat.succ x` where `isNumeral x` - `OfNat.ofNat _ x _` where `isNumeral x` -/ private partial def isNumeral (e : Expr) : Bool := - if e.isNatLit then true + if e.isRawNatLit then true else let f := e.getAppFn if !f.isConst then false diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean deleted file mode 100644 index ff33412e0b..0000000000 --- a/Std/Tactic/LibrarySearch.lean +++ /dev/null @@ -1,533 +0,0 @@ -/- -Copyright (c) 2021-2023 Gabriel Ebner and Lean FRO. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Joe Hendrix, Scott Morrison --/ -import Lean.Meta.Tactic.TryThis -import Std.Lean.CoreM -import Std.Lean.Expr -import Std.Lean.Meta.DiscrTree -import Std.Lean.Meta.LazyDiscrTree -import Lean.Elab.Tactic.SolveByElim -import Std.Util.Pickle - -/-! -# Library search - -This file defines tactics `std_exact?` and `std_apply?`, -(formerly known as `library_search`) -and a term elaborator `std_exact?%` -that tries to find a lemma -solving the current goal -(subgoals are solved using `solveByElim`). - -``` -example : x < x + 1 := std_exact?% -example : Nat := by std_exact? -``` - -These functions will likely lose their `std_` prefix once -we are ready to replace the corresponding implementations in Mathlib. --/ - -namespace Std.Tactic.LibrarySearch - -open Lean Meta Tactic.TryThis - -initialize registerTraceClass `Tactic.stdLibrarySearch -initialize registerTraceClass `Tactic.stdLibrarySearch.lemmas - -/-- Configuration for `DiscrTree`. -/ -def discrTreeConfig : WhnfCoreConfig := {} - -/-- -A "modifier" for a declaration. -* `none` indicates the original declaration, -* `mp` indicates that (possibly after binders) the declaration is an `↔`, - and we want to consider the forward direction, -* `mpr` similarly, but for the backward direction. --/ -inductive DeclMod - | /-- the original declaration -/ none - | /-- the forward direction of an `iff` -/ mp - | /-- the backward direction of an `iff` -/ mpr -deriving DecidableEq, Inhabited, Ord - -instance : ToString DeclMod where - toString m := match m with | .none => "" | .mp => "mp" | .mpr => "mpr" - -/-- -LibrarySearch has an extension mechanism for replacing the function used -to find candidate lemmas. --/ -@[reducible] -def CandidateFinder := Expr → MetaM (Array (Name × DeclMod)) - -open LazyDiscrTree (InitEntry isBlackListed createImportedEnvironment) - -namespace DiscrTreeFinder - -open System (FilePath) - - -/-- -Once we reach Mathlib, and have `cache` available, -we may still want to load a precomputed cache for `exact?` from a `.olean` file. - -This makes no sense here in Std, where there is no caching mechanism. --/ -def cachePath : IO FilePath := do - let sp ← searchPathRef.get - if let buildPath :: _ := sp then - let path := buildPath / "LibrarySearch.extra" - if ← path.pathExists then - return path - return ".lake" / "build" / "lib" / "LibrarySearch.extra" - -/-- Add a path to a discrimination tree.-/ -private def addPath [BEq α] (config : WhnfCoreConfig) (tree : DiscrTree α) (tp : Expr) (v : α) : - MetaM (DiscrTree α) := do - let k ← DiscrTree.mkPath tp config - pure <| tree.insertCore k v - -/-- Adds a constant with given name to tree. -/ -private def updateTree (config : WhnfCoreConfig) (tree : DiscrTree (Name × DeclMod)) - (name : Name) (constInfo : ConstantInfo) : MetaM (DiscrTree (Name × DeclMod)) := do - if constInfo.isUnsafe then return tree - if isBlackListed (←getEnv) name then return tree - withReducible do - let (_, _, type) ← forallMetaTelescope constInfo.type - let tree ← addPath config tree type (name, DeclMod.none) - match type.getAppFnArgs with - | (``Iff, #[lhs, rhs]) => do - let tree ← addPath config tree rhs (name, DeclMod.mp) - let tree ← addPath config tree lhs (name, DeclMod.mpr) - return tree - | _ => - return tree - -/-- -Constructs an discriminator tree from the current environment. --/ -def buildImportCache (config : WhnfCoreConfig) : MetaM (DiscrTree (Name × DeclMod)) := do - let profilingName := "apply?: init cache" - -- Sort so lemmas with longest names come first. - let post (A : Array (Name × DeclMod)) := - A.map (fun (n, m) => (n.toString.length, n, m)) |>.qsort (fun p q => p.1 > q.1) |>.map (·.2) - profileitM Exception profilingName (← getOptions) do - (·.mapArrays post) <$> (← getEnv).constants.map₁.foldM (init := {}) (updateTree config) - -/-- -Return matches from local constants. - -N.B. The efficiency of this could likely be considerably improved by caching in environment -extension. --/ -def localMatches (config : WhnfCoreConfig) (ty : Expr) : MetaM (Array (Name × DeclMod)) := do - let locals ← (← getEnv).constants.map₂.foldlM (init := {}) (DiscrTreeFinder.updateTree config) - pure <| (← locals.getMatch ty config).reverse - -/-- -Candidate finding function that uses strict discrimination tree for resolution. --/ -def mkImportFinder (config : WhnfCoreConfig) (importTree : DiscrTree (Name × DeclMod)) - (ty : Expr) : MetaM (Array (Name × DeclMod)) := do - pure <| (← importTree.getMatch ty config).reverse - -end DiscrTreeFinder - -namespace IncDiscrTreeFinder - - -/-- -The maximum number of constants an individual task performed. - -The value below was picked because it roughly correponded to 50ms of work on the machine this was -developed on. Smaller numbers did not seem to improve performance when importing Std and larger -numbers (<10k) seemed to degrade initialization performance. --/ -private def constantsPerTask : Nat := 6500 - -private def addImport (name : Name) (constInfo : ConstantInfo) : - MetaM (Array (InitEntry (Name × DeclMod))) := - forallTelescope constInfo.type fun _ type => do - let e ← InitEntry.fromExpr type (name, DeclMod.none) - let a := #[e] - if e.key == .const ``Iff 2 then - let a := a.push (←e.mkSubEntry 0 (name, DeclMod.mp)) - let a := a.push (←e.mkSubEntry 1 (name, DeclMod.mpr)) - pure a - else - pure a - -/-- -Candidate finding function that uses strict discrimination tree for resolution. --/ -def mkImportFinder : IO CandidateFinder := do - let ref ← IO.mkRef none - pure fun ty => do - let importTree ← (←ref.get).getDM $ do - profileitM Exception "librarySearch launch" (←getOptions) $ - createImportedEnvironment (←getEnv) (constantsPerTask := constantsPerTask) addImport - let (imports, importTree) ← importTree.getMatch ty - ref.set importTree - pure imports - -end IncDiscrTreeFinder - -private unsafe def mkImportFinder : IO CandidateFinder := do - let path ← DiscrTreeFinder.cachePath - if ← path.pathExists then - let (imports, _) ← unpickle (DiscrTree (Name × DeclMod)) path - -- `DiscrTree.getMatch` returns results in batches, with more specific lemmas coming later. - -- Hence we reverse this list, so we try out more specific lemmas earlier. - pure <| DiscrTreeFinder.mkImportFinder {} imports - else do - IncDiscrTreeFinder.mkImportFinder - -/-- -The preferred candidate finding function. --/ -initialize defaultCandidateFinder : IO.Ref CandidateFinder ← unsafe do - IO.mkRef (←mkImportFinder) - -/-- -Update the candidate finder used by library search. --/ -def setDefaultCandidateFinder (cf : CandidateFinder) : IO Unit := - defaultCandidateFinder.set cf - -private def emoji (e:Except ε α) := if e.toBool then checkEmoji else crossEmoji - -/-- Create lemma from name and mod. -/ -def mkLibrarySearchLemma (lem : Name) (mod : DeclMod) : MetaM Expr := do - let lem ← mkConstWithFreshMVarLevels lem - match mod with - | .none => pure lem - | .mp => mapForallTelescope (fun e => mkAppM ``Iff.mp #[e]) lem - | .mpr => mapForallTelescope (fun e => mkAppM ``Iff.mpr #[e]) lem - -/-- -A library search candidate using symmetry includes the goal to solve, the metavar -context for that goal, and the name and orientation of a rule to try using with goal. --/ -@[reducible] -def Candidate := (MVarId × MetavarContext) × (Name × DeclMod) - -/-- -Try applying the given lemma (with symmetry modifier) to the goal, -then try to close subsequent goals using `solveByElim`. -If `solveByElim` succeeds, we return `[]` as the list of new subgoals, -otherwise the full list of subgoals. --/ -private def librarySearchLemma (cfg : ApplyConfig) (act : List MVarId → MetaM (List MVarId)) - (allowFailure : MVarId → MetaM Bool) (cand : Candidate) : MetaM (List MVarId) := do - let ((goal, mctx), (name, mod)) := cand - withTraceNode `Tactic.stdLibrarySearch (return m!"{emoji ·} trying {name} with {mod} ") do - setMCtx mctx - let lem ← mkLibrarySearchLemma name mod - let newGoals ← goal.apply lem cfg - try - act newGoals - catch _ => - if ← allowFailure goal then - pure newGoals - else - failure - -/-- -Interleave x y interleaves the elements of x and y until one is empty and then returns -final elements in other list. --/ -def interleaveWith {α β γ} (f : α → γ) (x : Array α) (g : β → γ) (y : Array β) : Array γ := - Id.run do - let mut res := Array.mkEmpty (x.size + y.size) - let n := min x.size y.size - for h : i in [0:n] do - have p : i < min x.size y.size := h.2 - have q : i < x.size := Nat.le_trans p (Nat.min_le_left ..) - have r : i < y.size := Nat.le_trans p (Nat.min_le_right ..) - res := res.push (f x[i]) - res := res.push (g y[i]) - let last := - if x.size > n then - (x.extract n x.size).map f - else - (y.extract n y.size).map g - pure $ res ++ last - -/-- -Run `searchFn` on both the goal and `symm` applied to the goal. --/ -def librarySearchSymm (searchFn : CandidateFinder) (goal : MVarId) : MetaM (Array Candidate) := do - let tgt ← goal.getType - let l1 ← searchFn tgt - let coreMCtx ← getMCtx - let coreGoalCtx := (goal, coreMCtx) - if let some symmGoal ← observing? goal.applySymm then - let newType ← instantiateMVars (← symmGoal.getType) - let l2 ← searchFn newType - let symmMCtx ← getMCtx - let symmGoalCtx := (symmGoal, symmMCtx) - setMCtx coreMCtx - pure $ interleaveWith (coreGoalCtx, ·) l1 (symmGoalCtx, ·) l2 - else - pure $ l1.map (coreGoalCtx, ·) - -/-- A type synonym for our subgoal ranking algorithm. -/ -def SubgoalRankType := Bool × Nat × Int - deriving ToString - -instance : Ord SubgoalRankType := - have : Ord (Nat × Int) := lexOrd - lexOrd - -/-- Count how many local hypotheses appear in an expression. -/ -def countLocalHypsUsed [Monad m] [MonadLCtx m] [MonadMCtx m] (e : Expr) : m Nat := do - let e' ← instantiateMVars e - return (← getLocalHyps).foldr (init := 0) fun h n => if h.occurs e' then n + 1 else n - -/-- Returns a tuple: -* are there no remaining goals? -* how many local hypotheses were used? -* how many goals remain, negated? - -Larger values (i.e. no remaining goals, more local hypotheses, fewer remaining goals) -are better. --/ -def subgoalRanking (goal : MVarId) (subgoals : List MVarId) : MetaM SubgoalRankType := do - return (subgoals.isEmpty, ← countLocalHypsUsed (.mvar goal), - subgoals.length) - -/-- -An exception Id that indicates further speculation on candidate lemmas should stop -and current results returned. --/ -private initialize abortSpeculationId : InternalExceptionId ← - registerInternalExceptionId `Std.Tactic.LibrarySearch.abortSpeculation - -/-- -Called to abort speculative execution in library search. --/ -def abortSpeculation [MonadExcept Exception m] : m α := - throw (Exception.internal abortSpeculationId {}) - -/-- Returns true if this is an abort speculation exception. -/ -def isAbortSpeculation : Exception → Bool -| .internal id _ => id == abortSpeculationId -| _ => false - -/-- -Sequentially invokes a tactic `act` on each value in candidates on the current state. - -The tactic `act` should return a list of meta-variables that still need to be resolved. -If this list is empty, then no variables remain to be solved, and `tryOnEach` returns -`none` with the environment set so each goal is resolved. - -If the action throws an internal exception with the `abortSpeculationId` id then -further computation is stopped and intermediate results returned. If any other -exception is thrown, then it is silently discarded. --/ -def tryOnEach - (act : Candidate → MetaM (List MVarId)) - (candidates : Array Candidate) : - MetaM (Option (Array (List MVarId × MetavarContext))) := do - let mut a := #[] - let s ← saveState - for c in candidates do - match ← (tryCatch (Except.ok <$> act c) (pure ∘ Except.error)) with - | .error e => - restoreState s - if isAbortSpeculation e then - break - | .ok remaining => - if remaining.isEmpty then - return none - let ctx ← getMCtx - restoreState s - a := a.push (remaining, ctx) - return (.some a) - -/-- -Return an action that returns true when the remaining heartbeats is less -than the currently remaining heartbeats * leavePercent / 100. --/ -def mkHeartbeatCheck (leavePercent : Nat) : MetaM (MetaM Bool) := do - let maxHB ← getMaxHeartbeats - let hbThreshold := (← getRemainingHeartbeats) * leavePercent / 100 - -- Return true if we should stop - pure $ - if maxHB = 0 then - pure false - else do - return (← getRemainingHeartbeats) < hbThreshold - -open SolveByElim - -/-- Shortcut for calling `solveByElim`. -/ -def solveByElim (required : List Expr) (exfalso : Bool) (goals : List MVarId) (maxDepth : Nat) := do - -- There is only a marginal decrease in performance for using the `symm` option for `solveByElim`. - -- (measured via `lake build && time lake env lean test/librarySearch.lean`). - let cfg : SolveByElimConfig := - { maxDepth, exfalso := exfalso, symm := true, commitIndependentGoals := true, - transparency := ← getTransparency, - -- `constructor` has been observed to significantly slow down `exact?` in Mathlib. - constructor := false } - let ⟨lemmas, ctx⟩ ← SolveByElim.mkAssumptionSet false false [] [] #[] - let cfg := if !required.isEmpty then cfg.requireUsingAll required else cfg - SolveByElim.solveByElim cfg lemmas ctx goals - -/-- State for resolving imports -/ -private def LibSearchState := IO.Ref (Option CandidateFinder) - -private initialize LibSearchState.default : IO.Ref (Option CandidateFinder) ← do - IO.mkRef .none - -private instance : Inhabited LibSearchState where - default := LibSearchState.default - -private initialize ext : EnvExtension LibSearchState ← - registerEnvExtension (IO.mkRef .none) - -private def librarySearchEmoji : Except ε (Option α) → String -| .error _ => bombEmoji -| .ok (some _) => crossEmoji -| .ok none => checkEmoji - -private def librarySearch' (goal : MVarId) - (tactic : List MVarId → MetaM (List MVarId)) - (allowFailure : MVarId → MetaM Bool) - (leavePercentHeartbeats : Nat) : - MetaM (Option (Array (List MVarId × MetavarContext))) := do - withTraceNode `Tactic.stdLibrarySearch (return m!"{librarySearchEmoji ·} {← goal.getType}") do - profileitM Exception "librarySearch" (← getOptions) do - let importFinder ← do - let r := ext.getState (←getEnv) - match ←r.get with - | .some f => pure f - | .none => - let f ← defaultCandidateFinder.get - r.set (.some f) - pure f - let searchFn (ty : Expr) := do - let localMap ← (← getEnv).constants.map₂.foldlM (init := {}) (DiscrTreeFinder.updateTree {}) - let locals := (← localMap.getMatch ty {}).reverse - pure <| locals ++ (← importFinder ty) - -- Create predicate that returns true when running low on heartbeats. - let shouldAbort ← mkHeartbeatCheck leavePercentHeartbeats - let candidates ← librarySearchSymm searchFn goal - let cfg : ApplyConfig := { allowSynthFailures := true } - let act := fun cand => do - if ←shouldAbort then - abortSpeculation - librarySearchLemma cfg tactic allowFailure cand - tryOnEach act candidates - -/-- -Try to solve the goal either by: -* calling `tactic true` -* or applying a library lemma then calling `tactic false` on the resulting goals. - -Typically here `tactic` is `solveByElim`, -with the `Bool` flag indicating whether it may retry with `exfalso`. - -If it successfully closes the goal, returns `none`. -Otherwise, it returns `some a`, where `a : Array (List MVarId × MetavarContext)`, -with an entry for each library lemma which was successfully applied, -containing a list of the subsidiary goals, and the metavariable context after the application. - -(Always succeeds, and the metavariable context stored in the monad is reverted, -unless the goal was completely solved.) - -(Note that if `solveByElim` solves some but not all subsidiary goals, -this is not currently tracked.) --/ -def librarySearch (goal : MVarId) - (tactic : Bool → List MVarId → MetaM (List MVarId)) - (allowFailure : MVarId → MetaM Bool := fun _ => pure true) - (leavePercentHeartbeats : Nat := 10) : - MetaM (Option (Array (List MVarId × MetavarContext))) := do - (tactic true [goal] *> pure none) <|> - librarySearch' goal (tactic false) allowFailure leavePercentHeartbeats - -open Lean.Parser.Tactic - --- TODO: implement the additional options for `library_search` from Lean 3, --- in particular including additional lemmas --- with `std_exact? [X, Y, Z]` or `std_exact? with attr`. - --- For now we only implement the basic functionality. --- The full syntax is recognized, but will produce a "Tactic has not been implemented" error. - -/-- Syntax for `std_exact?` -/ -syntax (name := std_exact?') "std_exact?" (config)? (simpArgs)? (" using " (colGt ident),+)? - ("=>" tacticSeq)? : tactic - -/-- Syntax for `std_apply?` -/ -syntax (name := std_apply?') "std_apply?" (config)? (simpArgs)? (" using " (colGt term),+)? : tactic - -open Elab.Tactic Elab Tactic -open Parser.Tactic (tacticSeq) - -/-- Implementation of the `exact?` tactic. -/ -def exact? (tk : Syntax) (required : Option (Array (TSyntax `term))) - (solver : Option (TSyntax `Lean.Parser.Tactic.tacticSeq)) (requireClose : Bool) : - TacticM Unit := do - let mvar ← getMainGoal - let (_, goal) ← (← getMainGoal).intros - goal.withContext do - let required := (← (required.getD #[]).mapM getFVarId).toList.map .fvar - let tactic ← - match solver with - | none => - pure (fun exfalso => solveByElim required (exfalso := exfalso) (maxDepth := 6)) - | some t => - let _ <- mkInitialTacticInfo t - throwError "Do not yet support custom std_exact?/std_apply? tactics." - let allowFailure := fun g => do - let g ← g.withContext (instantiateMVars (.mvar g)) - return required.all fun e => e.occurs g - match ← librarySearch goal tactic allowFailure with - -- Found goal that closed problem - | none => - addExactSuggestion tk (← instantiateMVars (mkMVar mvar)).headBeta - -- Found suggestions - | some suggestions => - if requireClose then throwError - "`std_exact?` could not close the goal. Try `std_apply?` to see partial suggestions." - reportOutOfHeartbeats `library_search tk - for (_, suggestionMCtx) in suggestions do - withMCtx suggestionMCtx do - addExactSuggestion tk (← instantiateMVars (mkMVar mvar)).headBeta (addSubgoalsMsg := true) - if suggestions.isEmpty then logError "std_apply? didn't find any relevant lemmas" - admitGoal goal - -elab_rules : tactic - | `(tactic| std_exact? $[using $[$lemmas],*]? $[=> $solver]?) => do - exact? (← getRef) lemmas solver true - -elab_rules : tactic | `(tactic| std_apply? $[using $[$required],*]?) => do - exact? (← getRef) required none false - ---/-- Deprecation warning for `library_search`. -/ ---elab tk:"library_search" : tactic => do --- logWarning ("`library_search` has been renamed to `apply?`" ++ --- " (or `exact?` if you only want solutions closing the goal)") --- exact? tk none false - -open Elab Term in -/-- Term elaborator using the `exact?` tactic. -/ -elab tk:"std_exact?%" : term <= expectedType => do - let goal ← mkFreshExprMVar expectedType - let (_, introdGoal) ← goal.mvarId!.intros - introdGoal.withContext do - let tactic := fun exfalso g => solveByElim [] (maxDepth := 6) exfalso g - if let some suggestions ← librarySearch introdGoal tactic then - reportOutOfHeartbeats `library_search tk - for suggestion in suggestions do - withMCtx suggestion.2 do - addTermSuggestion tk (← instantiateMVars goal).headBeta - if suggestions.isEmpty then logError "std_exact? didn't find any relevant lemmas" - mkSorry expectedType (synthetic := true) - else - addTermSuggestion tk (← instantiateMVars goal).headBeta - instantiateMVars goal From 43d668665648e8242dd9419b28552640c4b83b51 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sun, 25 Feb 2024 17:51:45 +1100 Subject: [PATCH 086/213] rename std_apply? --- test/library_search/basic.lean | 92 +++++++++++++++++----------------- 1 file changed, 46 insertions(+), 46 deletions(-) diff --git a/test/library_search/basic.lean b/test/library_search/basic.lean index fc7c6ff9b2..4879724e05 100644 --- a/test/library_search/basic.lean +++ b/test/library_search/basic.lean @@ -22,106 +22,106 @@ noncomputable section /-- info: Try this: exact Nat.lt.base x -/ #guard_msgs in -example (x : Nat) : x ≠ x.succ := Nat.ne_of_lt (by std_apply?) +example (x : Nat) : x ≠ x.succ := Nat.ne_of_lt (by apply?) /-- info: Try this: exact Nat.zero_lt_succ 1 -/ #guard_msgs in -example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by std_apply?) +example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by apply?) example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by exact Fin.size_pos') /-- info: Try this: exact Nat.add_comm x y -/ #guard_msgs in -example (x y : Nat) : x + y = y + x := by std_apply? +example (x y : Nat) : x + y = y + x := by apply? /-- info: Try this: exact fun a => Nat.add_le_add_right a k -/ #guard_msgs in -example (n m k : Nat) : n ≤ m → n + k ≤ m + k := by std_apply? +example (n m k : Nat) : n ≤ m → n + k ≤ m + k := by apply? /-- info: Try this: exact Nat.mul_dvd_mul_left a w -/ #guard_msgs in -example (ha : a > 0) (w : b ∣ c) : a * b ∣ a * c := by std_apply? +example (ha : a > 0) (w : b ∣ c) : a * b ∣ a * c := by apply? -- Could be any number of results (`Int.one`, `Int.zero`, etc) #guard_msgs (drop info) in -example : Int := by std_apply? +example : Int := by apply? /-- info: Try this: Nat.lt.base x -/ #guard_msgs in -example : x < x + 1 := std_exact?% +example : x < x + 1 := exact?% /-- info: Try this: exact p -/ #guard_msgs in -example (P : Prop) (p : P) : P := by std_apply? +example (P : Prop) (p : P) : P := by apply? /-- info: Try this: exact False.elim (np p) -/ #guard_msgs in -example (P : Prop) (p : P) (np : ¬P) : false := by std_apply? +example (P : Prop) (p : P) (np : ¬P) : false := by apply? /-- info: Try this: exact h x rfl -/ #guard_msgs in -example (X : Type) (P : Prop) (x : X) (h : ∀ x : X, x = x → P) : P := by std_apply? +example (X : Type) (P : Prop) (x : X) (h : ∀ x : X, x = x → P) : P := by apply? -- Could be any number of results (`fun x => x`, `id`, etc) #guard_msgs (drop info) in -example (α : Prop) : α → α := by std_apply? +example (α : Prop) : α → α := by apply? -- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example (p : Prop) : (¬¬p) → p := by std_apply? -- says: `exact not_not.mp` --- example (a b : Prop) (h : a ∧ b) : a := by std_apply? -- says: `exact h.left` --- example (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by std_apply? -- say: `exact Function.mtr` +-- example (p : Prop) : (¬¬p) → p := by apply? -- says: `exact not_not.mp` +-- example (a b : Prop) (h : a ∧ b) : a := by apply? -- says: `exact h.left` +-- example (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by apply? -- say: `exact Function.mtr` /-- info: Try this: exact Nat.add_comm a b -/ #guard_msgs in example (a b : Nat) : a + b = b + a := -by std_apply? +by apply? /-- info: Try this: exact Nat.mul_sub_left_distrib n m k -/ #guard_msgs in example (n m k : Nat) : n * (m - k) = n * m - n * k := -by std_apply? +by apply? attribute [symm] Eq.symm /-- info: Try this: exact Eq.symm (Nat.mul_sub_left_distrib n m k) -/ #guard_msgs in example (n m k : Nat) : n * m - n * k = n * (m - k) := by - std_apply? + apply? /-- info: Try this: exact eq_comm -/ #guard_msgs in -example {α : Type} (x y : α) : x = y ↔ y = x := by std_apply? +example {α : Type} (x y : α) : x = y ↔ y = x := by apply? /-- info: Try this: exact Nat.add_pos_left ha b -/ #guard_msgs in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by std_apply? +example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? /-- info: Try this: exact Nat.add_pos_left ha b -/ #guard_msgs in -- Verify that if maxHeartbeats is 0 we don't stop immediately. set_option maxHeartbeats 0 in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by std_apply? +example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? section synonym /-- info: Try this: exact Nat.add_pos_left ha b -/ #guard_msgs in -example (a b : Nat) (ha : a > 0) (_hb : 0 < b) : 0 < a + b := by std_apply? +example (a b : Nat) (ha : a > 0) (_hb : 0 < b) : 0 < a + b := by apply? /-- info: Try this: exact Nat.le_of_dvd w h -/ #guard_msgs in example (a b : Nat) (h : a ∣ b) (w : b > 0) : a ≤ b := -by std_apply? +by apply? /-- info: Try this: exact Nat.le_of_dvd w h -/ #guard_msgs in -example (a b : Nat) (h : a ∣ b) (w : b > 0) : b ≥ a := by std_apply? +example (a b : Nat) (h : a ∣ b) (w : b > 0) : b ≥ a := by apply? -- TODO: A lemma with head symbol `¬` can be used to prove `¬ p` or `⊥` /-- info: Try this: exact Nat.not_lt_zero a -/ #guard_msgs in -example (a : Nat) : ¬ (a < 0) := by std_apply? +example (a : Nat) : ¬ (a < 0) := by apply? /-- info: Try this: exact Nat.not_succ_le_zero a h -/ #guard_msgs in -example (a : Nat) (h : a < 0) : False := by std_apply? +example (a : Nat) (h : a < 0) : False := by apply? -- An inductive type hides the constructor's arguments enough -- so that `apply?` doesn't accidentally close the goal. @@ -137,60 +137,60 @@ theorem lemma_with_false_in_head (a b : Nat) (_h1 : a < b) (h2 : P a) : False := /-- info: Try this: exact lemma_with_gt_in_head a h -/ #guard_msgs in -example (a : Nat) (h : P a) : 0 > a := by std_apply? +example (a : Nat) (h : P a) : 0 > a := by apply? /-- info: Try this: exact lemma_with_gt_in_head a h -/ #guard_msgs in -example (a : Nat) (h : P a) : a < 0 := by std_apply? +example (a : Nat) (h : P a) : a < 0 := by apply? /-- info: Try this: exact lemma_with_false_in_head a b h1 h2 -/ #guard_msgs in -example (a b : Nat) (h1 : a < b) (h2 : P a) : False := by std_apply? +example (a b : Nat) (h1 : a < b) (h2 : P a) : False := by apply? -- TODO this no longer works: --- example (a b : Nat) (h1 : a < b) : ¬ (P a) := by std_apply? -- says `exact lemma_with_false_in_head a b h1` +-- example (a b : Nat) (h1 : a < b) : ¬ (P a) := by apply? -- says `exact lemma_with_false_in_head a b h1` end synonym /-- info: Try this: exact fun P => iff_not_self -/ #guard_msgs in -example : ∀ P : Prop, ¬(P ↔ ¬P) := by std_apply? +example : ∀ P : Prop, ¬(P ↔ ¬P) := by apply? -- We even find `iff` results: /-- info: Try this: exact (Nat.dvd_add_iff_left h₁).mpr h₂ -/ #guard_msgs in -example {a b c : Nat} (h₁ : a ∣ c) (h₂ : a ∣ b + c) : a ∣ b := by std_apply? +example {a b c : Nat} (h₁ : a ∣ c) (h₂ : a ∣ b + c) : a ∣ b := by apply? -- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example {α : Sort u} (h : Empty) : α := by std_apply? -- says `exact Empty.elim h` --- example (f : A → C) (g : B → C) : (A ⊕ B) → C := by std_apply? -- says `exact Sum.elim f g` --- example (n : Nat) (r : ℚ) : ℚ := by std_apply? using n, r -- exact nsmulRec n r +-- example {α : Sort u} (h : Empty) : α := by apply? -- says `exact Empty.elim h` +-- example (f : A → C) (g : B → C) : (A ⊕ B) → C := by apply? -- says `exact Sum.elim f g` +-- example (n : Nat) (r : ℚ) : ℚ := by apply? using n, r -- exact nsmulRec n r opaque f : Nat → Nat axiom F (a b : Nat) : f a ≤ f b ↔ a ≤ b /-- info: Try this: exact (F a b).mpr h -/ #guard_msgs in -example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by std_apply? +example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by apply? /-- info: Try this: exact List.join L -/ #guard_msgs in -example (L : List (List Nat)) : List Nat := by std_apply? using L +example (L : List (List Nat)) : List Nat := by apply? using L -- Could be any number of results #guard_msgs (drop info) in -example (P _Q : List Nat) (h : Nat) : List Nat := by std_apply? using h, P +example (P _Q : List Nat) (h : Nat) : List Nat := by apply? using h, P -- Could be any number of results #guard_msgs (drop info) in example (l : List α) (f : α → β ⊕ γ) : List β × List γ := by - std_apply? using f -- partitionMap f l + apply? using f -- partitionMap f l -- Could be any number of results (`Nat.mul n m`, `Nat.add n m`, etc) #guard_msgs (drop info) in -example (n m : Nat) : Nat := by std_apply? using n, m +example (n m : Nat) : Nat := by apply? using n, m #guard_msgs (drop info) in -example (P Q : List Nat) (_h : Nat) : List Nat := by std_exact? using P, Q +example (P Q : List Nat) (_h : Nat) : List Nat := by exact? using P, Q -- Check that we don't use sorryAx: -- (see https://github.com/leanprover-community/mathlib4/issues/226) @@ -200,7 +200,7 @@ theorem Bool_eq_iff {A B : Bool} : (A = B) = (A ↔ B) := /-- info: Try this: exact Bool_eq_iff -/ #guard_msgs in theorem Bool_eq_iff2 {A B : Bool} : (A = B) = (A ↔ B) := by - std_apply? -- exact Bool_eq_iff + apply? -- exact Bool_eq_iff -- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/library_search.20regression/near/354025788 -- Disabled for Std @@ -213,17 +213,17 @@ theorem Bool_eq_iff2 {A B : Bool} : (A = B) = (A ↔ B) := by -- /-- info: Try this: exact Iff.symm Nat.prime_iff -/ --#guard_msgs in --example (n : Nat) : Prime n ↔ Nat.Prime n := by --- std_exact? +-- exact? -- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/exact.3F.20recent.20regression.3F/near/387691588 -- Disabled for Std --lemma ex' (x : Nat) (_h₁ : x = 0) (h : 2 * 2 ∣ x) : 2 ∣ x := by --- std_exact? says exact dvd_of_mul_left_dvd h +-- exact? says exact dvd_of_mul_left_dvd h -- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/apply.3F.20failure/near/402534407 -- Disabled for Std --example (P Q : Prop) (h : P → Q) (h' : ¬Q) : ¬P := by --- std_exact? says exact mt h h' +-- exact? says exact mt h h' -- Removed until we come up with a way of handling nonspecific lemmas -- that does not pollute the output or cause too much slow-down. @@ -242,11 +242,11 @@ warning: declaration uses 'sorry' -/ #guard_msgs in example {x : Int} (h : x ≠ 0) : 2 * x ≠ 0 := by - std_apply? using h + apply? using h -- Check that adding `with_reducible` prevents expensive kernel reductions. -- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/.60exact.3F.60.20failure.3A.20.22maximum.20recursion.20depth.20has.20been.20reached.22/near/417649319 /-- info: Try this: exact Nat.add_comm n m -/ #guard_msgs in example (_h : List.range 10000 = List.range 10000) (n m : Nat) : n + m = m + n := by - with_reducible std_exact? + with_reducible exact? From 4c80d37b02ab7cd779f0664163823d56e96480c2 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sun, 25 Feb 2024 17:55:20 +1100 Subject: [PATCH 087/213] fixes --- Std.lean | 1 - Std/Data/MLList/Heartbeats.lean | 3 +- Std/Lean/CoreM.lean | 50 --------------------------------- 3 files changed, 2 insertions(+), 52 deletions(-) delete mode 100644 Std/Lean/CoreM.lean diff --git a/Std.lean b/Std.lean index a8333ad82c..6ee2645e60 100644 --- a/Std.lean +++ b/Std.lean @@ -37,7 +37,6 @@ import Std.Data.String import Std.Data.Sum import Std.Data.UInt import Std.Lean.AttributeExtra -import Std.Lean.CoreM import Std.Lean.Delaborator import Std.Lean.Except import Std.Lean.Expr diff --git a/Std/Data/MLList/Heartbeats.lean b/Std/Data/MLList/Heartbeats.lean index a079f0db7c..02e9ebc2a9 100644 --- a/Std/Data/MLList/Heartbeats.lean +++ b/Std/Data/MLList/Heartbeats.lean @@ -4,12 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.MLList.Basic -import Std.Lean.CoreM +import Lean.Util.Heartbeats /-! # Truncate a `MLList` when running out of available heartbeats. -/ +open Lean open Lean.Core (CoreM) /-- Take an initial segment of a monadic lazy list, diff --git a/Std/Lean/CoreM.lean b/Std/Lean/CoreM.lean deleted file mode 100644 index 563debce6d..0000000000 --- a/Std/Lean/CoreM.lean +++ /dev/null @@ -1,50 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Lean.CoreM - -/-! -# Additional functions using `CoreM` state. --/ - -open Lean - -/-- -Count the number of heartbeats used during a monadic function. - -Remember that user facing heartbeats (e.g. as used in `set_option maxHeartbeats`) -differ from the internally tracked heartbeats by a factor of 1000, -so you need to divide the results here by 1000 before comparing with user facing numbers. --/ --- See also `Lean.withSeconds` -def Lean.withHeartbeats [Monad m] [MonadLiftT BaseIO m] (x : m α) : m (α × Nat) := do - let start ← IO.getNumHeartbeats - let r ← x - let finish ← IO.getNumHeartbeats - return (r, finish - start) - -/-- Return the current `maxHeartbeats`. -/ -def getMaxHeartbeats : CoreM Nat := do pure <| (← read).maxHeartbeats - -/-- Return the current `initHeartbeats`. -/ -def getInitHeartbeats : CoreM Nat := do pure <| (← read).initHeartbeats - -/-- Return the remaining heartbeats available in this computation. -/ -def getRemainingHeartbeats : CoreM Nat := do - pure <| (← getMaxHeartbeats) - ((← IO.getNumHeartbeats) - (← getInitHeartbeats)) - -/-- -Return the percentage of the max heartbeats allowed -that have been consumed so far in this computation. --/ -def heartbeatsPercent : CoreM Nat := do - pure <| ((← IO.getNumHeartbeats) - (← getInitHeartbeats)) * 100 / (← getMaxHeartbeats) - -/-- Log a message if it looks like we ran out of time. -/ -def reportOutOfHeartbeats (tac : Name) (stx : Syntax) (threshold : Nat := 90) : CoreM Unit := do - if (← heartbeatsPercent) ≥ threshold then - logInfoAt stx s!"\ - `{tac}` stopped because it was running out of time.\n\ - You may get better results using `set_option maxHeartbeats 0`." From 58f119a8691912e16657894f8aa0184238f7a5f6 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sun, 25 Feb 2024 17:57:19 +1100 Subject: [PATCH 088/213] chore: add test for simultaneous 'import Lean' and 'import Std' --- test/import_lean.lean | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 test/import_lean.lean diff --git a/test/import_lean.lean b/test/import_lean.lean new file mode 100644 index 0000000000..6ff94554f4 --- /dev/null +++ b/test/import_lean.lean @@ -0,0 +1,6 @@ +import Lean +import Std + +/-! +This file ensures that we can import all of `Lean` and `Std` without name conflicts. +-/ From 19109661af5009f6989fbc1b1a3bf51259abe53e Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sun, 25 Feb 2024 18:01:00 +1100 Subject: [PATCH 089/213] updates --- Std.lean | 1 - Std/Lean/Meta/LazyDiscrTree.lean | 881 ------------------------------- 2 files changed, 882 deletions(-) delete mode 100644 Std/Lean/Meta/LazyDiscrTree.lean diff --git a/Std.lean b/Std.lean index 6ee2645e60..c6bbd877a9 100644 --- a/Std.lean +++ b/Std.lean @@ -52,7 +52,6 @@ import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.Expr import Std.Lean.Meta.Inaccessible import Std.Lean.Meta.InstantiateMVars -import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Meta.SavedState import Std.Lean.Meta.Simp import Std.Lean.Meta.UnusedNames diff --git a/Std/Lean/Meta/LazyDiscrTree.lean b/Std/Lean/Meta/LazyDiscrTree.lean deleted file mode 100644 index 725896ef99..0000000000 --- a/Std/Lean/Meta/LazyDiscrTree.lean +++ /dev/null @@ -1,881 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix, Scott Morrison --/ - -import Lean.Meta.DiscrTree -import Std.Lean.Name - -/-! -# Lazy Discrimination Tree - -This file defines a new type of discrimination tree optimized for -rapidly population of imported modules for use in tactics. It uses a -lazy initialization strategy. - -The discrimination tree can be created through -`createImportedEnvironment`. This creates a discrimination tree from all -imported modules in an environment using a callback that provides the -entries as `InitEntry` values. - -The function `getMatch` can be used to get the values that match the -expression as well as an updated lazy discrimination tree that has -elaborated additional parts of the tree. --/ -namespace Lean.Meta.LazyDiscrTree - --- This namespace contains definitions copied from Lean.Meta.DiscrTree. -namespace MatchClone - -/-- -Discrimination tree key. --/ -private inductive Key where - /-- Constant -/ - | const : Name → Nat → Key - | fvar : FVarId → Nat → Key - | lit : Literal → Key - | star : Key - | other : Key - | arrow : Key - | proj : Name → Nat → Nat → Key - deriving Inhabited, BEq, Repr - -namespace Key - -/-- Hash function -/ -protected def hash : Key → UInt64 - | .const n a => mixHash 5237 $ mixHash n.hash (hash a) - | .fvar n a => mixHash 3541 $ mixHash (hash n) (hash a) - | .lit v => mixHash 1879 $ hash v - | .star => 7883 - | .other => 2411 - | .arrow => 17 - | .proj s i a => mixHash (hash a) $ mixHash (hash s) (hash i) - -instance : Hashable Key := ⟨Key.hash⟩ - -end Key - -private def tmpMVarId : MVarId := { name := `_discr_tree_tmp } -private def tmpStar := mkMVar tmpMVarId - -/-- - Return true iff the argument should be treated as a "wildcard" by the discrimination tree. - - - We ignore proofs because of proof irrelevance. It doesn't make sense to try to - index their structure. - - - We ignore instance implicit arguments (e.g., `[Add α]`) because they are "morally" canonical. - Moreover, we may have many definitionally equal terms floating around. - Example: `Ring.hasAdd Int Int.isRing` and `Int.hasAdd`. - - - We considered ignoring implicit arguments (e.g., `{α : Type}`) since users don't "see" them, - and may not even understand why some simplification rule is not firing. - However, in type class resolution, we have instance such as `Decidable (@Eq Nat x y)`, - where `Nat` is an implicit argument. Thus, we would add the path - ``` - Decidable -> Eq -> * -> * -> * -> [Nat.decEq] - ``` - to the discrimination tree IF we ignored the implicit `Nat` argument. - This would be BAD since **ALL** decidable equality instances would be in the same path. - So, we index implicit arguments if they are types. - This setting seems sensible for simplification theorems such as: - ``` - forall (x y : Unit), (@Eq Unit x y) = true - ``` - If we ignore the implicit argument `Unit`, the `DiscrTree` will say it is a candidate - simplification theorem for any equality in our goal. - - Remark: if users have problems with the solution above, we may provide a `noIndexing` annotation, - and `ignoreArg` would return true for any term of the form `noIndexing t`. --/ -private def ignoreArg (a : Expr) (i : Nat) (infos : Array ParamInfo) : MetaM Bool := do - if h : i < infos.size then - let info := infos.get ⟨i, h⟩ - if info.isInstImplicit then - return true - else if info.isImplicit || info.isStrictImplicit then - return not (← isType a) - else - isProof a - else - isProof a - -private partial def pushArgsAux (infos : Array ParamInfo) : Nat → Expr → Array Expr → - MetaM (Array Expr) - | i, .app f a, todo => do - if (← ignoreArg a i infos) then - pushArgsAux infos (i-1) f (todo.push tmpStar) - else - pushArgsAux infos (i-1) f (todo.push a) - | _, _, todo => return todo - -/-- - Return true if `e` is one of the following - - A nat literal (numeral) - - `Nat.zero` - - `Nat.succ x` where `isNumeral x` - - `OfNat.ofNat _ x _` where `isNumeral x` -/ -private partial def isNumeral (e : Expr) : Bool := - if e.isRawNatLit then true - else - let f := e.getAppFn - if !f.isConst then false - else - let fName := f.constName! - if fName == ``Nat.succ && e.getAppNumArgs == 1 then isNumeral e.appArg! - else if fName == ``OfNat.ofNat && e.getAppNumArgs == 3 then isNumeral (e.getArg! 1) - else if fName == ``Nat.zero && e.getAppNumArgs == 0 then true - else false - -private partial def toNatLit? (e : Expr) : Option Literal := - if isNumeral e then - if let some n := loop e then - some (.natVal n) - else - none - else - none -where - loop (e : Expr) : OptionT Id Nat := do - let f := e.getAppFn - match f with - | .lit (.natVal n) => return n - | .const fName .. => - if fName == ``Nat.succ && e.getAppNumArgs == 1 then - let r ← loop e.appArg! - return r+1 - else if fName == ``OfNat.ofNat && e.getAppNumArgs == 3 then - loop (e.getArg! 1) - else if fName == ``Nat.zero && e.getAppNumArgs == 0 then - return 0 - else - failure - | _ => failure - -private def isNatType (e : Expr) : MetaM Bool := - return (← whnf e).isConstOf ``Nat - -/-- - Return true if `e` is one of the following - - `Nat.add _ k` where `isNumeral k` - - `Add.add Nat _ _ k` where `isNumeral k` - - `HAdd.hAdd _ Nat _ _ k` where `isNumeral k` - - `Nat.succ _` - This function assumes `e.isAppOf fName` --/ -private def isOffset (fName : Name) (e : Expr) : MetaM Bool := do - if fName == ``Nat.add && e.getAppNumArgs == 2 then - return isNumeral e.appArg! - else if fName == ``Add.add && e.getAppNumArgs == 4 then - if (← isNatType (e.getArg! 0)) then return isNumeral e.appArg! else return false - else if fName == ``HAdd.hAdd && e.getAppNumArgs == 6 then - if (← isNatType (e.getArg! 1)) then return isNumeral e.appArg! else return false - else - return fName == ``Nat.succ && e.getAppNumArgs == 1 - -/-- - TODO: add hook for users adding their own functions for controlling `shouldAddAsStar` - Different `DiscrTree` users may populate this set using, for example, attributes. - - Remark: we currently tag "offset" terms as star to avoid having to add special - support for offset terms. - Example, suppose the discrimination tree contains the entry - `Nat.succ ?m |-> v`, and we are trying to retrieve the matches for - `Expr.lit (Literal.natVal 1) _`. - In this scenario, we want to retrieve `Nat.succ ?m |-> v` --/ -private def shouldAddAsStar (fName : Name) (e : Expr) : MetaM Bool := do - isOffset fName e - -/-- - Try to eliminate loose bound variables by performing beta-reduction. - We use this method when processing terms in discrimination trees. - These trees distinguish dependent arrows from nondependent ones. - Recall that dependent arrows are indexed as `.other`, but nondependent arrows as `.arrow ..`. - Motivation: we want to "discriminate" implications and simple arrows in our index. - - Now suppose we add the term `Foo (Nat → Nat)` to our index. The nested arrow appears as - `.arrow ..`. Then, suppose we want to check whether the index contains - `(x : Nat) → (fun _ => Nat) x`, but it will fail to retrieve `Foo (Nat → Nat)` because - it assumes the nested arrow is a dependent one and uses `.other`. - - We use this method to address this issue by beta-reducing terms containing loose bound variables. - See issue #2232. - - Remark: we expect the performance impact will be minimal. --/ -private def elimLooseBVarsByBeta (e : Expr) : CoreM Expr := - Core.transform e - (pre := fun e => do - if !e.hasLooseBVars then - return .done e - else if e.isHeadBetaTarget then - return .visit e.headBeta - else - return .continue) - -private def getKeyArgs (e : Expr) (isMatch root : Bool) (config : WhnfCoreConfig) : - MetaM (Key × Array Expr) := do - let e ← DiscrTree.reduceDT e root config - unless root do - -- See pushArgs - if let some v := toNatLit? e then - return (.lit v, #[]) - match e.getAppFn with - | .lit v => return (.lit v, #[]) - | .const c _ => - if (← getConfig).isDefEqStuckEx && e.hasExprMVar then - if (← isReducible c) then - /- `e` is a term `c ...` s.t. `c` is reducible and `e` has metavariables, but it was not - unfolded. This can happen if the metavariables in `e` are "blocking" smart unfolding. - If `isDefEqStuckEx` is enabled, then we must throw the `isDefEqStuck` exception to - postpone TC resolution. - Here is an example. Suppose we have - ``` - inductive Ty where - | bool | fn (a ty : Ty) - - - @[reducible] def Ty.interp : Ty → Type - | bool => Bool - | fn a b => a.interp → b.interp - ``` - and we are trying to synthesize `BEq (Ty.interp ?m)` - -/ - Meta.throwIsDefEqStuck - else if let some matcherInfo := isMatcherAppCore? (← getEnv) e then - -- A matcher application is stuck if one of the discriminants has a metavariable - let args := e.getAppArgs - let start := matcherInfo.getFirstDiscrPos - for arg in args[ start : start + matcherInfo.numDiscrs ] do - if arg.hasExprMVar then - Meta.throwIsDefEqStuck - else if (← isRec c) then - /- Similar to the previous case, but for `match` and recursor applications. It may be stuck - (i.e., did not reduce) because of metavariables. -/ - Meta.throwIsDefEqStuck - let nargs := e.getAppNumArgs - return (.const c nargs, e.getAppRevArgs) - | .fvar fvarId => - let nargs := e.getAppNumArgs - return (.fvar fvarId nargs, e.getAppRevArgs) - | .mvar mvarId => - if isMatch then - return (.other, #[]) - else do - let ctx ← read - if ctx.config.isDefEqStuckEx then - /- - When the configuration flag `isDefEqStuckEx` is set to true, - we want `isDefEq` to throw an exception whenever it tries to assign - a read-only metavariable. - This feature is useful for type class resolution where - we may want to notify the caller that the TC problem may be solvable - later after it assigns `?m`. - The method `DiscrTree.getUnify e` returns candidates `c` that may "unify" with `e`. - That is, `isDefEq c e` may return true. Now, consider `DiscrTree.getUnify d (Add ?m)` - where `?m` is a read-only metavariable, and the discrimination tree contains the keys - `HadAdd Nat` and `Add Int`. If `isDefEqStuckEx` is set to true, we must treat `?m` as - a regular metavariable here, otherwise we return the empty set of candidates. - This is incorrect because it is equivalent to saying that there is no solution even if - the caller assigns `?m` and try again. -/ - return (.star, #[]) - else if (← mvarId.isReadOnlyOrSyntheticOpaque) then - return (.other, #[]) - else - return (.star, #[]) - | .proj s i a .. => - let nargs := e.getAppNumArgs - return (.proj s i nargs, #[a] ++ e.getAppRevArgs) - | .forallE _ d b _ => - -- See comment at elimLooseBVarsByBeta - let b ← if b.hasLooseBVars then elimLooseBVarsByBeta b else pure b - if b.hasLooseBVars then - return (.other, #[]) - else - return (.arrow, #[d, b]) - | .bvar _ | .letE _ _ _ _ _ | .lam _ _ _ _ | .mdata _ _ | .app _ _ | .sort _ => - return (.other, #[]) - -/- -Given an expression we are looking for patterns that match, return the key and sub-expressions. --/ -private abbrev getMatchKeyArgs (e : Expr) (root : Bool) (config : WhnfCoreConfig) : - MetaM (Key × Array Expr) := - getKeyArgs e (isMatch := true) (root := root) (config := config) - -end MatchClone - -export MatchClone (Key Key.const) - -/-- -An unprocessed entry in the lazy discrimination tree. --/ -private abbrev LazyEntry α := Array Expr × ((LocalContext × LocalInstances) × α) - -/-- -Index identifying trie in a discrimination tree. --/ -@[reducible] -private def TrieIndex := Nat - -/-- -Discrimination tree trie. See `LazyDiscrTree`. --/ -private structure Trie (α : Type) where - node :: - /-- Values for matches ending at this trie. -/ - values : Array α - /-- Index of trie matching star. -/ - star : TrieIndex - /-- Following matches based on key of trie. -/ - children : HashMap Key TrieIndex - /-- Lazy entries at this trie that are not processed. -/ - pending : Array (LazyEntry α) - deriving Inhabited - -instance : EmptyCollection (Trie α) := ⟨.node #[] 0 {} #[]⟩ - -/-- Push lazy entry to trie. -/ -private def Trie.pushPending : Trie α → LazyEntry α → Trie α -| .node vs star cs p, e => .node vs star cs (p.push e) - -end LazyDiscrTree - -/-- -`LazyDiscrTree` is a variant of the discriminator tree datatype -`DiscrTree` in Lean core that is designed to be efficiently -initializable with a large number of patterns. This is useful -in contexts such as searching an entire Lean environment for -expressions that match a pattern. - -Lazy discriminator trees achieve good performance by minimizing -the amount of work that is done up front to build the discriminator -tree. When first adding patterns to the tree, only the root -discriminator key is computed and processing the remaining -terms is deferred until demanded by a match. --/ -structure LazyDiscrTree (α : Type) where - /-- Configuration for normalization. -/ - config : Lean.Meta.WhnfCoreConfig := {} - /-- Backing array of trie entries. Should be owned by this trie. -/ - tries : Array (LazyDiscrTree.Trie α) := #[default] - /-- Map from discriminator trie roots to the index. -/ - roots : Lean.HashMap LazyDiscrTree.Key LazyDiscrTree.TrieIndex := {} - -namespace LazyDiscrTree - -open Lean Elab Meta - -instance : Inhabited (LazyDiscrTree α) where - default := {} - -open Lean.Meta.DiscrTree (mkNoindexAnnotation hasNoindexAnnotation reduceDT) - -/-- -Specialization of Lean.Meta.DiscrTree.pushArgs --/ -private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) (config : WhnfCoreConfig) : - MetaM (Key × Array Expr) := do - if hasNoindexAnnotation e then - return (.star, todo) - else - let e ← reduceDT e root config - let fn := e.getAppFn - let push (k : Key) (nargs : Nat) (todo : Array Expr) : MetaM (Key × Array Expr) := do - let info ← getFunInfoNArgs fn nargs - let todo ← MatchClone.pushArgsAux info.paramInfo (nargs-1) e todo - return (k, todo) - match fn with - | .lit v => - return (.lit v, todo) - | .const c _ => - unless root do - if let some v := MatchClone.toNatLit? e then - return (.lit v, todo) - if (← MatchClone.shouldAddAsStar c e) then - return (.star, todo) - let nargs := e.getAppNumArgs - push (.const c nargs) nargs todo - | .proj s i a => - /- - If `s` is a class, then `a` is an instance. Thus, we annotate `a` with `no_index` since we do - not index instances. This should only happen if users mark a class projection function as - `[reducible]`. - - TODO: add better support for projections that are functions - -/ - let a := if isClass (← getEnv) s then mkNoindexAnnotation a else a - let nargs := e.getAppNumArgs - push (.proj s i nargs) nargs (todo.push a) - | .fvar _fvarId => --- let bi ← fvarId.getBinderInfo --- if bi.isInstImplicit then --- return (.other, todo) --- else - return (.star, todo) - | .mvar mvarId => - if mvarId == MatchClone.tmpMVarId then - -- We use `tmp to mark implicit arguments and proofs - return (.star, todo) - else - failure - | .forallE _ d b _ => - -- See comment at elimLooseBVarsByBeta - let b ← if b.hasLooseBVars then MatchClone.elimLooseBVarsByBeta b else pure b - if b.hasLooseBVars then - return (.other, todo) - else - return (.arrow, (todo.push d).push b) - | _ => - return (.other, todo) - -/-- Initial capacity for key and todo vector. -/ -private def initCapacity := 8 - -/-- -Get the root key and rest of terms of an expression using the specified config. --/ -private def rootKey (cfg: WhnfCoreConfig) (e : Expr) : MetaM (Key × Array Expr) := - pushArgs true (Array.mkEmpty initCapacity) e cfg - -private partial def mkPathAux (root : Bool) (todo : Array Expr) (keys : Array Key) - (config : WhnfCoreConfig) : MetaM (Array Key) := do - if todo.isEmpty then - return keys - else - let e := todo.back - let todo := todo.pop - let (k, todo) ← pushArgs root todo e config - mkPathAux false todo (keys.push k) config - -/-- -Create a path from an expression. - -This differs from Lean.Meta.DiscrTree.mkPath in that the expression -should uses free variables rather than meta-variables for holes. --/ -private def mkPath (e : Expr) (config : WhnfCoreConfig) : MetaM (Array Key) := do - let todo : Array Expr := .mkEmpty initCapacity - let keys : Array Key := .mkEmpty initCapacity - mkPathAux (root := true) (todo.push e) keys config - -/- Monad for finding matches while resolving deferred patterns. -/ -@[reducible] -private def MatchM α := ReaderT WhnfCoreConfig (StateRefT (Array (Trie α)) MetaM) - -private def runMatch (d : LazyDiscrTree α) (m : MatchM α β) : MetaM (β × LazyDiscrTree α) := do - let { config := c, tries := a, roots := r } := d - let (result, a) ← withReducible $ (m.run c).run a - pure (result, { config := c, tries := a, roots := r}) - -private def setTrie (i : TrieIndex) (v : Trie α) : MatchM α Unit := - modify (·.set! i v) - -/-- Create a new trie with the given lazy entry. -/ -private def newTrie [Monad m] [MonadState (Array (Trie α)) m] (e : LazyEntry α) : m TrieIndex := do - modifyGet fun a => let sz := a.size; (sz, a.push (.node #[] 0 {} #[e])) - -/-- Add a lazy entry to an existing trie. -/ -private def addLazyEntryToTrie (i:TrieIndex) (e : LazyEntry α) : MatchM α Unit := - modify (·.modify i (·.pushPending e)) - -/-- -This evaluates all lazy entries in a trie and updates `values`, `starIdx`, and `children` -accordingly. --/ -private partial def evalLazyEntries (config : WhnfCoreConfig) - (values : Array α) (starIdx : TrieIndex) (children : HashMap Key TrieIndex) - (entries : Array (LazyEntry α)) : - MatchM α (Array α × TrieIndex × HashMap Key TrieIndex) := do - let rec iter values starIdx children (i : Nat) : MatchM α _ := do - if p : i < entries.size then - let (todo, lctx, v) := entries[i] - if todo.isEmpty then - let values := values.push v - iter values starIdx children (i+1) - else - let e := todo.back - let todo := todo.pop - let (k, todo) ← withLCtx lctx.1 lctx.2 $ pushArgs false todo e config - if k == .star then - if starIdx = 0 then - let starIdx ← newTrie (todo, lctx, v) - iter values starIdx children (i+1) - else - addLazyEntryToTrie starIdx (todo, lctx, v) - iter values starIdx children (i+1) - else - match children.find? k with - | none => - let children := children.insert k (← newTrie (todo, lctx, v)) - iter values starIdx children (i+1) - | some idx => - addLazyEntryToTrie idx (todo, lctx, v) - iter values starIdx children (i+1) - else - pure (values, starIdx, children) - iter values starIdx children 0 - -private def evalNode (c : TrieIndex) : - MatchM α (Array α × TrieIndex × HashMap Key TrieIndex) := do - let .node vs star cs pending := (←get).get! c - if pending.size = 0 then - pure (vs, star, cs) - else - let config ← read - setTrie c default - let (vs, star, cs) ← evalLazyEntries config vs star cs pending - setTrie c <| .node vs star cs #[] - pure (vs, star, cs) - -/-- -Return the information about the trie at the given idnex. - -Used for internal debugging purposes. --/ -private def getTrie (d : LazyDiscrTree α) (idx : TrieIndex) : - MetaM ((Array α × TrieIndex × HashMap Key TrieIndex) × LazyDiscrTree α) := - runMatch d (evalNode idx) - -/-- -A match result repres --/ -private structure MatchResult (α : Type) where - elts : Array (Array (Array α)) := #[] - -private def MatchResult.push (r : MatchResult α) (score : Nat) (e : Array α) : MatchResult α := - if e.isEmpty then - r - else if score < r.elts.size then - { elts := r.elts.modify score (·.push e) } - else - let rec loop (a : Array (Array (Array α))) := - if a.size < score then - loop (a.push #[]) - else - { elts := a.push #[e] } - termination_by score - a.size - loop r.elts - -private partial def MatchResult.toArray (mr : MatchResult α) : Array α := - loop (Array.mkEmpty n) mr.elts - where n := mr.elts.foldl (fun i a => a.foldl (fun n a => n + a.size) i) 0 - loop (r : Array α) (a : Array (Array (Array α))) := - if a.isEmpty then - r - else - loop (a.back.foldl (init := r) (fun r a => r ++ a)) a.pop - -private partial def getMatchLoop (todo : Array Expr) (score : Nat) (c : TrieIndex) - (result : MatchResult α) : MatchM α (MatchResult α) := do - let (vs, star, cs) ← evalNode c - if todo.isEmpty then - return result.push score vs - else if star == 0 && cs.isEmpty then - return result - else - let e := todo.back - let todo := todo.pop - /- We must always visit `Key.star` edges since they are wildcards. - Thus, `todo` is not used linearly when there is `Key.star` edge - and there is an edge for `k` and `k != Key.star`. -/ - let visitStar (result : MatchResult α) : MatchM α (MatchResult α) := - if star != 0 then - getMatchLoop todo score star result - else - return result - let visitNonStar (k : Key) (args : Array Expr) (result : MatchResult α) := - match cs.find? k with - | none => return result - | some c => getMatchLoop (todo ++ args) (score + 1) c result - let result ← visitStar result - let (k, args) ← MatchClone.getMatchKeyArgs e (root := false) (←read) - match k with - | .star => return result - /- - Note: dep-arrow vs arrow - Recall that dependent arrows are `(Key.other, #[])`, and non-dependent arrows are - `(Key.arrow, #[a, b])`. - A non-dependent arrow may be an instance of a dependent arrow (stored at `DiscrTree`). - Thus, we also visit the `Key.other` child. - -/ - | .arrow => visitNonStar .other #[] (← visitNonStar k args result) - | _ => visitNonStar k args result - -private def getStarResult (root : Lean.HashMap Key TrieIndex) : MatchM α (MatchResult α) := - match root.find? .star with - | none => - pure <| {} - | some idx => do - let (vs, _) ← evalNode idx - pure <| ({} : MatchResult α).push 0 vs - -private def getMatchRoot (r : Lean.HashMap Key TrieIndex) (k : Key) (args : Array Expr) - (result : MatchResult α) : MatchM α (MatchResult α) := - match r.find? k with - | none => pure result - | some c => getMatchLoop args 1 c result - -/-- - Find values that match `e` in `root`. --/ -private def getMatchCore (root : Lean.HashMap Key TrieIndex) (e : Expr) : - MatchM α (MatchResult α) := do - let result ← getStarResult root - let (k, args) ← MatchClone.getMatchKeyArgs e (root := true) (←read) - match k with - | .star => return result - /- See note about "dep-arrow vs arrow" at `getMatchLoop` -/ - | .arrow => - getMatchRoot root k args (←getMatchRoot root .other #[] result) - | _ => - getMatchRoot root k args result - -/-- - Find values that match `e` in `d`. - - The results are ordered so that the longest matches in terms of number of - non-star keys are first with ties going to earlier operators first. --/ -def getMatch (d : LazyDiscrTree α) (e : Expr) : MetaM (Array α × LazyDiscrTree α) := - withReducible <| runMatch d <| (·.toArray) <$> getMatchCore d.roots e - -/-- -Structure for quickly initializing a lazy discrimination tree with a large number -of elements using concurrent functions for generating entries. --/ -private structure PreDiscrTree (α : Type) where - /-- Maps keys to index in tries array. -/ - roots : HashMap Key Nat := {} - /-- Lazy entries for root of trie. -/ - tries : Array (Array (LazyEntry α)) := #[] - deriving Inhabited - -namespace PreDiscrTree - -private def modifyAt (d : PreDiscrTree α) (k : Key) - (f : Array (LazyEntry α) → Array (LazyEntry α)) : PreDiscrTree α := - let { roots, tries } := d - match roots.find? k with - | .none => - let roots := roots.insert k tries.size - { roots, tries := tries.push (f #[]) } - | .some i => - { roots, tries := tries.modify i f } - -/-- Add an entry to the pre-discrimination tree.-/ -private def push (d : PreDiscrTree α) (k : Key) (e : LazyEntry α) : PreDiscrTree α := - d.modifyAt k (·.push e) - -/-- Convert a pre-discrimination tree to a lazy discrimination tree. -/ -private def toLazy (d : PreDiscrTree α) (config : WhnfCoreConfig := {}) : LazyDiscrTree α := - let { roots, tries } := d - { config, roots, tries := tries.map (.node {} 0 {}) } - -/-- Merge two discrimination trees. -/ -protected def append (x y : PreDiscrTree α) : PreDiscrTree α := - let (x, y, f) := - if x.roots.size ≥ y.roots.size then - (x, y, fun y x => x ++ y) - else - (y, x, fun x y => x ++ y) - let { roots := yk, tries := ya } := y - yk.fold (init := x) fun d k yi => d.modifyAt k (f ya[yi]!) - -instance : Append (PreDiscrTree α) where - append := PreDiscrTree.append - -end PreDiscrTree - -/-- Initial entry in lazy discrimination tree -/ -@[reducible] -structure InitEntry (α : Type) where - /-- Return root key for an entry. -/ - key : Key - /-- Returns rest of entry for later insertion. -/ - entry : LazyEntry α - -namespace InitEntry - -/-- -Constructs an initial entry from an expression and value. --/ -def fromExpr (expr : Expr) (value : α) (config : WhnfCoreConfig := {}) : MetaM (InitEntry α) := do - let lctx ← getLCtx - let linst ← getLocalInstances - let lctx := (lctx, linst) - let (key, todo) ← LazyDiscrTree.rootKey config expr - pure <| { key, entry := (todo, lctx, value) } - -/-- -Creates an entry for a subterm of an initial entry. - -This is slightly more efficient than using `fromExpr` on subterms since it avoids a redundant call -to `whnf`. --/ -def mkSubEntry (e : InitEntry α) (idx : Nat) (value : α) (config : WhnfCoreConfig := {}) : - MetaM (InitEntry α) := do - let (todo, lctx, _) := e.entry - let (key, todo) ← LazyDiscrTree.rootKey config todo[idx]! - pure <| { key, entry := (todo, lctx, value) } - -end InitEntry - -/-- Information about a failed import. -/ -private structure ImportFailure where - /-- Module with constant that import failed on. -/ - module : Name - /-- Constant that import failed on. -/ - const : Name - /-- Exception that triggers error. -/ - exception : Exception - -/-- Information generation from imported modules. -/ -private structure ImportData where - cache : IO.Ref (Lean.Meta.Cache) - errors : IO.Ref (Array ImportFailure) - -private def ImportData.new : BaseIO ImportData := do - let cache ← IO.mkRef {} - let errors ← IO.mkRef #[] - pure { cache, errors } - -/-- -An even wider class of "internal" names than reported by `Name.isInternalDetail`. --/ --- from Lean.Server.Completion -def isBlackListed (env : Environment) (declName : Name) : Bool := - declName == ``sorryAx - || declName.isInternalDetail - || declName matches .str _ "inj" - || declName matches .str _ "noConfusionType" - || isAuxRecursor env declName - || isNoConfusion env declName - || isRecCore env declName - || isMatcherCore env declName - -private def addConstImportData - (env : Environment) - (modName : Name) - (d : ImportData) - (tree : PreDiscrTree α) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (name : Name) (constInfo : ConstantInfo) : BaseIO (PreDiscrTree α) := do - if constInfo.isUnsafe then return tree - if isBlackListed env name then return tree - let mstate : Meta.State := { cache := ←d.cache.get } - d.cache.set {} - let ctx : Meta.Context := { config := { transparency := .reducible } } - let cm := (act name constInfo).run ctx mstate - let cctx : Core.Context := { - fileName := default, - fileMap := default - } - let cstate : Core.State := {env} - match ←(cm.run cctx cstate).toBaseIO with - | .ok ((a, ms), _) => - d.cache.set ms.cache - pure <| a.foldl (fun t e => t.push e.key e.entry) tree - | .error e => - let i : ImportFailure := { - module := modName, - const := name, - exception := e - } - d.errors.modify (·.push i) - pure tree - -/-- -Contains the pre discrimination tree and any errors occuring during initialization of -the library search tree. --/ -private structure InitResults (α : Type) where - tree : PreDiscrTree α := {} - errors : Array ImportFailure := #[] - -instance : Inhabited (InitResults α) where - default := {} - -namespace InitResults - -/-- Combine two initial results. -/ -protected def append (x y : InitResults α) : InitResults α := - let { tree := xv, errors := xe } := x - let { tree := yv, errors := ye } := y - { tree := xv ++ yv, errors := xe ++ ye } - -instance : Append (InitResults α) where - append := InitResults.append - -end InitResults - -private def toFlat (d : ImportData) (tree : PreDiscrTree α) : - BaseIO (InitResults α) := do - let de ← d.errors.swap #[] - pure ⟨tree, de⟩ - -private partial def loadImportedModule (env : Environment) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (d : ImportData) - (tree : PreDiscrTree α) - (mname : Name) - (mdata : ModuleData) - (i : Nat := 0) : BaseIO (PreDiscrTree α) := do - if h : i < mdata.constNames.size then - let name := mdata.constNames[i] - let constInfo := mdata.constants[i]! - let tree ← addConstImportData env mname d tree act name constInfo - loadImportedModule env act d tree mname mdata (i+1) - else - pure tree - -private def createImportedEnvironmentSeq (env : Environment) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (start stop : Nat) : BaseIO (InitResults α) := - do go (← ImportData.new) {} start stop - where go d (tree : PreDiscrTree α) (start stop : Nat) : BaseIO _ := do - if start < stop then - let mname := env.header.moduleNames[start]! - let mdata := env.header.moduleData[start]! - let tree ← loadImportedModule env act d tree mname mdata - go d tree (start+1) stop - else - toFlat d tree - termination_by stop - start - -/-- Get the results of each task and merge using combining function -/ -private def combineGet [Append α] (z : α) (tasks : Array (Task α)) : α := - tasks.foldl (fun x t => x ++ t.get) (init := z) - -/-- Create an imported environment for tree. -/ -def createImportedEnvironment (env : Environment) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (constantsPerTask : Nat := 1000) : - EIO Exception (LazyDiscrTree α) := do - let n := env.header.moduleData.size - let rec - /-- Allocate constants to tasks according to `constantsPerTask`. -/ - go tasks start cnt idx := do - if h : idx < env.header.moduleData.size then - let mdata := env.header.moduleData[idx] - let cnt := cnt + mdata.constants.size - if cnt > constantsPerTask then - let t ← createImportedEnvironmentSeq env act start (idx+1) |>.asTask - go (tasks.push t) (idx+1) 0 (idx+1) - else - go tasks start cnt (idx+1) - else - if start < n then - tasks.push <$> (createImportedEnvironmentSeq env act start n).asTask - else - pure tasks - termination_by env.header.moduleData.size - idx - let tasks ← go #[] 0 0 0 - let r := combineGet default tasks - if p : r.errors.size > 0 then - throw r.errors[0].exception - pure <| r.tree.toLazy From 5a874b10d19c3028ea6e98c9882015b23d774601 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sun, 25 Feb 2024 19:20:08 +1100 Subject: [PATCH 090/213] restore lemma --- Std/Data/Fin/Lemmas.lean | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 015d8b66f9..b48858d97e 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -8,3 +8,7 @@ import Std.Data.Fin.Basic namespace Fin attribute [norm_cast] val_last + +/-! ### clamp -/ + +@[simp] theorem coe_clamp (n m : Nat) : (clamp n m : Nat) = min n m := rfl From ce0285d72019790689ba152ef47b4f9a12909b6b Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 26 Feb 2024 09:31:42 +1100 Subject: [PATCH 091/213] fix bitvec stuff --- test/bitvec.lean | 4 +-- test/bitvec_simproc.lean | 70 ++++++++++++++++++++-------------------- 2 files changed, 36 insertions(+), 38 deletions(-) diff --git a/test/bitvec.lean b/test/bitvec.lean index e7a0d78617..4814fdd1a8 100644 --- a/test/bitvec.lean +++ b/test/bitvec.lean @@ -1,6 +1,6 @@ import Std.Data.BitVec -open Std.BitVec +open BitVec -- Basic arithmetic #guard 1#12 + 2#12 = 3#12 @@ -93,8 +93,6 @@ open Std.BitVec #guard extractLsb 7 4 0x1234#16 = 3 #guard extractLsb' 0 4 0x1234#16 = 0x4#4 -open Std - /-- This tests the match compiler with bitvector literals to ensure it can successfully generate a pattern for a bitvector literals. diff --git a/test/bitvec_simproc.lean b/test/bitvec_simproc.lean index b3c42ec12c..1013b41664 100644 --- a/test/bitvec_simproc.lean +++ b/test/bitvec_simproc.lean @@ -4,45 +4,45 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ import Std.Data.BitVec -open Std BitVec +open BitVec -example (h : x = (6 : Std.BitVec 3)) : x = -2 := by +example (h : x = (6 : BitVec 3)) : x = -2 := by simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (5 : Std.BitVec 3)) : x = ~~~2 := by +example (h : x = (5 : BitVec 3)) : x = ~~~2 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : Std.BitVec 32)) : x = BitVec.abs (-1#32) := by +example (h : x = (1 : BitVec 32)) : x = BitVec.abs (-1#32) := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (5 : Std.BitVec 3)) : x = 2 + 3 := by +example (h : x = (5 : BitVec 3)) : x = 2 + 3 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : Std.BitVec 3)) : x = 5 &&& 3 := by +example (h : x = (1 : BitVec 3)) : x = 5 &&& 3 := by simp; guard_target =ₛ x = 1#3; assumption -example (h : x = (7 : Std.BitVec 3)) : x = 5 ||| 3 := by +example (h : x = (7 : BitVec 3)) : x = 5 ||| 3 := by simp; guard_target =ₛ x = 7#3; assumption -example (h : x = (6 : Std.BitVec 3)) : x = 5 ^^^ 3 := by +example (h : x = (6 : BitVec 3)) : x = 5 ^^^ 3 := by simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (3 : Std.BitVec 32)) : x = 5 - 2 := by +example (h : x = (3 : BitVec 32)) : x = 5 - 2 := by simp; guard_target =ₛ x = 3#32; assumption -example (h : x = (10 : Std.BitVec 32)) : x = 5 * 2 := by +example (h : x = (10 : BitVec 32)) : x = 5 * 2 := by simp; guard_target =ₛ x = 10#32; assumption -example (h : x = (4 : Std.BitVec 32)) : x = 9 / 2 := by +example (h : x = (4 : BitVec 32)) : x = 9 / 2 := by simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = 9 % 2 := by +example (h : x = (1 : BitVec 32)) : x = 9 % 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : Std.BitVec 32)) : x = udiv 9 2 := by +example (h : x = (4 : BitVec 32)) : x = udiv 9 2 := by simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = umod 9 2 := by +example (h : x = (1 : BitVec 32)) : x = umod 9 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : Std.BitVec 32)) : x = sdiv (-9) (-2) := by +example (h : x = (4 : BitVec 32)) : x = sdiv (-9) (-2) := by simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = smod (-9) 2 := by +example (h : x = (1 : BitVec 32)) : x = smod (-9) 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = - smtUDiv 9 0 := by +example (h : x = (1 : BitVec 32)) : x = - smtUDiv 9 0 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = - srem (-9) 2 := by +example (h : x = (1 : BitVec 32)) : x = - srem (-9) 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = - smtSDiv 9 0 := by +example (h : x = (1 : BitVec 32)) : x = - smtSDiv 9 0 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = smtSDiv (-9) 0 := by +example (h : x = (1 : BitVec 32)) : x = smtSDiv (-9) 0 := by simp; guard_target =ₛ x = 1#32; assumption example (h : x = false) : x = (4#3).getLsb 0:= by simp; guard_target =ₛ x = false; assumption @@ -52,29 +52,29 @@ example (h : x = true) : x = (4#3).getMsb 0:= by simp; guard_target =ₛ x = true; assumption example (h : x = false) : x = (4#3).getMsb 2:= by simp; guard_target =ₛ x = false; assumption -example (h : x = (24 : Std.BitVec 32)) : x = 6#32 <<< 2 := by +example (h : x = (24 : BitVec 32)) : x = 6#32 <<< 2 := by simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = 6#32 >>> 2 := by +example (h : x = (1 : BitVec 32)) : x = 6#32 >>> 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (24 : Std.BitVec 32)) : x = BitVec.shiftLeft 6#32 2 := by +example (h : x = (24 : BitVec 32)) : x = BitVec.shiftLeft 6#32 2 := by simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = BitVec.ushiftRight 6#32 2 := by +example (h : x = (1 : BitVec 32)) : x = BitVec.ushiftRight 6#32 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (2 : Std.BitVec 32)) : x = - BitVec.sshiftRight (- 6#32) 2 := by +example (h : x = (2 : BitVec 32)) : x = - BitVec.sshiftRight (- 6#32) 2 := by simp; guard_target =ₛ x = 2#32; assumption -example (h : x = (5 : Std.BitVec 3)) : x = BitVec.rotateLeft (6#3) 1 := by +example (h : x = (5 : BitVec 3)) : x = BitVec.rotateLeft (6#3) 1 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (3 : Std.BitVec 3)) : x = BitVec.rotateRight (6#3) 1 := by +example (h : x = (3 : BitVec 3)) : x = BitVec.rotateRight (6#3) 1 := by simp; guard_target =ₛ x = 3#3; assumption -example (h : x = (7 : Std.BitVec 5)) : x = 1#3 ++ 3#2 := by +example (h : x = (7 : BitVec 5)) : x = 1#3 ++ 3#2 := by simp; guard_target =ₛ x = 7#5; assumption -example (h : x = (1 : Std.BitVec 3)) : x = BitVec.cast (by decide : 3=2+1) 1#3 := by +example (h : x = (1 : BitVec 3)) : x = BitVec.cast (by decide : 3=2+1) 1#3 := by simp; guard_target =ₛ x = 1#3; assumption example (h : x = 5) : x = (2#3 + 3#3).toNat := by simp; guard_target =ₛ x = 5; assumption example (h : x = -1) : x = (2#3 - 3#3).toInt := by simp; guard_target =ₛ x = -1; assumption -example (h : x = (1 : Std.BitVec 3)) : x = -BitVec.ofInt 3 (-1) := by +example (h : x = (1 : BitVec 3)) : x = -BitVec.ofInt 3 (-1) := by simp; guard_target =ₛ x = 1#3; assumption example (h : x) : x = (1#3 < 3#3) := by simp; guard_target =ₛ x; assumption @@ -100,13 +100,13 @@ example (h : x) : x = (3#3 ≥ 1#3) := by simp; guard_target =ₛ x; assumption example (h : ¬x) : x = (3#3 ≥ 4#3) := by simp; guard_target =ₛ ¬x; assumption -example (h : x = (5 : Std.BitVec 7)) : x = (5#3).zeroExtend' (by decide) := by +example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend' (by decide) := by simp; guard_target =ₛ x = 5#7; assumption -example (h : x = (80 : Std.BitVec 7)) : x = (5#3).shiftLeftZeroExtend 4 := by +example (h : x = (80 : BitVec 7)) : x = (5#3).shiftLeftZeroExtend 4 := by simp; guard_target =ₛ x = 80#7; assumption -example (h : x = (5: Std.BitVec 3)) : x = (10#5).extractLsb' 1 3 := by +example (h : x = (5: BitVec 3)) : x = (10#5).extractLsb' 1 3 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (9: Std.BitVec 6)) : x = (1#3).replicate 2 := by +example (h : x = (9: BitVec 6)) : x = (1#3).replicate 2 := by simp; guard_target =ₛ x = 9#6; assumption -example (h : x = (5 : Std.BitVec 7)) : x = (5#3).zeroExtend 7 := by +example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend 7 := by simp; guard_target =ₛ x = 5#7; assumption From ced7701eb3a51176ee924ca59a04c852a6760ea2 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 26 Feb 2024 15:29:50 +1100 Subject: [PATCH 092/213] fix tests --- test/lintsimp.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/lintsimp.lean b/test/lintsimp.lean index 9098b613d8..9dd0815d36 100644 --- a/test/lintsimp.lean +++ b/test/lintsimp.lean @@ -48,10 +48,10 @@ section def MyPred (_ : Nat → Nat) : Prop := True @[simp] theorem bad1 (f : Unit → Nat → Nat) : MyPred (f ()) ↔ True := by - rw [MyPred]; exact Iff.rfl + rw [MyPred] @[simp] theorem bad2 (f g : Nat → Nat) : MyPred (fun x => f (g x)) ↔ True := by - rw [MyPred]; exact Iff.rfl + rw [MyPred] -- Note, this is not a proper regression test because #671 depends on how the `MetaM` is -- executed, and `run_meta` sets the options appropriately. But setting the config From c73396385c77f3e0cb8f87ef39d463d09b0089fa Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 26 Feb 2024 09:16:10 +0000 Subject: [PATCH 093/213] chore: bump to nightly-2024-02-26 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index d71105d858..6ff4890153 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-24 +leanprover/lean4:nightly-2024-02-26 From 3fdf76f9aecd80156ab9e911a23a394a1f73f67b Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 26 Feb 2024 22:02:37 +1100 Subject: [PATCH 094/213] incomplete fixes --- Std.lean | 1 - Std/CodeAction/Attr.lean | 118 +------------------ Std/CodeAction/Basic.lean | 41 ------- Std/CodeAction/Misc.lean | 3 +- Std/Data/Int/DivMod.lean | 2 + Std/Data/Int/Order.lean | 1 + Std/Lean/Expr.lean | 19 --- Std/Tactic/GuardMsgs.lean | 194 ------------------------------- test/MLList.lean | 1 - test/absurd.lean | 1 - test/add_suggestion.lean | 1 - test/alias.lean | 1 - test/case.lean | 1 - test/coe.lean | 2 +- test/conv_equals.lean | 1 - test/ext.lean | 1 - test/guard_msgs.lean | 1 - test/instances.lean | 1 - test/isIndependentOf.lean | 1 - test/json.lean | 1 - test/kmp_matcher.lean | 1 - test/left_right.lean | 1 - test/lintTC.lean | 2 +- test/lint_unreachableTactic.lean | 1 - test/lintsimp.lean | 1 - test/lintunused.lean | 1 - test/nondet.lean | 1 - test/print_prefix.lean | 1 - test/register_label_attr.lean | 1 - test/repeat.lean | 1 - test/run_cmd.lean | 2 +- test/show_term.lean | 1 - test/simp_trace.lean | 1 - test/simpa.lean | 1 - test/tryThis.lean | 1 - test/where.lean | 1 - 36 files changed, 10 insertions(+), 400 deletions(-) delete mode 100644 Std/Tactic/GuardMsgs.lean diff --git a/Std.lean b/Std.lean index c6bbd877a9..449ed0960e 100644 --- a/Std.lean +++ b/Std.lean @@ -79,7 +79,6 @@ import Std.Tactic.Classical import Std.Tactic.Congr import Std.Tactic.Exact import Std.Tactic.FalseOrByContra -import Std.Tactic.GuardMsgs import Std.Tactic.Init import Std.Tactic.Instances import Std.Tactic.Lint diff --git a/Std/CodeAction/Attr.lean b/Std/CodeAction/Attr.lean index 42c6742404..f748450e7d 100644 --- a/Std/CodeAction/Attr.lean +++ b/Std/CodeAction/Attr.lean @@ -8,53 +8,16 @@ import Lean.Server.CodeActions /-! # Initial setup for code action attributes -* Attribute `@[hole_code_action]` collects code actions which will be called - on each occurrence of a hole (`_`, `?_` or `sorry`). +* `@[hole_code_action]` and `@[command_code_action]` now live in the Lean repository, + and are builtin. * Attribute `@[tactic_code_action]` collects code actions which will be called on each occurrence of a tactic. - -* Attribute `@[command_code_action]` collects code actions which will be called - on each occurrence of a command. -/ namespace Std.CodeAction open Lean Elab Server Lsp RequestM Snapshots -/-- A hole code action extension. -/ -abbrev HoleCodeAction := - CodeActionParams → Snapshot → - (ctx : ContextInfo) → (hole : TermInfo) → RequestM (Array LazyCodeAction) - -/-- Read a hole code action from a declaration of the right type. -/ -def mkHoleCodeAction (n : Name) : ImportM HoleCodeAction := do - let { env, opts, .. } ← read - IO.ofExcept <| unsafe env.evalConstCheck HoleCodeAction opts ``HoleCodeAction n - -/-- An extension which collects all the hole code actions. -/ -initialize holeCodeActionExt : - PersistentEnvExtension Name (Name × HoleCodeAction) (Array Name × Array HoleCodeAction) ← - registerPersistentEnvExtension { - mkInitial := pure (#[], #[]) - addImportedFn := fun as => return (#[], ← as.foldlM (init := #[]) fun m as => - as.foldlM (init := m) fun m a => return m.push (← mkHoleCodeAction a)) - addEntryFn := fun (s₁, s₂) (n₁, n₂) => (s₁.push n₁, s₂.push n₂) - exportEntriesFn := (·.1) - } - -initialize - registerBuiltinAttribute { - name := `hole_code_action - descr := "Declare a new hole code action, to appear in the code actions on ?_ and _" - applicationTime := .afterCompilation - add := fun decl stx kind => do - Attribute.Builtin.ensureNoArgs stx - unless kind == AttributeKind.global do - throwError "invalid attribute 'hole_code_action', must be global" - if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions - modifyEnv (holeCodeActionExt.addEntry · (decl, ← mkHoleCodeAction decl)) - } - /-- A tactic code action extension. -/ abbrev TacticCodeAction := CodeActionParams → Snapshot → @@ -166,80 +129,3 @@ initialize modifyEnv (tacticCodeActionExt.addEntry · (⟨decl, args⟩, ← mkTacticCodeAction decl)) | _ => pure () } - -/-- A command code action extension. -/ -abbrev CommandCodeAction := - CodeActionParams → Snapshot → (ctx : ContextInfo) → (node : InfoTree) → - RequestM (Array LazyCodeAction) - -/-- Read a command code action from a declaration of the right type. -/ -def mkCommandCodeAction (n : Name) : ImportM CommandCodeAction := do - let { env, opts, .. } ← read - IO.ofExcept <| unsafe env.evalConstCheck CommandCodeAction opts ``CommandCodeAction n - -/-- An entry in the command code actions extension, containing the attribute arguments. -/ -structure CommandCodeActionEntry where - /-- The declaration to tag -/ - declName : Name - /-- The command kinds that this extension supports. - If empty it is called on all command kinds. -/ - cmdKinds : Array Name - deriving Inhabited - -/-- The state of the command code actions extension. -/ -structure CommandCodeActions where - /-- The list of command code actions to apply on any command. -/ - onAnyCmd : Array CommandCodeAction := {} - /-- The list of command code actions to apply when a particular command kind is highlighted. -/ - onCmd : NameMap (Array CommandCodeAction) := {} - deriving Inhabited - -/-- Insert a command code action entry into the `CommandCodeActions` structure. -/ -def CommandCodeActions.insert (self : CommandCodeActions) - (tacticKinds : Array Name) (action : CommandCodeAction) : CommandCodeActions := - if tacticKinds.isEmpty then - { self with onAnyCmd := self.onAnyCmd.push action } - else - { self with onCmd := tacticKinds.foldl (init := self.onCmd) fun m a => - m.insert a ((m.findD a #[]).push action) } - -/-- An extension which collects all the command code actions. -/ -initialize cmdCodeActionExt : - PersistentEnvExtension CommandCodeActionEntry (CommandCodeActionEntry × CommandCodeAction) - (Array CommandCodeActionEntry × CommandCodeActions) ← - registerPersistentEnvExtension { - mkInitial := pure (#[], {}) - addImportedFn := fun as => return (#[], ← as.foldlM (init := {}) fun m as => - as.foldlM (init := m) fun m ⟨name, kinds⟩ => - return m.insert kinds (← mkCommandCodeAction name)) - addEntryFn := fun (s₁, s₂) (e, n₂) => (s₁.push e, s₂.insert e.cmdKinds n₂) - exportEntriesFn := (·.1) - } - -/-- -This attribute marks a code action, which is used to suggest new tactics or replace existing ones. - -* `@[command_code_action kind]`: This is a code action which applies to applications of the command - `kind` (a command syntax kind), which can replace the command or insert things before or after it. - -* `@[command_code_action kind₁ kind₂]`: shorthand for - `@[command_code_action kind₁, command_code_action kind₂]`. - -* `@[command_code_action]`: This is a command code action that applies to all commands. - Use sparingly. --/ -syntax (name := command_code_action) "command_code_action" (ppSpace ident)* : attr - -initialize - registerBuiltinAttribute { - name := `command_code_action - descr := "Declare a new command code action, to appear in the code actions on commands" - applicationTime := .afterCompilation - add := fun decl stx kind => do - unless kind == AttributeKind.global do - throwError "invalid attribute 'command_code_action', must be global" - let `(attr| command_code_action $args*) := stx | return - let args ← args.mapM resolveGlobalConstNoOverloadWithInfo - if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions - modifyEnv (cmdCodeActionExt.addEntry · (⟨decl, args⟩, ← mkCommandCodeAction decl)) - } diff --git a/Std/CodeAction/Basic.lean b/Std/CodeAction/Basic.lean index d15e086f86..d09ed3f2c6 100644 --- a/Std/CodeAction/Basic.lean +++ b/Std/CodeAction/Basic.lean @@ -21,24 +21,6 @@ namespace Std.CodeAction open Lean Elab Term Server RequestM -/-- -A code action which calls all `@[hole_code_action]` code actions on each hole -(`?_`, `_`, or `sorry`). --/ -@[code_action_provider] def holeCodeActionProvider : CodeActionProvider := fun params snap => do - let doc ← readDoc - let startPos := doc.meta.text.lspPosToUtf8Pos params.range.start - let endPos := doc.meta.text.lspPosToUtf8Pos params.range.end - have holes := snap.infoTree.foldInfo (init := #[]) fun ctx info result => Id.run do - let .ofTermInfo info := info | result - unless [``elabHole, ``elabSyntheticHole, ``elabSorry].contains info.elaborator do - return result - let (some head, some tail) := (info.stx.getPos? true, info.stx.getTailPos? true) | result - unless head ≤ endPos && startPos ≤ tail do return result - result.push (ctx, info) - let #[(ctx, info)] := holes | return #[] - (holeCodeActionExt.getState snap.env).2.concatMapM (· params snap ctx info) - /-- The return value of `findTactic?`. This is the syntax for which code actions will be triggered. @@ -205,26 +187,3 @@ partial def findInfoTree? (kind : SyntaxNodeKind) (tgtRange : String.Range) try out := out ++ (← act params snap ctx i stk goals) catch _ => pure () | _ => unreachable! pure out - -/-- -A code action which calls all `@[command_code_action]` code actions on each command. --/ -@[code_action_provider] def cmdCodeActionProvider : CodeActionProvider := fun params snap => do - let doc ← readDoc - let startPos := doc.meta.text.lspPosToUtf8Pos params.range.start - let endPos := doc.meta.text.lspPosToUtf8Pos params.range.end - have cmds := snap.infoTree.foldInfoTree (init := #[]) fun ctx node result => Id.run do - let .node (.ofCommandInfo info) _ := node | result - let (some head, some tail) := (info.stx.getPos? true, info.stx.getTailPos? true) | result - unless head ≤ endPos && startPos ≤ tail do return result - result.push (ctx, node) - let actions := (cmdCodeActionExt.getState snap.env).2 - let mut out := #[] - for (ctx, node) in cmds do - let .node (.ofCommandInfo info) _ := node | unreachable! - if let some arr := actions.onCmd.find? info.stx.getKind then - for act in arr do - try out := out ++ (← act params snap ctx node) catch _ => pure () - for act in actions.onAnyCmd do - try out := out ++ (← act params snap ctx node) catch _ => pure () - pure out diff --git a/Std/CodeAction/Misc.lean b/Std/CodeAction/Misc.lean index 18f38ec793..e6d50ef051 100644 --- a/Std/CodeAction/Misc.lean +++ b/Std/CodeAction/Misc.lean @@ -9,6 +9,7 @@ import Std.Lean.Name import Std.Lean.Position import Std.CodeAction.Attr import Lean.Meta.Tactic.TryThis +import Lean.Server.CodeActions.Provider /-! # Miscellaneous code actions @@ -17,7 +18,7 @@ This declares some basic tactic code actions, using the `@[tactic_code_action]` -/ namespace Std.CodeAction -open Lean Meta Elab Server RequestM +open Lean Meta Elab Server RequestM CodeAction /-- Return the syntax stack leading to `target` from `root`, if one exists. -/ def findStack? (root target : Syntax) : Option Syntax.Stack := do diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 383a6c2088..052c242e01 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -49,6 +49,7 @@ theorem fdiv_eq_ediv : ∀ (a : Int) {b : Int}, 0 ≤ b → fdiv a b = a / b theorem div_eq_ediv : ∀ {a b : Int}, 0 ≤ a → 0 ≤ b → a.div b = a / b | 0, _, _, _ | _, 0, _, _ => by simp | succ _, succ _, _, _ => rfl + | _, _, _, _ => sorry -- FIXME regression on nightly-2024-02-26, shouldn't be needed theorem fdiv_eq_div {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = div a b := div_eq_ediv Ha Hb ▸ fdiv_eq_ediv _ Hb @@ -286,6 +287,7 @@ theorem emod_two_eq (x : Int) : x % 2 = 0 ∨ x % 2 = 1 := by match x % 2, h₁, h₂ with | 0, _, _ => simp | 1, _, _ => simp + | _, _, _ => sorry -- FIXME regression on nightly-2024-02-26, shouldn't be needed theorem mod_add_div' (m k : Int) : mod m k + m.div k * k = m := by rw [Int.mul_comm]; apply mod_add_div diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 443ec4e28a..92c142c529 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -449,6 +449,7 @@ theorem sign_eq_neg_one_of_neg {a : Int} (h : a < 0) : sign a = -1 := theorem eq_zero_of_sign_eq_zero : ∀ {a : Int}, sign a = 0 → a = 0 | 0, _ => rfl + | _, _ => sorry -- regression on nightly-2024-02-26, this branch shouldn't be needed. theorem pos_of_sign_eq_one : ∀ {a : Int}, sign a = 1 → 0 < a | (_ + 1 : Nat), _ => ofNat_lt.2 (Nat.succ_pos _) diff --git a/Std/Lean/Expr.lean b/Std/Lean/Expr.lean index 2367af3892..20338d3424 100644 --- a/Std/Lean/Expr.lean +++ b/Std/Lean/Expr.lean @@ -40,12 +40,6 @@ def lambdaArity : Expr → Nat | lam _ _ b _ => 1 + lambdaArity b | _ => 0 -/-- Like `getAppFn` but ignores metadata. -/ -def getAppFn' : Expr → Expr - | mdata _ b => getAppFn' b - | app f _ => getAppFn' f - | e => e - /-- Like `getAppNumArgs` but ignores metadata. -/ def getAppNumArgs' (e : Expr) : Nat := go e 0 @@ -104,24 +98,11 @@ def getRevArgD' : Expr → Nat → Expr → Expr | app f _ , i+1, v => getRevArgD' f i v | _ , _ , v => v -/-- Like `getRevArg!` but ignores metadata. -/ -@[inline] -def getRevArg!' : Expr → Nat → Expr - | mdata _ b, n => getRevArg!' b n - | app _ a , 0 => a - | app f _ , i+1 => getRevArg!' f i - | _ , _ => panic! "invalid index" - /-- Like `getArgD` but ignores metadata. -/ @[inline] def getArgD' (e : Expr) (i : Nat) (v₀ : Expr) (n := e.getAppNumArgs') : Expr := getRevArgD' e (n - i - 1) v₀ -/-- Like `getArg!` but ignores metadata. -/ -@[inline] -def getArg!' (e : Expr) (i : Nat) (n := e.getAppNumArgs') : Expr := - getRevArg!' e (n - i - 1) - /-- Like `isAppOf` but ignores metadata. -/ def isAppOf' (e : Expr) (n : Name) : Bool := match e.getAppFn' with diff --git a/Std/Tactic/GuardMsgs.lean b/Std/Tactic/GuardMsgs.lean deleted file mode 100644 index f0f3ab7568..0000000000 --- a/Std/Tactic/GuardMsgs.lean +++ /dev/null @@ -1,194 +0,0 @@ -/- -Copyright (c) 2023 Kyle Miller. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kyle Miller --/ -import Std.CodeAction.Attr -import Std.Lean.Position - -/-! `#guard_msgs` command for testing commands - -This module defines a command to test that another command produces the expected messages. -See the docstring on the `#guard_msgs` command. --/ - -open Lean Parser.Tactic Elab Command - -namespace Std.Tactic.GuardMsgs - -/-- Element that can be part of a `#guard_msgs` specification. -/ -syntax guardMsgsSpecElt := &"drop"? (&"info" <|> &"warning" <|> &"error" <|> &"all") - -/-- Specification for `#guard_msgs` command. -/ -syntax guardMsgsSpec := "(" guardMsgsSpecElt,* ")" - -/-- -`#guard_msgs` captures the messages generated by another command and checks that they -match the contents of the docstring attached to the `#guard_msgs` command. - -Basic example: -```lean -/-- -error: unknown identifier 'x' --/ -#guard_msgs in -example : α := x -``` -This checks that there is such an error and then consumes the message entirely. - -By default, the command intercepts all messages, but there is a way to specify which types -of messages to consider. For example, we can select only warnings: -```lean -/-- -warning: declaration uses 'sorry' --/ -#guard_msgs(warning) in -example : α := sorry -``` -or only errors -```lean -#guard_msgs(error) in -example : α := sorry -``` -In this last example, since the message is not intercepted there is a warning on `sorry`. -We can drop the warning completely with -```lean -#guard_msgs(error, drop warning) in -example : α := sorry -``` - -Syntax description: -``` -#guard_msgs (drop? info|warning|error|all,*)? in cmd -``` - -If there is no specification, `#guard_msgs` intercepts all messages. -Otherwise, if there is one, the specification is considered in left-to-right order, and the first -that applies chooses the outcome of the message: -- `info`, `warning`, `error`: intercept a message with the given severity level. -- `all`: intercept any message (so `#guard_msgs in cmd` and `#guard_msgs (all) in cmd` - are equivalent). -- `drop info`, `drop warning`, `drop error`: intercept a message with the given severity - level and then drop it. These messages are not checked. -- `drop all`: intercept a message and drop it. - -For example, `#guard_msgs (error, drop all) in cmd` means to check warnings and then drop -everything else. --/ -syntax (name := guardMsgsCmd) - (docComment)? "#guard_msgs" (ppSpace guardMsgsSpec)? " in" ppLine command : command - -/-- Gives a string representation of a message without source position information. -Ensures the message ends with a '\n'. -/ -private def messageToStringWithoutPos (msg : Message) : IO String := do - let mut str ← msg.data.toString - unless msg.caption == "" do - str := msg.caption ++ ":\n" ++ str - match msg.severity with - | MessageSeverity.information => str := "info: " ++ str - | MessageSeverity.warning => str := "warning: " ++ str - | MessageSeverity.error => str := "error: " ++ str - if str.isEmpty || str.back != '\n' then - str := str ++ "\n" - return str - -/-- The decision made by a specification for a message. -/ -inductive SpecResult - /-- Capture the message and check it matches the docstring. -/ - | check - /-- Drop the message and delete it. -/ - | drop - /-- Do not capture the message. -/ - | passthrough - -/-- Parses a `guardMsgsSpec`. -- No specification: check everything. -- With a specification: interpret the spec, and if nothing applies pass it through. -/ -def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) : - CommandElabM (Message → SpecResult) := do - if let some spec := spec? then - match spec with - | `(guardMsgsSpec| ($[$elts:guardMsgsSpecElt],*)) => do - let mut p : Message → SpecResult := fun _ => .passthrough - let pushP (s : MessageSeverity) (drop : Bool) (p : Message → SpecResult) - (msg : Message) : SpecResult := - if msg.severity == s then if drop then .drop else .check - else p msg - for elt in elts.reverse do - match elt with - | `(guardMsgsSpecElt| $[drop%$drop?]? info) => p := pushP .information drop?.isSome p - | `(guardMsgsSpecElt| $[drop%$drop?]? warning) => p := pushP .warning drop?.isSome p - | `(guardMsgsSpecElt| $[drop%$drop?]? error) => p := pushP .error drop?.isSome p - | `(guardMsgsSpecElt| $[drop%$drop?]? all) => - p := fun _ => if drop?.isSome then .drop else .check - | _ => throwErrorAt elt "Invalid #guard_msgs specification element" - return p - | _ => throwErrorAt spec "Invalid #guard_msgs specification" - else - return fun _ => .check - -/-- An info tree node corresponding to a failed `#guard_msgs` invocation, -used for code action support. -/ -structure GuardMsgFailure where - /-- The result of the nested command -/ - res : String - deriving TypeName - -elab_rules : command - | `(command| $[$dc?:docComment]? #guard_msgs%$tk $(spec?)? in $cmd) => do - let expected : String := (← dc?.mapM (getDocStringText ·)).getD "" |>.trim - let specFn ← parseGuardMsgsSpec spec? - let initMsgs ← modifyGet fun st => (st.messages, { st with messages := {} }) - elabCommandTopLevel cmd - let msgs := (← get).messages - let mut toCheck : MessageLog := .empty - let mut toPassthrough : MessageLog := .empty - for msg in msgs.toList do - match specFn msg with - | .check => toCheck := toCheck.add msg - | .drop => pure () - | .passthrough => toPassthrough := toPassthrough.add msg - let res := "---\n".intercalate (← toCheck.toList.mapM (messageToStringWithoutPos ·)) |>.trim - -- We do some whitespace normalization here to allow users to break long lines. - if expected.replace "\n" " " == res.replace "\n" " " then - -- Passed. Only put toPassthrough messages back on the message log - modify fun st => { st with messages := initMsgs ++ toPassthrough } - else - -- Failed. Put all the messages back on the message log and add an error - modify fun st => { st with messages := initMsgs ++ msgs } - logErrorAt tk m!"❌ Docstring on `#guard_msgs` does not match generated message:\n\n{res}" - pushInfoLeaf (.ofCustomInfo { stx := ← getRef, value := Dynamic.mk (GuardMsgFailure.mk res) }) - -open CodeAction Server RequestM in -/-- A code action which will update the doc comment on a `#guard_msgs` invocation. -/ -@[command_code_action guardMsgsCmd] -def guardMsgsCodeAction : CommandCodeAction := fun _ _ _ node => do - let .node _ ts := node | return #[] - let res := ts.findSome? fun - | .node (.ofCustomInfo { stx, value }) _ => return (stx, (← value.get? GuardMsgFailure).res) - | _ => none - let some (stx, res) := res | return #[] - let doc ← readDoc - let eager := { - title := "Update #guard_msgs with tactic output" - kind? := "quickfix" - isPreferred? := true - } - pure #[{ - eager - lazy? := some do - let some start := stx.getPos? true | return eager - let some tail := stx.setArg 0 mkNullNode |>.getPos? true | return eager - let newText := if res.isEmpty then - "" - else if res.length ≤ 100-7 && !res.contains '\n' then -- TODO: configurable line length? - s!"/-- {res} -/\n" - else - s!"/--\n{res}\n-/\n" - pure { eager with - edit? := some <|.ofTextEdit doc.versionedIdentifier { - range := doc.meta.text.utf8RangeToLspRange ⟨start, tail⟩ - newText - } - } - }] diff --git a/test/MLList.lean b/test/MLList.lean index eaf14cbc04..8473b08e8b 100644 --- a/test/MLList.lean +++ b/test/MLList.lean @@ -1,5 +1,4 @@ import Std.Data.MLList.IO -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/absurd.lean b/test/absurd.lean index dd0d4af4f8..9efe145830 100644 --- a/test/absurd.lean +++ b/test/absurd.lean @@ -1,5 +1,4 @@ import Std.Tactic.Basic -import Std.Tactic.GuardMsgs /-! Tests for `absurd` tactic -/ diff --git a/test/add_suggestion.lean b/test/add_suggestion.lean index 6604c092d9..c86c6a4c95 100644 --- a/test/add_suggestion.lean +++ b/test/add_suggestion.lean @@ -1,5 +1,4 @@ import Lean.Meta.Tactic.TryThis -import Std.Tactic.GuardMsgs set_option linter.unusedVariables false set_option linter.missingDocs false diff --git a/test/alias.lean b/test/alias.lean index 1f3e2e7dbe..0b8e125329 100644 --- a/test/alias.lean +++ b/test/alias.lean @@ -1,5 +1,4 @@ import Std.Tactic.Alias -import Std.Tactic.GuardMsgs set_option linter.unusedVariables false set_option linter.missingDocs false diff --git a/test/case.lean b/test/case.lean index 78b6fe5f43..f0bb9d9b5e 100644 --- a/test/case.lean +++ b/test/case.lean @@ -1,5 +1,4 @@ import Std.Tactic.Case -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/coe.lean b/test/coe.lean index 6a52129da0..2edede07ff 100644 --- a/test/coe.lean +++ b/test/coe.lean @@ -1,4 +1,4 @@ -import Std.Tactic.GuardMsgs +import Lean.Meta.CoeAttr set_option linter.missingDocs false diff --git a/test/conv_equals.lean b/test/conv_equals.lean index f646192acd..95ff7354f8 100644 --- a/test/conv_equals.lean +++ b/test/conv_equals.lean @@ -5,7 +5,6 @@ Authors: Joachim Breitner -/ import Std.Tactic.Basic -import Std.Tactic.GuardMsgs -- The example from the doc string, for quick comparision -- and keeping the doc up-to-date diff --git a/test/ext.lean b/test/ext.lean index 3e00798a7c..84f718d12f 100644 --- a/test/ext.lean +++ b/test/ext.lean @@ -1,5 +1,4 @@ import Std.Logic -import Std.Tactic.GuardMsgs set_option linter.missingDocs false axiom mySorry {α : Sort _} : α diff --git a/test/guard_msgs.lean b/test/guard_msgs.lean index 5a6b77e282..96d89f5aaa 100644 --- a/test/guard_msgs.lean +++ b/test/guard_msgs.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs #guard_msgs in /-- error: unknown identifier 'x' -/ diff --git a/test/instances.lean b/test/instances.lean index 220630ee12..ed1fd9698a 100644 --- a/test/instances.lean +++ b/test/instances.lean @@ -1,5 +1,4 @@ import Std.Tactic.Instances -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/isIndependentOf.lean b/test/isIndependentOf.lean index 7d0bff1c89..6ff9720bbf 100644 --- a/test/isIndependentOf.lean +++ b/test/isIndependentOf.lean @@ -1,6 +1,5 @@ import Std.Lean.Meta.Basic import Std.Tactic.PermuteGoals -import Std.Tactic.GuardMsgs import Lean.Meta.Tactic.IndependentOf open Lean Meta Elab.Tactic diff --git a/test/json.lean b/test/json.lean index 63df684c34..8755ab9126 100644 --- a/test/json.lean +++ b/test/json.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs import Lean.Data.Json.Elab /-- info: {"lookACalc": 131, diff --git a/test/kmp_matcher.lean b/test/kmp_matcher.lean index 600878c7e3..1b46841033 100644 --- a/test/kmp_matcher.lean +++ b/test/kmp_matcher.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs import Std.Data.String.Basic /-! Tests for Knuth-Morris-Pratt matching algorithm -/ diff --git a/test/left_right.lean b/test/left_right.lean index fcff731b06..cf65bee79c 100644 --- a/test/left_right.lean +++ b/test/left_right.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs /-- Construct a natural number using `left`. -/ def zero : Nat := by diff --git a/test/lintTC.lean b/test/lintTC.lean index c24a1faf0a..937f4ca4e7 100644 --- a/test/lintTC.lean +++ b/test/lintTC.lean @@ -1,5 +1,5 @@ import Std.Tactic.Lint.TypeClass -import Std.Tactic.GuardMsgs +import Lean.Elab.Command open Std.Tactic.Lint namespace A diff --git a/test/lint_unreachableTactic.lean b/test/lint_unreachableTactic.lean index 00501d85ae..86938a12f9 100644 --- a/test/lint_unreachableTactic.lean +++ b/test/lint_unreachableTactic.lean @@ -1,5 +1,4 @@ import Std.Linter.UnreachableTactic -import Std.Tactic.GuardMsgs /-- warning: this tactic is never executed [linter.unreachableTactic] -/ #guard_msgs in diff --git a/test/lintsimp.lean b/test/lintsimp.lean index 9dd0815d36..41bd091192 100644 --- a/test/lintsimp.lean +++ b/test/lintsimp.lean @@ -1,5 +1,4 @@ import Std.Tactic.Lint -import Std.Tactic.GuardMsgs open Std.Tactic.Lint set_option linter.missingDocs false diff --git a/test/lintunused.lean b/test/lintunused.lean index a917c0e9e6..b236ec97ea 100644 --- a/test/lintunused.lean +++ b/test/lintunused.lean @@ -1,5 +1,4 @@ import Std.Tactic.Lint -import Std.Tactic.GuardMsgs -- should be ignored as the proof contains sorry /-- warning: declaration uses 'sorry' -/ diff --git a/test/nondet.lean b/test/nondet.lean index 3bc2d94856..66f3022e08 100644 --- a/test/nondet.lean +++ b/test/nondet.lean @@ -1,5 +1,4 @@ import Std.Control.Nondet.Basic -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/print_prefix.lean b/test/print_prefix.lean index a80badc41b..9f742b382a 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -1,5 +1,4 @@ import Std.Tactic.PrintPrefix -import Std.Tactic.GuardMsgs inductive TEmpty : Type /-- diff --git a/test/register_label_attr.lean b/test/register_label_attr.lean index 9b0e66c846..c10279bd18 100644 --- a/test/register_label_attr.lean +++ b/test/register_label_attr.lean @@ -1,5 +1,4 @@ import Std.Test.Internal.DummyLabelAttr -import Std.Tactic.GuardMsgs import Lean.LabelAttribute set_option linter.missingDocs false diff --git a/test/repeat.lean b/test/repeat.lean index 009fd16841..276e283f8f 100644 --- a/test/repeat.lean +++ b/test/repeat.lean @@ -1,5 +1,4 @@ import Std.Tactic.Basic -import Std.Tactic.GuardMsgs open Lean Elab Tactic Meta diff --git a/test/run_cmd.lean b/test/run_cmd.lean index acb2e24065..a3b649e5e0 100644 --- a/test/run_cmd.lean +++ b/test/run_cmd.lean @@ -1,5 +1,5 @@ import Lean.Elab.Tactic.ElabTerm -import Std.Tactic.GuardMsgs +import Lean.Elab.Command open Lean Elab Tactic diff --git a/test/show_term.lean b/test/show_term.lean index 25b6aacb1d..922e034238 100644 --- a/test/show_term.lean +++ b/test/show_term.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Tactic.ShowTerm -import Std.Tactic.GuardMsgs /-- info: Try this: exact (n, 37) -/ #guard_msgs in example (n : Nat) : Nat × Nat := by diff --git a/test/simp_trace.lean b/test/simp_trace.lean index 2e700e2fae..b3cefc454c 100644 --- a/test/simp_trace.lean +++ b/test/simp_trace.lean @@ -1,5 +1,4 @@ import Std.Tactic.SqueezeScope -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/simpa.lean b/test/simpa.lean index fe1b4e702d..065e3b8328 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Gabriel Ebner -/ import Std.Tactic.ShowTerm -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/tryThis.lean b/test/tryThis.lean index e616193b62..c17a64c287 100644 --- a/test/tryThis.lean +++ b/test/tryThis.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 Thomas Murrills. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Murrills -/ -import Std.Tactic.GuardMsgs import Lean.Meta.Tactic.TryThis open Lean.Meta.Tactic.TryThis diff --git a/test/where.lean b/test/where.lean index 5ec9cc4300..8c005997ca 100644 --- a/test/where.lean +++ b/test/where.lean @@ -1,5 +1,4 @@ import Std.Tactic.Where -import Std.Tactic.GuardMsgs -- Return to pristine state set_option linter.missingDocs false From faf712980ca96aec281c76c00c80a1018718cdf9 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 27 Feb 2024 12:04:33 +1100 Subject: [PATCH 095/213] chore: adaptations for nightly-2024-02-22 (#668) --- Std.lean | 12 - Std/Classes/Order.lean | 1 - Std/Classes/SetNotation.lean | 28 - Std/Data/Array/Lemmas.lean | 1 - Std/Data/BitVec.lean | 4 - Std/Data/BitVec/Basic.lean | 533 ----------------- Std/Data/BitVec/Bitblast.lean | 172 ------ Std/Data/BitVec/Folds.lean | 57 -- Std/Data/BitVec/Lemmas.lean | 524 ---------------- Std/Data/BitVec/Simprocs.lean | 283 --------- Std/Data/Fin/Lemmas.lean | 823 +------------------------- Std/Data/Int/Gcd.lean | 1 - Std/Data/List/Basic.lean | 23 +- Std/Data/List/Lemmas.lean | 37 -- Std/Data/Nat.lean | 1 - Std/Data/Nat/Basic.lean | 9 - Std/Data/Nat/Bitwise.lean | 497 ---------------- Std/Data/Rat/Lemmas.lean | 1 - Std/Data/String/Lemmas.lean | 1 - Std/Data/Sum/Basic.lean | 10 - Std/Lean/Meta/Basic.lean | 122 ---- Std/Lean/Meta/Iterator.lean | 69 --- Std/Lean/Parser.lean | 37 -- Std/Tactic/Basic.lean | 1 - Std/Tactic/LabelAttr.lean | 95 --- Std/Tactic/LibrarySearch.lean | 7 +- Std/Tactic/NormCast.lean | 349 ----------- Std/Tactic/NormCast/Ext.lean | 219 ------- Std/Tactic/NormCast/Lemmas.lean | 18 - Std/Tactic/Relation/Symm.lean | 119 ---- Std/Tactic/SimpTrace.lean | 123 ---- Std/Tactic/Simpa.lean | 117 ---- Std/Tactic/SolveByElim.lean | 564 ------------------ Std/Tactic/SolveByElim/Backtrack.lean | 205 ------- Std/Tactic/SqueezeScope.lean | 4 +- Std/Test/Internal/DummyLabelAttr.lean | 2 +- Std/Util/CheckTactic.lean | 69 ++- lean-toolchain | 2 +- test/array.lean | 7 +- test/ext.lean | 1 - test/isIndependentOf.lean | 1 + test/norm_cast.lean | 1 - test/register_label_attr.lean | 3 +- test/simpa.lean | 1 - test/solve_by_elim.lean | 4 +- test/symm.lean | 2 +- 46 files changed, 81 insertions(+), 5079 deletions(-) delete mode 100644 Std/Classes/SetNotation.lean delete mode 100644 Std/Data/BitVec/Basic.lean delete mode 100644 Std/Data/BitVec/Bitblast.lean delete mode 100644 Std/Data/BitVec/Folds.lean delete mode 100644 Std/Data/BitVec/Simprocs.lean delete mode 100644 Std/Data/Nat/Bitwise.lean delete mode 100644 Std/Lean/Meta/Iterator.lean delete mode 100644 Std/Lean/Parser.lean delete mode 100644 Std/Tactic/LabelAttr.lean delete mode 100644 Std/Tactic/NormCast.lean delete mode 100644 Std/Tactic/NormCast/Ext.lean delete mode 100644 Std/Tactic/NormCast/Lemmas.lean delete mode 100644 Std/Tactic/Relation/Symm.lean delete mode 100644 Std/Tactic/SimpTrace.lean delete mode 100644 Std/Tactic/Simpa.lean delete mode 100644 Std/Tactic/SolveByElim.lean delete mode 100644 Std/Tactic/SolveByElim/Backtrack.lean diff --git a/Std.lean b/Std.lean index 1b2cb1e4d1..c43ddd2ea4 100644 --- a/Std.lean +++ b/Std.lean @@ -3,7 +3,6 @@ import Std.Classes.Cast import Std.Classes.Order import Std.Classes.RatCast import Std.Classes.SatisfiesM -import Std.Classes.SetNotation import Std.CodeAction import Std.CodeAction.Attr import Std.CodeAction.Basic @@ -54,7 +53,6 @@ import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.Expr import Std.Lean.Meta.Inaccessible import Std.Lean.Meta.InstantiateMVars -import Std.Lean.Meta.Iterator import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Meta.SavedState import Std.Lean.Meta.Simp @@ -63,7 +61,6 @@ import Std.Lean.MonadBacktrack import Std.Lean.Name import Std.Lean.NameMap import Std.Lean.NameMapAttribute -import Std.Lean.Parser import Std.Lean.PersistentHashMap import Std.Lean.PersistentHashSet import Std.Lean.Position @@ -87,7 +84,6 @@ import Std.Tactic.FalseOrByContra import Std.Tactic.GuardMsgs import Std.Tactic.Init import Std.Tactic.Instances -import Std.Tactic.LabelAttr import Std.Tactic.LibrarySearch import Std.Tactic.Lint import Std.Tactic.Lint.Basic @@ -96,21 +92,13 @@ import Std.Tactic.Lint.Misc import Std.Tactic.Lint.Simp import Std.Tactic.Lint.TypeClass import Std.Tactic.NoMatch -import Std.Tactic.NormCast -import Std.Tactic.NormCast.Ext -import Std.Tactic.NormCast.Lemmas import Std.Tactic.OpenPrivate import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix import Std.Tactic.Relation.Rfl -import Std.Tactic.Relation.Symm import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm -import Std.Tactic.SimpTrace -import Std.Tactic.Simpa -import Std.Tactic.SolveByElim -import Std.Tactic.SolveByElim.Backtrack import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable import Std.Tactic.Where diff --git a/Std/Classes/Order.lean b/Std/Classes/Order.lean index f92e96c0dd..fcf0e23bf0 100644 --- a/Std/Classes/Order.lean +++ b/Std/Classes/Order.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Std.Tactic.Simpa /-! ## Ordering -/ diff --git a/Std/Classes/SetNotation.lean b/Std/Classes/SetNotation.lean deleted file mode 100644 index 977e1e3df3..0000000000 --- a/Std/Classes/SetNotation.lean +++ /dev/null @@ -1,28 +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 --/ - -/-- -`{ a, b, c }` is a set with elements `a`, `b`, and `c`. - -This notation works for all types that implement `Insert` and `Singleton`. --/ -syntax "{" term,+ "}" : term - -macro_rules - | `({$x:term}) => `(singleton $x) - | `({$x:term, $xs:term,*}) => `(insert $x {$xs:term,*}) - -/-- Unexpander for the `{ x }` notation. -/ -@[app_unexpander singleton] -def singletonUnexpander : Lean.PrettyPrinter.Unexpander - | `($_ $a) => `({ $a:term }) - | _ => throw () - -/-- Unexpander for the `{ x, y, ... }` notation. -/ -@[app_unexpander insert] -def insertUnexpander : Lean.PrettyPrinter.Unexpander - | `($_ $a { $ts:term,* }) => `({$a:term, $ts,*}) - | _ => throw () diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 40a055b66b..330f553080 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -9,7 +9,6 @@ import Std.Data.List.Lemmas import Std.Data.Array.Init.Lemmas import Std.Data.Array.Basic import Std.Tactic.SeqFocus -import Std.Tactic.Simpa import Std.Util.ProofWanted local macro_rules | `($x[$i]'$h) => `(getElem $x $i $h) diff --git a/Std/Data/BitVec.lean b/Std/Data/BitVec.lean index 3448b2d7c2..2df74a3107 100644 --- a/Std/Data/BitVec.lean +++ b/Std/Data/BitVec.lean @@ -1,5 +1 @@ -import Std.Data.BitVec.Basic -import Std.Data.BitVec.Bitblast -import Std.Data.BitVec.Folds import Std.Data.BitVec.Lemmas -import Std.Data.BitVec.Simprocs diff --git a/Std/Data/BitVec/Basic.lean b/Std/Data/BitVec/Basic.lean deleted file mode 100644 index 6c8d2f2944..0000000000 --- a/Std/Data/BitVec/Basic.lean +++ /dev/null @@ -1,533 +0,0 @@ -/- -Copyright (c) 2022 by the authors listed in the file AUTHORS and their -institutional affiliations. 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 --/ -import Std.Data.Nat.Bitwise -import Std.Tactic.Alias - -namespace Std - -/-! -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). -of SMT-LIBv2. --/ - -/-- -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) - deriving DecidableEq - -namespace BitVec - -/-- `cast eq i` embeds `i` into an equal `BitVec` type. -/ -@[inline] def cast (eq : n = m) (i : BitVec n) : BitVec m := - .ofFin (Fin.cast (congrArg _ eq) i.toFin) - -/-- The `BitVec` with value `i mod 2^n`. Treated as an operation on bitvectors, -this is truncation of the high bits when downcasting and zero-extension when upcasting. -/ -protected def ofNat (n : Nat) (i : Nat) : BitVec n where - toFin := Fin.ofNat' i (Nat.two_pow_pos n) - -instance : NatCast (BitVec w) := ⟨BitVec.ofNat w⟩ - -/-- Given a bitvector `a`, return the underlying `Nat`. This is O(1) because `BitVec` is a -(zero-cost) wrapper around a `Nat`. -/ -protected def toNat (a : BitVec n) : Nat := a.toFin.val - -/-- Return the bound in terms of toNat. -/ -theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt - -/-- Return the `i`-th least significant bit or `false` if `i ≥ w`. -/ -@[inline] def getLsb (x : BitVec w) (i : Nat) : Bool := x.toNat.testBit i - -/-- Return the `i`-th most significant bit or `false` if `i ≥ w`. -/ -@[inline] def getMsb (x : BitVec w) (i : Nat) : Bool := i < w && getLsb x (w-1-i) - -/-- Return most-significant bit in bitvector. -/ -@[inline] protected def msb (a : BitVec n) : Bool := getMsb a 0 - -/-- Interpret the bitvector as an integer stored in two's complement form. -/ -protected def toInt (a : BitVec n) : Int := - if a.msb then Int.ofNat a.toNat - Int.ofNat (2^n) else a.toNat - -/-- Return a bitvector `0` of size `n`. This is the bitvector with all zero bits. -/ -protected def zero (n : Nat) : BitVec n := ⟨0, Nat.two_pow_pos n⟩ - -instance : Inhabited (BitVec n) where default := .zero n - -instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i - -/-- Notation for bit vector literals. `i#n` is a shorthand for `BitVec.ofNat n i`. -/ -scoped syntax:max term:max noWs "#" noWs term:max : term -macro_rules | `($i#$n) => `(BitVec.ofNat $n $i) - -/- Support for `i#n` notation in patterns. -/ -attribute [match_pattern] BitVec.ofNat - -/-- Unexpander for bit vector literals. -/ -@[app_unexpander BitVec.ofNat] def unexpandBitVecOfNat : Lean.PrettyPrinter.Unexpander - | `($(_) $n $i) => `($i#$n) - | _ => throw () - -/-- Convert bitvector into a fixed-width hex number. -/ -protected def toHex {n : Nat} (x : BitVec n) : String := - let s := (Nat.toDigits 16 x.toNat).asString - let t := (List.replicate ((n+3) / 4 - s.length) '0').asString - t ++ s - -instance : Repr (BitVec n) where reprPrec a _ := "0x" ++ (a.toHex : Format) ++ "#" ++ repr n - -instance : ToString (BitVec n) where toString a := toString (repr a) - -/-- Theorem for normalizing the bit vector literal representation. -/ --- TODO: This needs more usage data to assess which direction the simp should go. -@[simp] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = BitVec.ofNat n i := rfl -@[simp] theorem natCast_eq_ofNat : Nat.cast x = x#w := rfl - -/-- -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 where toFin := x.toFin + y.toFin -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 where toFin := x.toFin - y.toFin -instance : Sub (BitVec n) := ⟨BitVec.sub⟩ - -/-- -Negation for bit vectors. This can be interpreted as either signed or unsigned negation -modulo `2^n`. - -SMT-Lib name: `bvneg`. --/ -protected def neg (x : BitVec n) : BitVec n := .sub 0 x -instance : Neg (BitVec n) := ⟨.neg⟩ - -/-- Bit vector of size `n` where all bits are `1`s -/ -def allOnes (n : Nat) : BitVec n := -1 - -/-- -Return the absolute value of a signed bitvector. --/ -protected def abs (s : BitVec n) : BitVec n := if s.msb then .neg s else s - -/-- -Multiplication for bit vectors. This can be interpreted as either signed or unsigned negation -modulo `2^n`. - -SMT-Lib name: `bvmul`. --/ -protected def mul (x y : BitVec n) : BitVec n := ofFin <| x.toFin * y.toFin -instance : Mul (BitVec n) := ⟨.mul⟩ - -/-- -Unsigned division for bit vectors using the Lean convention where division by zero returns zero. --/ -def udiv (x y : BitVec n) : BitVec n := ofFin <| x.toFin / y.toFin -instance : Div (BitVec n) := ⟨.udiv⟩ - -/-- -Unsigned modulo for bit vectors. - -SMT-Lib name: `bvurem`. --/ -def umod (x y : BitVec n) : BitVec n := ofFin <| x.toFin % y.toFin -instance : Mod (BitVec n) := ⟨.umod⟩ - -/-- -Unsigned division for bit vectors using the -[SMT-Lib convention](http://smtlib.cs.uiowa.edu/theories-FixedSizeBitVectors.shtml) -where division by zero returns the `allOnes` bitvector. - -SMT-Lib name: `bvudiv`. --/ -def smtUDiv (x y : BitVec n) : BitVec n := if y = 0 then -1 else .udiv x y - -/-- -Signed t-division for bit vectors using the Lean convention where division -by zero returns zero. - -```lean -sdiv 7#4 2 = 3#4 -sdiv (-9#4) 2 = -4#4 -sdiv 5#4 -2 = -2#4 -sdiv (-7#4) (-2) = 3#4 -``` --/ -def sdiv (s t : BitVec n) : BitVec n := - match s.msb, t.msb with - | false, false => udiv s t - | false, true => .neg (udiv s (.neg t)) - | true, false => .neg (udiv (.neg s) t) - | true, true => udiv (.neg s) (.neg t) - -/-- -Signed division for bit vectors using SMTLIB rules for division by zero. - -Specifically, `smtSDiv x 0 = if x >= 0 then -1 else 1` - -SMT-Lib name: `bvsdiv`. --/ -def smtSDiv (s t : BitVec n) : BitVec n := - match s.msb, t.msb with - | false, false => smtUDiv s t - | false, true => .neg (smtUDiv s (.neg t)) - | true, false => .neg (smtUDiv (.neg s) t) - | true, true => smtUDiv (.neg s) (.neg t) - -/-- -Remainder for signed division rounding to zero. - -SMT_Lib name: `bvsrem`. --/ -def srem (s t : BitVec n) : BitVec n := - match s.msb, t.msb with - | false, false => umod s t - | false, true => umod s (.neg t) - | true, false => .neg (umod (.neg s) t) - | true, true => .neg (umod (.neg s) (.neg t)) - -/-- -Remainder for signed division rounded to negative infinity. - -SMT_Lib name: `bvsmod`. --/ -def smod (s t : BitVec m) : BitVec m := - match s.msb, t.msb with - | false, false => .umod s t - | false, true => - let u := .umod s (.neg t) - (if u = BitVec.ofNat m 0 then u else .add u t) - | true, false => - let u := .umod (.neg s) t - (if u = BitVec.ofNat m 0 then u else .sub t u) - | true, true => .neg (.umod (.neg s) (.neg t)) - -/-- -Unsigned less-than for bit vectors. - -SMT-Lib name: `bvult`. --/ -protected def ult (x y : BitVec n) : Bool := x.toFin < y.toFin -instance : LT (BitVec n) where lt x y := x.toFin < y.toFin -instance (x y : BitVec n) : Decidable (x < y) := - inferInstanceAs (Decidable (x.toFin < y.toFin)) - -/-- -Unsigned less-than-or-equal-to for bit vectors. - -SMT-Lib name: `bvule`. --/ -protected def ule (x y : BitVec n) : Bool := x.toFin ≤ y.toFin - -instance : LE (BitVec n) where le x y := x.toFin ≤ y.toFin -instance (x y : BitVec n) : Decidable (x ≤ y) := - inferInstanceAs (Decidable (x.toFin ≤ y.toFin)) - -/-- -Signed less-than for bit vectors. - -```lean -BitVec.slt 6#4 7 = true -BitVec.slt 7#4 8 = false -``` -SMT-Lib name: `bvslt`. --/ -protected def slt (x y : BitVec n) : Bool := x.toInt < y.toInt - -/-- -Signed less-than-or-equal-to for bit vectors. - -SMT-Lib name: `bvsle`. --/ -protected def sle (x y : BitVec n) : Bool := x.toInt ≤ y.toInt - -/-- -Bitwise AND for bit vectors. - -```lean -0b1010#4 &&& 0b0110#4 = 0b0010#4 -``` - -SMT-Lib name: `bvand`. --/ -protected def and (x y : BitVec n) : BitVec n where toFin := - ⟨x.toNat &&& y.toNat, Nat.and_lt_two_pow x.toNat y.isLt⟩ -instance : AndOp (BitVec w) := ⟨.and⟩ - -/-- -Bitwise OR for bit vectors. - -```lean -0b1010#4 ||| 0b0110#4 = 0b1110#4 -``` - -SMT-Lib name: `bvor`. --/ -protected def or (x y : BitVec n) : BitVec n where toFin := - ⟨x.toNat ||| y.toNat, Nat.or_lt_two_pow x.isLt y.isLt⟩ -instance : OrOp (BitVec w) := ⟨.or⟩ - -/-- - Bitwise XOR for bit vectors. - -```lean -0b1010#4 ^^^ 0b0110#4 = 0b1100#4 -``` - -SMT-Lib name: `bvxor`. --/ -protected def xor (x y : BitVec n) : BitVec n where toFin := - ⟨x.toNat ^^^ y.toNat, Nat.xor_lt_two_pow x.isLt y.isLt⟩ -instance : Xor (BitVec w) := ⟨.xor⟩ - -/-- -Bitwise NOT for bit vectors. - -```lean -~~~(0b0101#4) == 0b1010 -``` -SMT-Lib name: `bvnot`. --/ -protected def not (x : BitVec n) : BitVec n := - allOnes n ^^^ x -instance : Complement (BitVec w) := ⟨.not⟩ - -/-- The `BitVec` with value `(2^n + (i mod 2^n)) mod 2^n`. -/ -protected def ofInt (n : Nat) (i : Int) : BitVec n := - match i with - | Int.ofNat a => .ofNat n a - | Int.negSucc a => ~~~.ofNat n a - -instance : IntCast (BitVec w) := ⟨BitVec.ofInt w⟩ - -/-- -Left shift for bit vectors. The low bits are filled with zeros. As a numeric operation, this is -equivalent to `a * 2^s`, modulo `2^n`. - -SMT-Lib name: `bvshl` except this operator uses a `Nat` shift value. --/ -protected def shiftLeft (a : BitVec n) (s : Nat) : BitVec n := .ofNat n (a.toNat <<< s) -instance : HShiftLeft (BitVec w) Nat (BitVec w) := ⟨.shiftLeft⟩ - -/-- -(Logical) right shift for bit vectors. The high bits are filled with zeros. -As a numeric operation, this is equivalent to `a / 2^s`, rounding down. - -SMT-Lib name: `bvlshr` except this operator uses a `Nat` shift value. --/ -def ushiftRight (a : BitVec n) (s : Nat) : BitVec n := - ⟨a.toNat >>> s, by - let ⟨a, lt⟩ := a - simp only [BitVec.toNat, Nat.shiftRight_eq_div_pow, Nat.div_lt_iff_lt_mul (Nat.two_pow_pos s)] - rw [←Nat.mul_one a] - exact Nat.mul_lt_mul_of_lt_of_le' lt (Nat.two_pow_pos s) (Nat.le_refl 1)⟩ - -instance : HShiftRight (BitVec w) Nat (BitVec w) := ⟨.ushiftRight⟩ - -/-- -Arithmetic right shift for bit vectors. The high bits are filled with the -most-significant bit. -As a numeric operation, this is equivalent to `a.toInt >>> s`. - -SMT-Lib name: `bvashr` except this operator uses a `Nat` shift value. --/ -def sshiftRight (a : BitVec n) (s : Nat) : BitVec n := .ofInt n (a.toInt >>> s) - -instance {n} : HShiftLeft (BitVec m) (BitVec n) (BitVec m) := ⟨fun x y => x <<< y.toNat⟩ -instance {n} : HShiftRight (BitVec m) (BitVec n) (BitVec m) := ⟨fun x y => x >>> y.toNat⟩ - -/-- -Rotate left for bit vectors. All the bits of `x` are shifted to higher positions, with the top `n` -bits wrapping around to fill the low bits. - -```lean -rotateLeft 0b0011#4 3 = 0b1001 -``` -SMT-Lib name: `rotate_left` except this operator uses a `Nat` shift amount. --/ -def rotateLeft (x : BitVec w) (n : Nat) : BitVec w := x <<< n ||| x >>> (w - n) - -/-- -Rotate right for bit vectors. All the bits of `x` are shifted to lower positions, with the -bottom `n` bits wrapping around to fill the high bits. - -```lean -rotateRight 0b01001#5 1 = 0b10100 -``` -SMT-Lib name: `rotate_right` except this operator uses a `Nat` shift amount. --/ -def rotateRight (x : BitVec w) (n : Nat) : BitVec w := x >>> n ||| x <<< (w - n) - -/-- -A version of `zeroExtend` that requires a proof, but is a noop. --/ -def zeroExtend' {n w : Nat} (le : n ≤ w) (x : BitVec n) : BitVec w := - ⟨x.toNat, by - apply Nat.lt_of_lt_of_le x.isLt - exact Nat.pow_le_pow_of_le_right (by trivial) le⟩ - -/-- -`shiftLeftZeroExtend x n` returns `zeroExtend (w+n) x <<< n` without -needing to compute `x % 2^(2+n)`. --/ -def shiftLeftZeroExtend (msbs : BitVec w) (m : Nat) : BitVec (w+m) := - let shiftLeftLt {x : Nat} (p : x < 2^w) (m : Nat) : x <<< m < 2^(w+m) := by - simp [Nat.shiftLeft_eq, Nat.pow_add] - apply Nat.mul_lt_mul_of_pos_right p - exact (Nat.two_pow_pos m) - ⟨msbs.toNat <<< m, shiftLeftLt msbs.isLt m⟩ - -/-- -Concatenation of bitvectors. This uses the "big endian" convention that the more significant -input is on the left, so `0xAB#8 ++ 0xCD#8 = 0xABCD#16`. - -SMT-Lib name: `concat`. --/ -def append (msbs : BitVec n) (lsbs : BitVec m) : BitVec (n+m) := - shiftLeftZeroExtend msbs m ||| zeroExtend' (Nat.le_add_left m n) lsbs - -instance : HAppend (BitVec w) (BitVec v) (BitVec (w + v)) := ⟨.append⟩ - -/-- -Extraction of bits `start` to `start + len - 1` from a bit vector of size `n` to yield a -new bitvector of size `len`. If `start + len > n`, then the vector will be zero-padded in the -high bits. --/ -def extractLsb' (start len : Nat) (a : BitVec n) : BitVec len := .ofNat _ (a.toNat >>> start) - -/-- -Extraction of bits `hi` (inclusive) down to `lo` (inclusive) from a bit vector of size `n` to -yield a new bitvector of size `hi - lo + 1`. - -SMT-Lib name: `extract`. --/ -def extractLsb (hi lo : Nat) (a : BitVec n) : BitVec (hi - lo + 1) := extractLsb' lo _ a - --- TODO: write this using multiplication -/-- `replicate i x` concatenates `i` copies of `x` into a new vector of length `w*i`. -/ -def replicate : (i : Nat) → BitVec w → BitVec (w*i) - | 0, _ => 0 - | n+1, x => - have hEq : w + w*n = w*(n + 1) := by - rw [Nat.mul_add, Nat.add_comm, Nat.mul_one] - hEq ▸ (x ++ replicate n x) - -/-- Fills a bitvector with `w` copies of the bit `b`. -/ -def fill (w : Nat) (b : Bool) : BitVec w := bif b then -1 else 0 - -/-- -Zero extend vector `x` of length `w` by adding zeros in the high bits until it has length `v`. -If `v < w` then it truncates the high bits instead. - -SMT-Lib name: `zero_extend`. --/ -def zeroExtend (v : Nat) (x : BitVec w) : BitVec v := - if h : w ≤ v then - zeroExtend' h x - else - .ofNat v x.toNat - -/-- -Truncate the high bits of bitvector `x` of length `w`, resulting in a vector of length `v`. -If `v > w` then it zero-extends the vector instead. --/ -alias truncate := zeroExtend - -/-- -Sign extend a vector of length `w`, extending with `i` additional copies of the most significant -bit in `x`. If `x` is an empty vector, then the sign is treated as zero. - -SMT-Lib name: `sign_extend`. --/ -def signExtend (v : Nat) (x : BitVec w) : BitVec v := .ofInt v x.toInt - -/-! We add simp-lemmas that rewrite bitvector operations into the equivalent notation -/ -@[simp] theorem append_eq (x : BitVec w) (y : BitVec v) : BitVec.append x y = x ++ y := rfl -@[simp] theorem shiftLeft_eq (x : BitVec w) (n : Nat) : BitVec.shiftLeft x n = x <<< n := rfl -@[simp] theorem ushiftRight_eq (x : BitVec w) (n : Nat) : BitVec.ushiftRight x n = x >>> n := rfl -@[simp] theorem not_eq (x : BitVec w) : BitVec.not x = ~~~x := rfl -@[simp] theorem and_eq (x y : BitVec w) : BitVec.and x y = x &&& y := rfl -@[simp] theorem or_eq (x y : BitVec w) : BitVec.or x y = x ||| y := rfl -@[simp] theorem xor_eq (x y : BitVec w) : BitVec.xor x y = x ^^^ y := rfl -@[simp] theorem neg_eq (x : BitVec w) : BitVec.neg x = -x := rfl -@[simp] theorem add_eq (x y : BitVec w) : BitVec.add x y = x + y := rfl -@[simp] theorem sub_eq (x y : BitVec w) : BitVec.sub x y = x - y := rfl -@[simp] theorem mul_eq (x y : BitVec w) : BitVec.mul x y = x * y := rfl -@[simp] theorem zero_eq : BitVec.zero n = 0#n := rfl - -@[simp] theorem cast_ofNat {n m : Nat} (h : n = m) (x : Nat) : - cast h (BitVec.ofNat n x) = BitVec.ofNat m x := by - subst h; rfl - -@[simp] theorem cast_cast {n m k : Nat} (h₁ : n = m) (h₂ : m = k) (x : BitVec n) : - cast h₂ (cast h₁ x) = cast (h₁ ▸ h₂) x := - rfl - -@[simp] theorem cast_eq {n : Nat} (h : n = n) (x : BitVec n) : - cast h x = x := - rfl - -/-- Turn a `Bool` into a bitvector of length `1` -/ -def ofBool (b : Bool) : BitVec 1 := cond b 1 0 - -@[simp] theorem ofBool_false : ofBool false = 0 := by trivial -@[simp] theorem ofBool_true : ofBool true = 1 := by trivial - -/-- The empty bitvector -/ -abbrev nil : BitVec 0 := 0 - -/-! -### Cons and Concat -We give special names to the operations of adding a single bit to either end of a bitvector. -We follow the precedent of `Vector.cons`/`Vector.concat` both for the name, and for the decision -to have the resulting size be `n + 1` for both operations (rather than `1 + n`, which would be the -result of appending a single bit to the front in the naive implementation). --/ - -/-- Append a single bit to the end of a bitvector, using big endian order (see `append`). - That is, the new bit is the least significant bit. -/ -def concat {n} (msbs : BitVec n) (lsb : Bool) : BitVec (n+1) := msbs ++ (ofBool lsb) - -/-- Prepend a single bit to the front of a bitvector, using big endian order (see `append`). - That is, the new bit is the most significant bit. -/ -def cons {n} (msb : Bool) (lsbs : BitVec n) : BitVec (n+1) := - ((ofBool msb) ++ lsbs).cast (Nat.add_comm ..) - -/-- All empty bitvectors are equal -/ -instance : Subsingleton (BitVec 0) where - allEq := by intro ⟨0, _⟩ ⟨0, _⟩; rfl - -/-- Every bitvector of length 0 is equal to `nil`, i.e., there is only one empty bitvector -/ -theorem eq_nil : ∀ (x : BitVec 0), x = nil - | ofFin ⟨0, _⟩ => rfl - -theorem append_ofBool (msbs : BitVec w) (lsb : Bool) : - msbs ++ ofBool lsb = concat msbs lsb := - rfl - -theorem ofBool_append (msb : Bool) (lsbs : BitVec w) : - ofBool msb ++ lsbs = (cons msb lsbs).cast (Nat.add_comm ..) := - rfl diff --git a/Std/Data/BitVec/Bitblast.lean b/Std/Data/BitVec/Bitblast.lean deleted file mode 100644 index 9c068721f1..0000000000 --- a/Std/Data/BitVec/Bitblast.lean +++ /dev/null @@ -1,172 +0,0 @@ -/- -Copyright (c) 2023 by the authors listed in the file AUTHORS and their -institutional affiliations. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix --/ -import Std.Data.BitVec.Folds - -/-! -# Bitblasting of bitvectors - -This module provides theorems for showing the equivalence between BitVec operations using -the `Fin 2^n` representation and Boolean vectors. It is still under development, but -intended to provide a path for converting SAT and SMT solver proofs about BitVectors -as vectors of bits into proofs about Lean `BitVec` values. - -The module is named for the bit-blasting operation in an SMT solver that converts bitvector -expressions into expressions about individual bits in each vector. - -## Main results -* `x + y : BitVec w` is `(adc x y false).2`. - - -## Future work -All other operations are to be PR'ed later and are already proved in -https://github.com/mhk119/lean-smt/blob/bitvec/Smt/Data/Bitwise.lean. - --/ - -open Nat Bool - -/-! ### Preliminaries -/ - -namespace Std.BitVec - -private theorem testBit_limit {x i : Nat} (x_lt_succ : x < 2^(i+1)) : - testBit x i = decide (x ≥ 2^i) := by - cases xi : testBit x i with - | true => - simp [testBit_implies_ge xi] - | false => - simp - cases Nat.lt_or_ge x (2^i) with - | inl x_lt => - exact x_lt - | inr x_ge => - have ⟨j, ⟨j_ge, jp⟩⟩ := ge_two_pow_implies_high_bit_true x_ge - cases Nat.lt_or_eq_of_le j_ge with - | inr x_eq => - simp [x_eq, jp] at xi - | inl x_lt => - exfalso - apply Nat.lt_irrefl - calc x < 2^(i+1) := x_lt_succ - _ ≤ 2 ^ j := Nat.pow_le_pow_of_le_right Nat.zero_lt_two x_lt - _ ≤ x := testBit_implies_ge jp - -private theorem mod_two_pow_succ (x i : Nat) : - x % 2^(i+1) = 2^i*(x.testBit i).toNat + x % (2 ^ i):= by - apply Nat.eq_of_testBit_eq - intro j - simp only [Nat.mul_add_lt_is_or, testBit_or, testBit_mod_two_pow, testBit_shiftLeft, - Nat.testBit_bool_to_nat, Nat.sub_eq_zero_iff_le, Nat.mod_lt, Nat.two_pow_pos, - testBit_mul_pow_two] - rcases Nat.lt_trichotomy i j with i_lt_j | i_eq_j | j_lt_i - · have i_le_j : i ≤ j := Nat.le_of_lt i_lt_j - have not_j_le_i : ¬(j ≤ i) := Nat.not_le_of_lt i_lt_j - have not_j_lt_i : ¬(j < i) := Nat.not_lt_of_le i_le_j - have not_j_lt_i_succ : ¬(j < i + 1) := - Nat.not_le_of_lt (Nat.succ_lt_succ i_lt_j) - simp [i_le_j, not_j_le_i, not_j_lt_i, not_j_lt_i_succ] - · simp [i_eq_j] - · have j_le_i : j ≤ i := Nat.le_of_lt j_lt_i - have j_le_i_succ : j < i + 1 := Nat.succ_le_succ j_le_i - have not_j_ge_i : ¬(j ≥ i) := Nat.not_le_of_lt j_lt_i - simp [j_lt_i, j_le_i, not_j_ge_i, j_le_i_succ] - -private theorem mod_two_pow_lt (x i : Nat) : x % 2 ^ i < 2^i := Nat.mod_lt _ (Nat.two_pow_pos _) - -/-! ### Addition -/ - -/-- carry w x y c returns true if the `w` carry bit is true when computing `x + y + c`. -/ -def carry (w x y : Nat) (c : Bool) : Bool := decide (x % 2^w + y % 2^w + c.toNat ≥ 2^w) - -@[simp] theorem carry_zero : carry 0 x y c = c := by - cases c <;> simp [carry, mod_one] - -/-- At least two out of three booleans are true. -/ -abbrev atLeastTwo (a b c : Bool) : Bool := a && b || a && c || b && c - -/-- Carry function for bitwise addition. -/ -def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, Bool.xor x (Bool.xor y c)) - -/-- Bitwise addition implemented via a ripple carry adder. -/ -def adc (x y : BitVec w) : Bool → Bool × BitVec w := - iunfoldr fun (i : Fin w) c => adcb (x.getLsb i) (y.getLsb i) c - -theorem adc_overflow_limit (x y i : Nat) (c : Bool) : x % 2^i + (y % 2^i + c.toNat) < 2^(i+1) := by - have : c.toNat ≤ 1 := Bool.toNat_le_one c - rw [Nat.pow_succ] - omega - -theorem carry_succ (w x y : Nat) (c : Bool) : - carry (succ w) x y c = atLeastTwo (x.testBit w) (y.testBit w) (carry w x y c) := by - simp only [carry, mod_two_pow_succ, atLeastTwo] - simp only [Nat.pow_succ'] - generalize testBit x w = xh - generalize testBit y w = yh - have sum_bnd : x%2^w + (y%2^w + c.toNat) < 2*2^w := by - simp only [← Nat.pow_succ'] - exact adc_overflow_limit x y w c - cases xh <;> cases yh <;> (simp; omega) - -theorem getLsb_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool) : - getLsb (x + y + zeroExtend w (ofBool c)) i = - Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x.toNat y.toNat c)) := by - let ⟨x, x_lt⟩ := x - let ⟨y, y_lt⟩ := y - simp only [getLsb, toNat_add, toNat_zeroExtend, i_lt, toNat_ofFin, toNat_ofBool, - Nat.mod_add_mod, Nat.add_mod_mod] - apply Eq.trans - rw [← Nat.div_add_mod x (2^i), ← Nat.div_add_mod y (2^i)] - simp only - [ Nat.testBit_mod_two_pow, - Nat.testBit_mul_two_pow_add_eq, - i_lt, - decide_True, - Bool.true_and, - Nat.add_assoc, - Nat.add_left_comm (_%_) (_ * _) _, - testBit_limit (adc_overflow_limit x y i c) - ] - simp [testBit_to_div_mod, carry, Nat.add_assoc] - -theorem getLsb_add {i : Nat} (i_lt : i < w) (x y : BitVec w) : - getLsb (x + y) i = - Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x.toNat y.toNat false)) := by - simpa using getLsb_add_add_bool i_lt x y false - -theorem adc_spec (x y : BitVec w) (c : Bool) : - adc x y c = (carry w x.toNat y.toNat c, x + y + zeroExtend w (ofBool c)) := by - simp only [adc] - apply iunfoldr_replace - (fun i => carry i x.toNat y.toNat c) - (x + y + zeroExtend w (ofBool c)) - c - case init => - simp [carry, Nat.mod_one] - cases c <;> rfl - case step => - intro ⟨i, lt⟩ - simp only [adcb, Prod.mk.injEq, carry_succ] - apply And.intro - case left => - rw [testBit_toNat, testBit_toNat] - case right => - simp [getLsb_add_add_bool lt] - -theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := by - simp [adc_spec] - -/-! ### add -/ - -/-- 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)] - · rfl - · simp [adcb, atLeastTwo] - -/-- Subtracting `x` from the all ones bitvector is equivalent to taking its complement -/ -theorem allOnes_sub_eq_not (x : BitVec w) : allOnes w - x = ~~~x := by - rw [← add_not_self x, BitVec.add_comm, add_sub_cancel] diff --git a/Std/Data/BitVec/Folds.lean b/Std/Data/BitVec/Folds.lean deleted file mode 100644 index 952b930006..0000000000 --- a/Std/Data/BitVec/Folds.lean +++ /dev/null @@ -1,57 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix --/ -import Std.Data.BitVec.Lemmas -import Std.Data.Nat.Lemmas - -namespace Std.BitVec - -/-- -iunfoldr is an iterative operation that applies a function `f` repeatedly. - -It produces a sequence of state values `[s_0, s_1 .. s_w]` and a bitvector -`v` where `f i s_i = (s_{i+1}, b_i)` and `b_i` is bit `i`th least-significant bit -in `v` (e.g., `getLsb v i = b_i`). - -Theorems involving `iunfoldr` can be eliminated using `iunfoldr_replace` below. --/ -def iunfoldr (f : Fin w -> α → α × Bool) (s : α) : α × BitVec w := - Fin.hIterate (fun i => α × BitVec i) (s, nil) fun i q => - (fun p => ⟨p.fst, cons p.snd q.snd⟩) (f i q.fst) - -theorem iunfoldr.fst_eq - {f : Fin w → α → α × Bool} (state : Nat → α) (s : α) - (init : s = state 0) - (ind : ∀(i : Fin w), (f i (state i.val)).fst = state (i.val+1)) : - (iunfoldr f s).fst = state w := by - unfold iunfoldr - apply Fin.hIterate_elim (fun i (p : α × BitVec i) => p.fst = state i) - case init => - exact init - case step => - intro i ⟨s, v⟩ p - simp_all [ind i] - -private theorem iunfoldr.eq_test - {f : Fin w → α → α × Bool} (state : Nat → α) (value : BitVec w) (a : α) - (init : state 0 = a) - (step : ∀(i : Fin w), f i (state i.val) = (state (i.val+1), value.getLsb i.val)) : - iunfoldr f a = (state w, BitVec.truncate w value) := by - apply Fin.hIterate_eq (fun i => ((state i, BitVec.truncate i value) : α × BitVec i)) - case init => - simp only [init, eq_nil] - case step => - intro i - simp_all [truncate_succ] - -/-- -Correctness theorem for `iunfoldr`. --/ -theorem iunfoldr_replace - {f : Fin w → α → α × Bool} (state : Nat → α) (value : BitVec w) (a : α) - (init : state 0 = a) - (step : ∀(i : Fin w), f i (state i.val) = (state (i.val+1), value.getLsb i.val)) : - iunfoldr f a = (state w, value) := by - simp [iunfoldr.eq_test state value a init step] diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index 3a23fa3e04..65983b4fb0 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -4,543 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joe Hendrix -/ import Std.Data.Bool -import Std.Data.BitVec.Basic import Std.Data.Fin.Lemmas import Std.Data.Nat.Lemmas -import Std.Tactic.Simpa import Std.Util.ProofWanted namespace Std.BitVec -/-- -This normalized a bitvec using `ofFin` to `ofNat`. --/ -theorem ofFin_eq_ofNat : @BitVec.ofFin w (Fin.mk x lt) = BitVec.ofNat w x := by - simp only [BitVec.ofNat, Fin.ofNat', lt, Nat.mod_eq_of_lt] - -/-- Prove equality of bitvectors in terms of nat operations. -/ -theorem eq_of_toNat_eq {n} : ∀ {i j : BitVec n}, i.toNat = j.toNat → i = j - | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl - /-- Replaced 2024-02-07. -/ @[deprecated] alias zero_is_unique := eq_nil -@[simp] theorem val_toFin (x : BitVec w) : x.toFin.val = x.toNat := rfl - -theorem toNat_eq (x y : BitVec n) : x = y ↔ x.toNat = y.toNat := - Iff.intro (congrArg BitVec.toNat) eq_of_toNat_eq - -theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.toFin.2 - -theorem testBit_toNat (x : BitVec w) : x.toNat.testBit i = x.getLsb i := rfl - -@[simp] theorem getLsb_ofFin (x : Fin (2^n)) (i : Nat) : - getLsb (BitVec.ofFin x) i = x.val.testBit i := rfl - -@[simp] theorem getLsb_ge (x : BitVec w) (i : Nat) (ge : i ≥ w) : getLsb x i = false := by - let ⟨x, x_lt⟩ := x - simp - apply Nat.testBit_lt_two_pow - have p : 2^w ≤ 2^i := Nat.pow_le_pow_of_le_right (by omega) ge - omega - -theorem lt_of_getLsb (x : BitVec w) (i : Nat) : getLsb x i = true → i < w := by - if h : i < w then - simp [h] - else - simp [Nat.ge_of_not_lt h] - --- We choose `eq_of_getLsb_eq` as the `@[ext]` theorem for `BitVec` --- somewhat arbitrarily over `eq_of_getMsg_eq`. -@[ext] theorem eq_of_getLsb_eq {x y : BitVec w} - (pred : ∀(i : Fin w), x.getLsb i.val = y.getLsb i.val) : x = y := by - apply eq_of_toNat_eq - apply Nat.eq_of_testBit_eq - intro i - if i_lt : i < w then - exact pred ⟨i, i_lt⟩ - else - have p : i ≥ w := Nat.le_of_not_gt i_lt - simp [testBit_toNat, getLsb_ge _ _ p] - -theorem eq_of_getMsb_eq {x y : BitVec w} - (pred : ∀(i : Fin w), x.getMsb i = y.getMsb i.val) : x = y := by - simp only [getMsb] at pred - apply eq_of_getLsb_eq - intro ⟨i, i_lt⟩ - if w_zero : w = 0 then - simp [w_zero] - else - have w_pos := Nat.pos_of_ne_zero w_zero - have r : i ≤ w - 1 := by - simp [Nat.le_sub_iff_add_le w_pos, Nat.add_succ] - exact i_lt - have q_lt : w - 1 - i < w := by - simp only [Nat.sub_sub] - apply Nat.sub_lt w_pos - simp [Nat.succ_add] - have q := pred ⟨w - 1 - i, q_lt⟩ - simpa [q_lt, Nat.sub_sub_self, r] using q - -theorem eq_of_toFin_eq : ∀ {x y : BitVec w}, x.toFin = y.toFin → x = y - | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl - -@[simp] theorem toNat_ofBool (b : Bool) : (ofBool b).toNat = b.toNat := by - cases b <;> rfl - -theorem ofNat_one (n : Nat) : BitVec.ofNat 1 n = BitVec.ofBool (n % 2 = 1) := by - rcases (Nat.mod_two_eq_zero_or_one n) with h | h <;> simp [h, BitVec.ofNat, Fin.ofNat'] - -theorem ofBool_eq_iff_eq : ∀(b b' : Bool), BitVec.ofBool b = BitVec.ofBool b' ↔ b = b' := by - decide - -@[simp] theorem toNat_ofFin (x : Fin (2^n)) : (BitVec.ofFin x).toNat = x.val := rfl - -@[simp] theorem toNat_ofNat (x w : Nat) : (x#w).toNat = x % 2^w := by - simp [BitVec.toNat, BitVec.ofNat, Fin.ofNat'] - -@[simp] theorem toFin_ofNat (w x : Nat) : (x#w).toFin = Fin.ofNat' x (Nat.two_pow_pos _) := rfl - --- Remark: we don't use `[simp]` here because simproc` subsumes it for literals. --- If `x` and `n` are not literals, applying this theorem eagerly may not be a good idea. -theorem getLsb_ofNat (n : Nat) (x : Nat) (i : Nat) : - getLsb (x#n) i = (i < n && x.testBit i) := by - simp [getLsb, BitVec.ofNat, Fin.val_ofNat'] - -@[deprecated toNat_ofNat] theorem toNat_zero (n : Nat) : (0#n).toNat = 0 := by trivial - -@[simp] theorem toNat_mod_cancel (x : BitVec n) : x.toNat % (2^n) = x.toNat := - Nat.mod_eq_of_lt x.isLt - -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) - -@[simp] theorem ofNat_toNat (m : Nat) (x : BitVec n) : x.toNat#m = truncate m x := by - let ⟨x, lt_n⟩ := x - unfold truncate - unfold zeroExtend - if h : n ≤ m then - unfold zeroExtend' - have lt_m : x < 2 ^ m := lt_two_pow_of_le lt_n h - simp [h, lt_m, Nat.mod_eq_of_lt, BitVec.toNat, BitVec.ofNat, Fin.ofNat'] - else - simp [h] - - -/-! ### msb -/ - -theorem msb_eq_decide (x : BitVec (Nat.succ w)) : BitVec.msb x = decide (2 ^ w ≤ x.toNat) := by - simp only [BitVec.msb, getMsb, Nat.zero_lt_succ, - decide_True, getLsb, Nat.testBit, Nat.succ_sub_succ_eq_sub, - Nat.sub_zero, Nat.and_one_is_mod, Bool.true_and, Nat.shiftRight_eq_div_pow] - rcases (Nat.lt_or_ge (BitVec.toNat x) (2 ^ w)) with h | h - · simp [Nat.div_eq_of_lt h, h] - · simp only [h] - rw [Nat.div_eq_sub_div (Nat.two_pow_pos w) h, Nat.div_eq_of_lt] - · decide - · have : BitVec.toNat x < 2^w + 2^w := by simpa [Nat.pow_succ, Nat.mul_two] using x.isLt - omega - -/-! ### cast -/ - -@[simp] theorem toNat_cast (h : w = v) (x : BitVec w) : (cast h x).toNat = x.toNat := rfl -@[simp] theorem toFin_cast (h : w = v) (x : BitVec w) : - (cast h x).toFin = x.toFin.cast (by rw [h]) := - rfl - -@[simp] theorem getLsb_cast (h : w = v) (x : BitVec w) : (cast h x).getLsb i = x.getLsb i := by - subst h; simp - -@[simp] theorem getMsb_cast (h : w = v) (x : BitVec w) : (cast h x).getMsb i = x.getMsb i := by - subst h; simp -@[simp] theorem msb_cast (h : w = v) (x : BitVec w) : (cast h x).msb = x.msb := by - simp [BitVec.msb] - -/-! ### zeroExtend and truncate -/ - -@[simp] theorem toNat_zeroExtend' {m n : Nat} (p : m ≤ n) (x : BitVec m) : - (zeroExtend' p x).toNat = x.toNat := by - unfold zeroExtend' - simp [p, x.isLt, Nat.mod_eq_of_lt] - -theorem toNat_zeroExtend (i : Nat) (x : BitVec n) : - BitVec.toNat (zeroExtend i x) = x.toNat % 2^i := by - let ⟨x, lt_n⟩ := x - simp only [zeroExtend] - if n_le_i : n ≤ i then - have x_lt_two_i : x < 2 ^ i := lt_two_pow_of_le lt_n n_le_i - simp [n_le_i, Nat.mod_eq_of_lt, x_lt_two_i] - else - simp [n_le_i, toNat_ofNat] - -@[simp] theorem zeroExtend_eq (x : BitVec n) : zeroExtend n x = x := by - apply eq_of_toNat_eq - let ⟨x, lt_n⟩ := x - simp [truncate, zeroExtend] - -@[simp] theorem zeroExtend_zero (m n : Nat) : zeroExtend m (0#n) = 0#m := by - apply eq_of_toNat_eq - simp [toNat_zeroExtend] - -@[simp] theorem truncate_eq (x : BitVec n) : truncate n x = x := zeroExtend_eq x - -@[simp] theorem toNat_truncate (x : BitVec n) : (truncate i x).toNat = x.toNat % 2^i := - toNat_zeroExtend i x - -@[simp] theorem getLsb_zeroExtend' (ge : m ≥ n) (x : BitVec n) (i : Nat) : - getLsb (zeroExtend' ge x) i = getLsb x i := by - simp [getLsb, toNat_zeroExtend'] - -@[simp] theorem getLsb_zeroExtend (m : Nat) (x : BitVec n) (i : Nat) : - getLsb (zeroExtend m x) i = (decide (i < m) && getLsb x i) := by - simp [getLsb, toNat_zeroExtend, Nat.testBit_mod_two_pow] - -@[simp] theorem getLsb_truncate (m : Nat) (x : BitVec n) (i : Nat) : - getLsb (truncate m x) i = (decide (i < m) && getLsb x i) := - getLsb_zeroExtend m x i - -/-! ## extractLsb -/ - -@[simp] -protected theorem extractLsb_ofFin {n} (x : Fin (2^n)) (hi lo : Nat) : - extractLsb hi lo (@BitVec.ofFin n x) = .ofNat (hi-lo+1) (x.val >>> lo) := rfl - -@[simp] -protected theorem extractLsb_ofNat (x n : Nat) (hi lo : Nat) : - extractLsb hi lo x#n = .ofNat (hi - lo + 1) ((x % 2^n) >>> lo) := by - apply eq_of_getLsb_eq - intro ⟨i, _lt⟩ - simp [BitVec.ofNat] - -@[simp] theorem extractLsb'_toNat (s m : Nat) (x : BitVec n) : - (extractLsb' s m x).toNat = (x.toNat >>> s) % 2^m := rfl - -@[simp] theorem extractLsb_toNat (hi lo : Nat) (x : BitVec n) : - (extractLsb hi lo x).toNat = (x.toNat >>> lo) % 2^(hi-lo+1) := rfl - -@[simp] theorem getLsb_extract (hi lo : Nat) (x : BitVec n) (i : Nat) : - getLsb (extractLsb hi lo x) i = (i ≤ (hi-lo) && getLsb x (lo+i)) := by - unfold getLsb - simp [Nat.lt_succ] - -/-! ### allOnes -/ - -private theorem allOnes_def : - allOnes v = .ofFin (⟨0, Nat.two_pow_pos v⟩ - ⟨1 % 2^v, Nat.mod_lt _ (Nat.two_pow_pos v)⟩) := by - rfl - -@[simp] theorem toNat_allOnes : (allOnes v).toNat = 2^v - 1 := by - simp only [allOnes_def, toNat_ofFin, Fin.coe_sub, Nat.zero_add] - by_cases h : v = 0 - · subst h - rfl - · rw [Nat.mod_eq_of_lt (Nat.one_lt_two_pow h), Nat.mod_eq_of_lt] - exact Nat.pred_lt_self (Nat.two_pow_pos v) - -@[simp] theorem getLsb_allOnes : (allOnes v).getLsb i = decide (i < v) := by - simp only [allOnes_def, getLsb_ofFin, Fin.coe_sub, Nat.zero_add, Nat.testBit_mod_two_pow] - if h : i < v then - simp only [h, decide_True, Bool.true_and] - match i, v, h with - | i, (v + 1), h => - rw [Nat.mod_eq_of_lt (by simp), Nat.testBit_two_pow_sub_one] - simp [h] - else - simp [h] - -theorem negOne_eq_allOnes : -1#w = allOnes w := - rfl - -/-! ### or -/ - -@[simp] theorem toNat_or (x y : BitVec v) : - BitVec.toNat (x ||| y) = BitVec.toNat x ||| BitVec.toNat y := rfl - -@[simp] theorem toFin_or (x y : BitVec v) : - BitVec.toFin (x ||| y) = BitVec.toFin x ||| BitVec.toFin y := by - simp only [HOr.hOr, OrOp.or, BitVec.or, Fin.lor, val_toFin, Fin.mk.injEq] - exact (Nat.mod_eq_of_lt <| Nat.or_lt_two_pow x.isLt y.isLt).symm - - -@[simp] theorem getLsb_or {x y : BitVec v} : (x ||| y).getLsb i = (x.getLsb i || y.getLsb i) := by - rw [← testBit_toNat, getLsb, getLsb] - simp - -/-! ### and -/ - -@[simp] theorem toNat_and (x y : BitVec v) : - BitVec.toNat (x &&& y) = BitVec.toNat x &&& BitVec.toNat y := rfl - -@[simp] theorem toFin_and (x y : BitVec v) : - BitVec.toFin (x &&& y) = BitVec.toFin x &&& BitVec.toFin y := by - simp only [HAnd.hAnd, AndOp.and, BitVec.and, Fin.land, val_toFin, Fin.mk.injEq] - exact (Nat.mod_eq_of_lt <| Nat.and_lt_two_pow _ y.isLt).symm - -@[simp] theorem getLsb_and {x y : BitVec v} : (x &&& y).getLsb i = (x.getLsb i && y.getLsb i) := by - rw [← testBit_toNat, getLsb, getLsb] - simp - -/-! ### xor -/ - -@[simp] theorem toNat_xor (x y : BitVec v) : - BitVec.toNat (x ^^^ y) = BitVec.toNat x ^^^ BitVec.toNat y := rfl - -@[simp] theorem toFin_xor (x y : BitVec v) : - BitVec.toFin (x ^^^ y) = BitVec.toFin x ^^^ BitVec.toFin y := by - simp only [HXor.hXor, Xor.xor, BitVec.xor, Fin.xor, val_toFin, Fin.mk.injEq] - exact (Nat.mod_eq_of_lt <| Nat.xor_lt_two_pow x.isLt y.isLt).symm - -@[simp] theorem getLsb_xor {x y : BitVec v} : - (x ^^^ y).getLsb i = (xor (x.getLsb i) (y.getLsb i)) := by - rw [← testBit_toNat, getLsb, getLsb] - simp - -/-! ### not -/ - -theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl - -@[simp] theorem toNat_not {x : BitVec v} : (~~~x).toNat = 2^v - 1 - x.toNat := by - rw [Nat.sub_sub, Nat.add_comm, not_def, toNat_xor] - apply Nat.eq_of_testBit_eq - intro i - simp only [toNat_allOnes, Nat.testBit_xor, Nat.testBit_two_pow_sub_one] - match h : BitVec.toNat x with - | 0 => simp - | y+1 => - rw [Nat.succ_eq_add_one] at h - rw [← h] - rw [Nat.testBit_two_pow_sub_succ (toNat_lt _)] - · cases w : decide (i < v) - · simp at w - simp [w] - rw [Nat.testBit_lt_two_pow] - calc BitVec.toNat x < 2 ^ v := toNat_lt _ - _ ≤ 2 ^ i := Nat.pow_le_pow_of_le_right Nat.zero_lt_two w - · simp - -@[simp] theorem toFin_not (x : BitVec w) : - (~~~x).toFin = x.toFin.rev := by - apply Fin.val_inj.mp - simp only [val_toFin, toNat_not, Fin.val_rev] - omega - -@[simp] theorem getLsb_not {x : BitVec v} : (~~~x).getLsb i = (decide (i < v) && ! x.getLsb i) := by - by_cases h' : i < v <;> simp_all [not_def] - -/-! ### shiftLeft -/ - -@[simp] theorem toNat_shiftLeft {x : BitVec v} : - BitVec.toNat (x <<< n) = BitVec.toNat x <<< n % 2^v := - BitVec.toNat_ofNat _ _ - -@[simp] theorem toFin_shiftLeft {n : Nat} (x : BitVec w) : - BitVec.toFin (x <<< n) = Fin.ofNat' (x.toNat <<< n) (Nat.two_pow_pos w) := rfl - -@[simp] theorem getLsb_shiftLeft (x : BitVec m) (n) : - getLsb (x <<< n) i = (decide (i < m) && !decide (i < n) && getLsb x (i - n)) := by - rw [← testBit_toNat, getLsb] - simp only [toNat_shiftLeft, Nat.testBit_mod_two_pow, Nat.testBit_shiftLeft, ge_iff_le] - -- This step could be a case bashing tactic. - cases h₁ : decide (i < m) <;> cases h₂ : decide (n ≤ i) <;> cases h₃ : decide (i < n) - all_goals { simp_all <;> omega } - -theorem shiftLeftZeroExtend_eq {x : BitVec w} : - shiftLeftZeroExtend x n = zeroExtend (w+n) x <<< n := by - apply eq_of_toNat_eq - rw [shiftLeftZeroExtend, zeroExtend] - split - · simp - rw [Nat.mod_eq_of_lt] - rw [Nat.shiftLeft_eq, Nat.pow_add] - exact Nat.mul_lt_mul_of_pos_right (BitVec.toNat_lt x) (Nat.two_pow_pos _) - · omega - -@[simp] theorem getLsb_shiftLeftZeroExtend (x : BitVec m) (n : Nat) : - getLsb (shiftLeftZeroExtend x n) i = ((! decide (i < n)) && getLsb x (i - n)) := by - rw [shiftLeftZeroExtend_eq] - simp only [getLsb_shiftLeft, getLsb_zeroExtend] - cases h₁ : decide (i < n) <;> cases h₂ : decide (i - n < m + n) <;> cases h₃ : decide (i < m + n) - <;> simp_all - <;> (rw [getLsb_ge]; omega) - -/-! ### ushiftRight -/ - -@[simp] theorem toNat_ushiftRight (x : BitVec n) (i : Nat) : - (x >>> i).toNat = x.toNat >>> i := rfl - -@[simp] theorem getLsb_ushiftRight (x : BitVec n) (i j : Nat) : - getLsb (x >>> i) j = getLsb x (i+j) := by - unfold getLsb ; simp - -/-! ### append -/ - -theorem append_def (x : BitVec v) (y : BitVec w) : - x ++ y = (shiftLeftZeroExtend x w ||| zeroExtend' (Nat.le_add_left w v) y) := rfl - -@[simp] theorem toNat_append (x : BitVec m) (y : BitVec n) : - (x ++ y).toNat = x.toNat <<< n ||| y.toNat := - rfl - -@[simp] theorem getLsb_append {v : BitVec n} {w : BitVec m} : - getLsb (v ++ w) i = bif i < m then getLsb w i else getLsb v (i - m) := by - simp [append_def] - by_cases h : i < m - · simp [h] - · simp [h]; simp_all - -/-! ### rev -/ - -theorem getLsb_rev (x : BitVec w) (i : Fin w) : - x.getLsb i.rev = x.getMsb i := by - simp [getLsb, getMsb] - congr 1 - omega - -theorem getMsb_rev (x : BitVec w) (i : Fin w) : - x.getMsb i.rev = x.getLsb i := by - simp only [← getLsb_rev] - simp only [Fin.rev] - congr - omega - -/-! ### cons -/ - -@[simp] theorem toNat_cons (b : Bool) (x : BitVec w) : - (cons b x).toNat = (b.toNat <<< w) ||| x.toNat := by - let ⟨x, _⟩ := x - simp [cons, toNat_append, toNat_ofBool] - -@[simp] theorem getLsb_cons (b : Bool) {n} (x : BitVec n) (i : Nat) : - getLsb (cons b x) i = if i = n then b else getLsb x i := by - simp only [getLsb, toNat_cons, Nat.testBit_or] - rw [Nat.testBit_shiftLeft] - rcases Nat.lt_trichotomy i n with i_lt_n | i_eq_n | n_lt_i - · have p1 : ¬(n ≤ i) := by omega - have p2 : i ≠ n := by omega - simp [p1, p2] - · simp [i_eq_n, testBit_toNat] - cases b <;> trivial - · have p1 : i ≠ n := by omega - have p2 : i - n ≠ 0 := by omega - simp [p1, p2, Nat.testBit_bool_to_nat] - -theorem truncate_succ (x : BitVec w) : - truncate (i+1) x = cons (getLsb x i) (truncate i x) := by - apply eq_of_getLsb_eq - intro j - simp only [getLsb_truncate, getLsb_cons, j.isLt, decide_True, Bool.true_and] - if j_eq : j.val = i then - simp [j_eq] - else - have j_lt : j.val < i := Nat.lt_of_le_of_ne (Nat.le_of_succ_le_succ j.isLt) j_eq - simp [j_eq, j_lt] - -/-! ### add -/ - -theorem add_def {n} (x y : BitVec n) : x + y = .ofNat n (x.toNat + y.toNat) := rfl - -/-- -Definition of bitvector addition as a nat. --/ -@[simp] theorem toNat_add (x y : BitVec w) : (x + y).toNat = (x.toNat + y.toNat) % 2^w := rfl -@[simp] theorem toFin_add (x y : BitVec w) : (x + y).toFin = toFin x + toFin y := rfl -@[simp] theorem ofFin_add (x : Fin (2^n)) (y : BitVec n) : - .ofFin x + y = .ofFin (x + y.toFin) := rfl -@[simp] theorem add_ofFin (x : BitVec n) (y : Fin (2^n)) : - x + .ofFin y = .ofFin (x.toFin + y) := rfl -@[simp] theorem ofNat_add_ofNat {n} (x y : Nat) : x#n + y#n = (x + y)#n := by - apply eq_of_toNat_eq ; simp [BitVec.ofNat] - -protected theorem add_assoc (x y z : BitVec n) : x + y + z = x + (y + z) := by - apply eq_of_toNat_eq ; simp [Nat.add_assoc] - -protected theorem add_comm (x y : BitVec n) : x + y = y + x := by - simp [add_def, Nat.add_comm] - -@[simp] protected theorem add_zero (x : BitVec n) : x + 0#n = x := by simp [add_def] - -@[simp] protected theorem zero_add (x : BitVec n) : 0#n + x = x := by simp [add_def] - - /-! ### sub/neg -/ -theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n (x.toNat + (2^n - y.toNat)) := by rfl - -@[simp] theorem toNat_sub {n} (x y : BitVec n) : - (x - y).toNat = ((x.toNat + (2^n - y.toNat)) % 2^n) := rfl -@[simp] theorem toFin_sub (x y : BitVec n) : (x - y).toFin = toFin x - toFin y := rfl - /-- Replaced 2024-02-06. -/ @[deprecated] alias sub_toNat := toNat_sub -@[simp] theorem ofFin_sub (x : Fin (2^n)) (y : BitVec n) : .ofFin x - y = .ofFin (x - y.toFin) := - rfl -@[simp] theorem sub_ofFin (x : BitVec n) (y : Fin (2^n)) : x - .ofFin y = .ofFin (x.toFin - y) := - rfl --- Remark: we don't use `[simp]` here because simproc` subsumes it for literals. --- If `x` and `n` are not literals, applying this theorem eagerly may not be a good idea. -theorem ofNat_sub_ofNat {n} (x y : Nat) : x#n - y#n = .ofNat n (x + (2^n - y % 2^n)) := by - apply eq_of_toNat_eq ; simp [BitVec.ofNat] - -@[simp] protected theorem sub_zero (x : BitVec n) : x - (0#n) = x := by apply eq_of_toNat_eq ; simp - -@[simp] protected theorem sub_self (x : BitVec n) : x - x = 0#n := by - apply eq_of_toNat_eq - simp only [toNat_sub] - rw [Nat.add_sub_of_le] - · simp - · exact Nat.le_of_lt x.isLt - -@[simp] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by - simp [Neg.neg, BitVec.neg] - /-- Replaced 2024-02-06. -/ @[deprecated] alias neg_toNat := toNat_neg - -theorem sub_toAdd {n} (x y : BitVec n) : x - y = x + - y := by - apply eq_of_toNat_eq - simp - -@[simp] theorem neg_zero (n:Nat) : -0#n = 0#n := by apply eq_of_toNat_eq ; simp - -theorem add_sub_cancel (x y : BitVec w) : x + y - y = x := by - apply eq_of_toNat_eq - have y_toNat_le := Nat.le_of_lt y.toNat_lt - rw [toNat_sub, toNat_add, Nat.mod_add_mod, Nat.add_assoc, ← Nat.add_sub_assoc y_toNat_le, - Nat.add_sub_cancel_left, Nat.add_mod_right, toNat_mod_cancel] - -/-! ### mul -/ - -theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl - -theorem toNat_mul (x y : BitVec n) : (x * y).toNat = (x.toNat * y.toNat) % 2 ^ n := rfl -@[simp] theorem toFin_mul (x y : BitVec n) : (x * y).toFin = (x.toFin * y.toFin) := rfl - -/-! ### le and lt -/ - -theorem le_def (x y : BitVec n) : - x ≤ y ↔ x.toNat ≤ y.toNat := Iff.rfl - -@[simp] theorem le_ofFin (x : BitVec n) (y : Fin (2^n)) : - x ≤ BitVec.ofFin y ↔ x.toFin ≤ y := Iff.rfl -@[simp] theorem ofFin_le (x : Fin (2^n)) (y : BitVec n) : - BitVec.ofFin x ≤ y ↔ x ≤ y.toFin := Iff.rfl -@[simp] theorem ofNat_le_ofNat {n} (x y : Nat) : (x#n) ≤ (y#n) ↔ x % 2^n ≤ y % 2^n := by - simp [le_def] - -theorem lt_def (x y : BitVec n) : - x < y ↔ x.toNat < y.toNat := Iff.rfl - -@[simp] theorem lt_ofFin (x : BitVec n) (y : Fin (2^n)) : - x < BitVec.ofFin y ↔ x.toFin < y := Iff.rfl -@[simp] theorem ofFin_lt (x : Fin (2^n)) (y : BitVec n) : - BitVec.ofFin x < y ↔ x < y.toFin := Iff.rfl -@[simp] theorem ofNat_lt_ofNat {n} (x y : Nat) : (x#n) < (y#n) ↔ x % 2^n < y % 2^n := by - simp [lt_def] - -protected theorem lt_of_le_ne (x y : BitVec n) (h1 : x <= y) (h2 : ¬ x = y) : x < y := by - revert h1 h2 - let ⟨x, lt⟩ := x - let ⟨y, lt⟩ := y - simp - exact Nat.lt_of_le_of_ne diff --git a/Std/Data/BitVec/Simprocs.lean b/Std/Data/BitVec/Simprocs.lean deleted file mode 100644 index 9263d2f80e..0000000000 --- a/Std/Data/BitVec/Simprocs.lean +++ /dev/null @@ -1,283 +0,0 @@ -/- -Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura --/ -import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Nat -import Std.Data.BitVec.Basic - -namespace Std.BitVec -open Lean Meta Simp - -/-- A bit-vector literal -/ -structure Literal where - /-- Size. -/ - n : Nat - /-- Actual value. -/ - value : BitVec n - -/-- -Try to convert an `OfNat.ofNat`-application into a bitvector literal. --/ -private def fromOfNatExpr? (e : Expr) : SimpM (Option Literal) := OptionT.run do - guard (e.isAppOfArity ``OfNat.ofNat 3) - let type ← whnf e.appFn!.appFn!.appArg! - guard (type.isAppOfArity ``BitVec 1) - let n ← Nat.fromExpr? type.appArg! - let v ← Nat.fromExpr? e.appFn!.appArg! - return { n, value := BitVec.ofNat n v } - -/-- -Try to convert an `Std.BitVec.ofNat`-application into a bitvector literal. --/ -private def fromBitVecExpr? (e : Expr) : SimpM (Option Literal) := OptionT.run do - guard (e.isAppOfArity ``Std.BitVec.ofNat 2) - let n ← Nat.fromExpr? e.appFn!.appArg! - let v ← Nat.fromExpr? e.appArg! - return { n, value := BitVec.ofNat n v } - -/-- -Try to convert `OfNat.ofNat`/`Std.BitVec.OfNat` application into a -bitvector literal. --/ -def fromExpr? (e : Expr) : SimpM (Option Literal) := OptionT.run do - fromBitVecExpr? e <|> fromOfNatExpr? e - -/-- -Convert a bitvector literal into an expression. --/ --- Using `Std.BitVec.ofNat` because it is being used in `simp` theorems -def Literal.toExpr (lit : Literal) : Expr := - mkApp2 (mkConst ``Std.BitVec.ofNat) (mkNatLit lit.n) (mkNatLit lit.value.toNat) - -/-- -Helper function for reducing homogenous unary bitvector operators. --/ -@[inline] def reduceUnary (declName : Name) (arity : Nat) - (op : {n : Nat} → BitVec n → BitVec n) (e : Expr) : SimpM Step := do - unless e.isAppOfArity declName arity do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let v := { v with value := op v.value } - return .done { expr := v.toExpr } - -/-- -Helper function for reducing homogenous binary bitvector operators. --/ -@[inline] def reduceBin (declName : Name) (arity : Nat) - (op : {n : Nat} → BitVec n → BitVec n → BitVec n) (e : Expr) : SimpM Step := do - unless e.isAppOfArity declName arity do return .continue - let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue - let some v₂ ← fromExpr? e.appArg! | return .continue - if h : v₁.n = v₂.n then - trace[Meta.debug] "reduce [{declName}] {v₁.value}, {v₂.value}" - let v := { v₁ with value := op v₁.value (h ▸ v₂.value) } - return .done { expr := v.toExpr } - else - return .continue - -/-- -Helper function for reducing bitvector functions such as `getLsb` and `getMsb`. --/ -@[inline] def reduceGetBit (declName : Name) (op : {n : Nat} → BitVec n → Nat → Bool) (e : Expr) - : SimpM Step := do - unless e.isAppOfArity declName 3 do return .continue - let some v ← fromExpr? e.appFn!.appArg! | return .continue - let some i ← Nat.fromExpr? e.appArg! | return .continue - let b := op v.value i - return .done { expr := toExpr b } - -/-- -Helper function for reducing bitvector functions such as `shiftLeft` and `rotateRight`. --/ -@[inline] def reduceShift (declName : Name) (arity : Nat) - (op : {n : Nat} → BitVec n → Nat → BitVec n) (e : Expr) : SimpM Step := do - unless e.isAppOfArity declName arity do return .continue - let some v ← fromExpr? e.appFn!.appArg! | return .continue - let some i ← Nat.fromExpr? e.appArg! | return .continue - let v := { v with value := op v.value i } - return .done { expr := v.toExpr } - -/-- -Helper function for reducing bitvector predicates. --/ -@[inline] def reduceBinPred (declName : Name) (arity : Nat) - (op : {n : Nat} → BitVec n → BitVec n → Bool) (e : Expr) (isProp := true) : SimpM Step := do - unless e.isAppOfArity declName arity do return .continue - let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue - let some v₂ ← fromExpr? e.appArg! | return .continue - if h : v₁.n = v₂.n then - let b := op v₁.value (h ▸ v₂.value) - if isProp then - evalPropStep e b - else - return .done { expr := toExpr b } - else - return .continue - -/-- Simplification procedure for negation of `BitVec`s. -/ -simproc [simp, seval] reduceNeg ((- _ : BitVec _)) := reduceUnary ``Neg.neg 3 (- ·) -/-- Simplification procedure for bitwise not of `BitVec`s. -/ -simproc [simp, seval] reduceNot ((~~~ _ : BitVec _)) := - reduceUnary ``Complement.complement 3 (~~~ ·) -/-- Simplification procedure for absolute value of `BitVec`s. -/ -simproc [simp, seval] reduceAbs (BitVec.abs _) := reduceUnary ``BitVec.abs 2 BitVec.abs -/-- Simplification procedure for bitwise and of `BitVec`s. -/ -simproc [simp, seval] reduceAnd ((_ &&& _ : BitVec _)) := reduceBin ``HAnd.hAnd 6 (· &&& ·) -/-- Simplification procedure for bitwise or of `BitVec`s. -/ -simproc [simp, seval] reduceOr ((_ ||| _ : BitVec _)) := reduceBin ``HOr.hOr 6 (· ||| ·) -/-- Simplification procedure for bitwise xor of `BitVec`s. -/ -simproc [simp, seval] reduceXOr ((_ ^^^ _ : BitVec _)) := reduceBin ``HXor.hXor 6 (· ^^^ ·) -/-- Simplification procedure for addition of `BitVec`s. -/ -simproc [simp, seval] reduceAdd ((_ + _ : BitVec _)) := reduceBin ``HAdd.hAdd 6 (· + ·) -/-- Simplification procedure for multiplication of `BitVec`s. -/ -simproc [simp, seval] reduceMul ((_ * _ : BitVec _)) := reduceBin ``HMul.hMul 6 (· * ·) -/-- Simplification procedure for subtraction of `BitVec`s. -/ -simproc [simp, seval] reduceSub ((_ - _ : BitVec _)) := reduceBin ``HSub.hSub 6 (· - ·) -/-- Simplification procedure for division of `BitVec`s. -/ -simproc [simp, seval] reduceDiv ((_ / _ : BitVec _)) := reduceBin ``HDiv.hDiv 6 (· / ·) -/-- Simplification procedure for the modulo operation on `BitVec`s. -/ -simproc [simp, seval] reduceMod ((_ % _ : BitVec _)) := reduceBin ``HMod.hMod 6 (· % ·) -/-- Simplification procedure for for the unsigned modulo operation on `BitVec`s. -/ -simproc [simp, seval] reduceUMod ((umod _ _ : BitVec _)) := reduceBin ``umod 3 umod -/-- Simplification procedure for unsigned division of `BitVec`s. -/ -simproc [simp, seval] reduceUDiv ((udiv _ _ : BitVec _)) := reduceBin ``udiv 3 udiv -/-- Simplification procedure for division of `BitVec`s using the SMT-Lib conventions. -/ -simproc [simp, seval] reduceSMTUDiv ((smtUDiv _ _ : BitVec _)) := reduceBin ``smtUDiv 3 smtUDiv -/-- Simplification procedure for the signed modulo operation on `BitVec`s. -/ -simproc [simp, seval] reduceSMod ((smod _ _ : BitVec _)) := reduceBin ``smod 3 smod -/-- Simplification procedure for signed remainder of `BitVec`s. -/ -simproc [simp, seval] reduceSRem ((srem _ _ : BitVec _)) := reduceBin ``srem 3 srem -/-- Simplification procedure for signed t-division of `BitVec`s. -/ -simproc [simp, seval] reduceSDiv ((sdiv _ _ : BitVec _)) := reduceBin ``sdiv 3 sdiv -/-- Simplification procedure for signed division of `BitVec`s using the SMT-Lib conventions. -/ -simproc [simp, seval] reduceSMTSDiv ((smtSDiv _ _ : BitVec _)) := reduceBin ``smtSDiv 3 smtSDiv -/-- Simplification procedure for `getLsb` (lowest significant bit) on `BitVec`. -/ -simproc [simp, seval] reduceGetLsb (getLsb _ _) := reduceGetBit ``getLsb getLsb -/-- Simplification procedure for `getMsb` (most significant bit) on `BitVec`. -/ -simproc [simp, seval] reduceGetMsb (getMsb _ _) := reduceGetBit ``getMsb getMsb - -/-- Simplification procedure for shift left on `BitVec`. -/ -simproc [simp, seval] reduceShiftLeft (BitVec.shiftLeft _ _) := - reduceShift ``BitVec.shiftLeft 3 BitVec.shiftLeft -/-- Simplification procedure for unsigned shift right on `BitVec`. -/ -simproc [simp, seval] reduceUShiftRight (BitVec.ushiftRight _ _) := - reduceShift ``BitVec.ushiftRight 3 BitVec.ushiftRight -/-- Simplification procedure for signed shift right on `BitVec`. -/ -simproc [simp, seval] reduceSShiftRight (BitVec.sshiftRight _ _) := - reduceShift ``BitVec.sshiftRight 3 BitVec.sshiftRight -/-- Simplification procedure for shift left on `BitVec`. -/ -simproc [simp, seval] reduceHShiftLeft ((_ <<< _ : BitVec _)) := - reduceShift ``HShiftLeft.hShiftLeft 6 (· <<< ·) -/-- Simplification procedure for shift right on `BitVec`. -/ -simproc [simp, seval] reduceHShiftRight ((_ >>> _ : BitVec _)) := - reduceShift ``HShiftRight.hShiftRight 6 (· >>> ·) -/-- Simplification procedure for rotate left on `BitVec`. -/ -simproc [simp, seval] reduceRotateLeft (BitVec.rotateLeft _ _) := - reduceShift ``BitVec.rotateLeft 3 BitVec.rotateLeft -/-- Simplification procedure for rotate right on `BitVec`. -/ -simproc [simp, seval] reduceRotateRight (BitVec.rotateRight _ _) := - reduceShift ``BitVec.rotateRight 3 BitVec.rotateRight - -/-- Simplification procedure for append on `BitVec`. -/ -simproc [simp, seval] reduceAppend ((_ ++ _ : BitVec _)) := fun e => do - unless e.isAppOfArity ``HAppend.hAppend 6 do return .continue - let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue - let some v₂ ← fromExpr? e.appArg! | return .continue - let v : Literal := { n := v₁.n + v₂.n, value := v₁.value ++ v₂.value } - return .done { expr := v.toExpr } - -/-- Simplification procedure for casting `BitVec`s along an equality of the size. -/ -simproc [simp, seval] reduceCast (cast _ _) := fun e => do - unless e.isAppOfArity ``cast 4 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some m ← Nat.fromExpr? e.appFn!.appFn!.appArg! | return .continue - let v : Literal := { n := m, value := BitVec.ofNat m v.value.toNat } - return .done { expr := v.toExpr } - -/-- Simplification procedure for `BitVec.toNat`. -/ -simproc [simp, seval] reduceToNat (BitVec.toNat _) := fun e => do - unless e.isAppOfArity ``BitVec.toNat 2 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - return .done { expr := mkNatLit v.value.toNat } - -/-- Simplification procedure for `BitVec.toInt`. -/ -simproc [simp, seval] reduceToInt (BitVec.toInt _) := fun e => do - unless e.isAppOfArity ``BitVec.toInt 2 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - return .done { expr := Int.toExpr v.value.toInt } - -/-- Simplification procedure for `BitVec.ofInt`. -/ -simproc [simp, seval] reduceOfInt (BitVec.ofInt _ _) := fun e => do - unless e.isAppOfArity ``BitVec.ofInt 2 do return .continue - let some n ← Nat.fromExpr? e.appFn!.appArg! | return .continue - let some i ← Int.fromExpr? e.appArg! | return .continue - let lit : Literal := { n, value := BitVec.ofInt n i } - return .done { expr := lit.toExpr } - -/-- Simplification procedure for `<` on `BitVec`s. -/ -simproc [simp, seval] reduceLT (( _ : BitVec _) < _) := reduceBinPred ``LT.lt 4 (· < ·) -/-- Simplification procedure for `≤` on `BitVec`s. -/ -simproc [simp, seval] reduceLE (( _ : BitVec _) ≤ _) := reduceBinPred ``LE.le 4 (. ≤ .) -/-- Simplification procedure for `>` on `BitVec`s. -/ -simproc [simp, seval] reduceGT (( _ : BitVec _) > _) := reduceBinPred ``GT.gt 4 (. > .) -/-- Simplification procedure for `≥` on `BitVec`s. -/ -simproc [simp, seval] reduceGE (( _ : BitVec _) ≥ _) := reduceBinPred ``GE.ge 4 (. ≥ .) - -/-- Simplification procedure for unsigned less than `ult` on `BitVec`s. -/ -simproc [simp, seval] reduceULT (BitVec.ult _ _) := - reduceBinPred ``BitVec.ult 3 BitVec.ult (isProp := false) -/-- Simplification procedure for unsigned less than or equal `ule` on `BitVec`s. -/ -simproc [simp, seval] reduceULE (BitVec.ule _ _) := - reduceBinPred ``BitVec.ule 3 BitVec.ule (isProp := false) -/-- Simplification procedure for signed less than `slt` on `BitVec`s. -/ -simproc [simp, seval] reduceSLT (BitVec.slt _ _) := - reduceBinPred ``BitVec.slt 3 BitVec.slt (isProp := false) -/-- Simplification procedure for signed less than or equal `sle` on `BitVec`s. -/ -simproc [simp, seval] reduceSLE (BitVec.sle _ _) := - reduceBinPred ``BitVec.sle 3 BitVec.sle (isProp := false) - -/-- Simplification procedure for `zeroExtend'` on `BitVec`s. -/ -simproc [simp, seval] reduceZeroExtend' (zeroExtend' _ _) := fun e => do - unless e.isAppOfArity ``zeroExtend' 4 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some w ← Nat.fromExpr? e.appFn!.appFn!.appArg! | return .continue - if h : v.n ≤ w then - let lit : Literal := { n := w, value := v.value.zeroExtend' h } - return .done { expr := lit.toExpr } - else - return .continue - -/-- Simplification procedure for `shiftLeftZeroExtend` on `BitVec`s. -/ -simproc [simp, seval] reduceShiftLeftZeroExtend (shiftLeftZeroExtend _ _) := fun e => do - unless e.isAppOfArity ``shiftLeftZeroExtend 3 do return .continue - let some v ← fromExpr? e.appFn!.appArg! | return .continue - let some m ← Nat.fromExpr? e.appArg! | return .continue - let lit : Literal := { n := v.n + m, value := v.value.shiftLeftZeroExtend m } - return .done { expr := lit.toExpr } - -/-- Simplification procedure for `extractLsb'` on `BitVec`s. -/ -simproc [simp, seval] reduceExtracLsb' (extractLsb' _ _ _) := fun e => do - unless e.isAppOfArity ``extractLsb' 4 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some start ← Nat.fromExpr? e.appFn!.appFn!.appArg! | return .continue - let some len ← Nat.fromExpr? e.appFn!.appArg! | return .continue - let lit : Literal := { n := len, value := v.value.extractLsb' start len } - return .done { expr := lit.toExpr } - -/-- Simplification procedure for `replicate` on `BitVec`s. -/ -simproc [simp, seval] reduceReplicate (replicate _ _) := fun e => do - unless e.isAppOfArity ``replicate 3 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some w ← Nat.fromExpr? e.appFn!.appArg! | return .continue - let lit : Literal := { n := v.n * w, value := v.value.replicate w } - return .done { expr := lit.toExpr } - -/-- Simplification procedure for `zeroExtend` on `BitVec`s. -/ -simproc [simp, seval] reduceZeroExtend (zeroExtend _ _) := fun e => do - unless e.isAppOfArity ``zeroExtend 3 do return .continue - let some v ← fromExpr? e.appArg! | return .continue - let some n ← Nat.fromExpr? e.appFn!.appArg! | return .continue - let lit : Literal := { n, value := v.value.zeroExtend n } - return .done { expr := lit.toExpr } - -end Std.BitVec diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 6fd2666be0..015d8b66f9 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -4,828 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Fin.Basic -import Std.Tactic.Simpa -import Std.Tactic.NormCast.Lemmas -import Std.Tactic.SimpTrace namespace Fin -/-- If you actually have an element of `Fin n`, then the `n` is always positive -/ -theorem size_pos (i : Fin n) : 0 < n := Nat.lt_of_le_of_lt (Nat.zero_le _) i.2 - -theorem mod_def (a m : Fin n) : a % m = Fin.mk (a % m) (Nat.lt_of_le_of_lt (Nat.mod_le _ _) a.2) := - rfl - -theorem mul_def (a b : Fin n) : a * b = Fin.mk ((a * b) % n) (Nat.mod_lt _ a.size_pos) := rfl - -theorem sub_def (a b : Fin n) : a - b = Fin.mk ((a + (n - b)) % n) (Nat.mod_lt _ a.size_pos) := rfl - -theorem size_pos' : ∀ [Nonempty (Fin n)], 0 < n | ⟨i⟩ => i.size_pos - -@[simp] theorem is_lt (a : Fin n) : (a : Nat) < n := a.2 - -theorem pos_iff_nonempty {n : Nat} : 0 < n ↔ Nonempty (Fin n) := - ⟨fun h => ⟨⟨0, h⟩⟩, fun ⟨i⟩ => i.pos⟩ - -/-! ### coercions and constructions -/ - -@[simp] protected theorem eta (a : Fin n) (h : a < n) : (⟨a, h⟩ : Fin n) = a := rfl - -@[ext] theorem ext {a b : Fin n} (h : (a : Nat) = b) : a = b := eq_of_val_eq h - -theorem val_inj {a b : Fin n} : a.1 = b.1 ↔ a = b := ⟨Fin.eq_of_val_eq, Fin.val_eq_of_eq⟩ - -theorem ext_iff {a b : Fin n} : a = b ↔ a.1 = b.1 := val_inj.symm - -theorem val_ne_iff {a b : Fin n} : a.1 ≠ b.1 ↔ a ≠ b := not_congr val_inj - -theorem exists_iff {p : Fin n → Prop} : (∃ i, p i) ↔ ∃ i h, p ⟨i, h⟩ := - ⟨fun ⟨⟨i, hi⟩, hpi⟩ => ⟨i, hi, hpi⟩, fun ⟨i, hi, hpi⟩ => ⟨⟨i, hi⟩, hpi⟩⟩ - -theorem forall_iff {p : Fin n → Prop} : (∀ i, p i) ↔ ∀ i h, p ⟨i, h⟩ := - ⟨fun h i hi => h ⟨i, hi⟩, fun h ⟨i, hi⟩ => h i hi⟩ - -protected theorem mk.inj_iff {n a b : Nat} {ha : a < n} {hb : b < n} : - (⟨a, ha⟩ : Fin n) = ⟨b, hb⟩ ↔ a = b := ext_iff - -theorem val_mk {m n : Nat} (h : m < n) : (⟨m, h⟩ : Fin n).val = m := rfl - -theorem eq_mk_iff_val_eq {a : Fin n} {k : Nat} {hk : k < n} : - a = ⟨k, hk⟩ ↔ (a : Nat) = k := ext_iff - -theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta .. - -@[simp] theorem val_ofNat' (a : Nat) (is_pos : n > 0) : - (Fin.ofNat' a is_pos).val = a % n := rfl - -@[deprecated ofNat'_zero_val] theorem ofNat'_zero_val : (Fin.ofNat' 0 h).val = 0 := Nat.zero_mod _ - -@[simp] theorem mod_val (a b : Fin n) : (a % b).val = a.val % b.val := - rfl - -@[simp] theorem div_val (a b : Fin n) : (a / b).val = a.val / b.val := - rfl - -@[simp] theorem modn_val (a : Fin n) (b : Nat) : (a.modn b).val = a.val % b := - rfl - -theorem ite_val {n : Nat} {c : Prop} [Decidable c] {x : c → Fin n} (y : ¬c → Fin n) : - (if h : c then x h else y h).val = if h : c then (x h).val else (y h).val := by - by_cases c <;> simp [*] - -theorem dite_val {n : Nat} {c : Prop} [Decidable c] {x y : Fin n} : - (if c then x else y).val = if c then x.val else y.val := by - by_cases c <;> simp [*] - -/-! ### order -/ - -theorem le_def {a b : Fin n} : a ≤ b ↔ a.1 ≤ b.1 := .rfl - -theorem lt_def {a b : Fin n} : a < b ↔ a.1 < b.1 := .rfl - -theorem lt_iff_val_lt_val {a b : Fin n} : a < b ↔ a.val < b.val := Iff.rfl - -@[simp] protected theorem not_le {a b : Fin n} : ¬ a ≤ b ↔ b < a := Nat.not_le - -@[simp] protected theorem not_lt {a b : Fin n} : ¬ a < b ↔ b ≤ a := Nat.not_lt - -protected theorem ne_of_lt {a b : Fin n} (h : a < b) : a ≠ b := Fin.ne_of_val_ne (Nat.ne_of_lt h) - -protected theorem ne_of_gt {a b : Fin n} (h : a < b) : b ≠ a := Fin.ne_of_val_ne (Nat.ne_of_gt h) - -protected theorem le_of_lt {a b : Fin n} (h : a < b) : a ≤ b := Nat.le_of_lt h - -theorem is_le (i : Fin (n + 1)) : i ≤ n := Nat.le_of_lt_succ i.is_lt - -@[simp] theorem is_le' {a : Fin n} : a ≤ n := Nat.le_of_lt a.is_lt - -theorem mk_lt_of_lt_val {b : Fin n} {a : Nat} (h : a < b) : - (⟨a, Nat.lt_trans h b.is_lt⟩ : Fin n) < b := h - -theorem mk_le_of_le_val {b : Fin n} {a : Nat} (h : a ≤ b) : - (⟨a, Nat.lt_of_le_of_lt h b.is_lt⟩ : Fin n) ≤ b := h - -@[simp] theorem mk_le_mk {x y : Nat} {hx hy} : (⟨x, hx⟩ : Fin n) ≤ ⟨y, hy⟩ ↔ x ≤ y := .rfl - -@[simp] theorem mk_lt_mk {x y : Nat} {hx hy} : (⟨x, hx⟩ : Fin n) < ⟨y, hy⟩ ↔ x < y := .rfl - -@[simp] theorem val_zero (n : Nat) : (0 : Fin (n + 1)).1 = 0 := rfl - -@[simp] theorem mk_zero : (⟨0, Nat.succ_pos n⟩ : Fin (n + 1)) = 0 := rfl - -@[simp] theorem zero_le (a : Fin (n + 1)) : 0 ≤ a := Nat.zero_le a.val - -theorem zero_lt_one : (0 : Fin (n + 2)) < 1 := Nat.zero_lt_one - -@[simp] theorem not_lt_zero (a : Fin (n + 1)) : ¬a < 0 := nofun - -theorem pos_iff_ne_zero {a : Fin (n + 1)} : 0 < a ↔ a ≠ 0 := by - rw [lt_def, val_zero, Nat.pos_iff_ne_zero, ← val_ne_iff]; rfl - -theorem eq_zero_or_eq_succ {n : Nat} : ∀ i : Fin (n + 1), i = 0 ∨ ∃ j : Fin n, i = j.succ - | 0 => .inl rfl - | ⟨j + 1, h⟩ => .inr ⟨⟨j, Nat.lt_of_succ_lt_succ h⟩, rfl⟩ - -theorem eq_succ_of_ne_zero {n : Nat} {i : Fin (n + 1)} (hi : i ≠ 0) : ∃ j : Fin n, i = j.succ := - (eq_zero_or_eq_succ i).resolve_left hi - -@[simp] theorem val_rev (i : Fin n) : rev i = n - (i + 1) := rfl - -@[simp] theorem rev_rev (i : Fin n) : rev (rev i) = i := ext <| by - rw [val_rev, val_rev, ← Nat.sub_sub, Nat.sub_sub_self (by exact i.2), Nat.add_sub_cancel] - -@[simp] theorem rev_le_rev {i j : Fin n} : rev i ≤ rev j ↔ j ≤ i := by - simp only [le_def, val_rev, Nat.sub_le_sub_iff_left (Nat.succ_le.2 j.is_lt)] - exact Nat.succ_le_succ_iff - -@[simp] theorem rev_inj {i j : Fin n} : rev i = rev j ↔ i = j := - ⟨fun h => by simpa using congrArg rev h, congrArg _⟩ - -theorem rev_eq {n a : Nat} (i : Fin (n + 1)) (h : n = a + i) : - rev i = ⟨a, Nat.lt_succ_of_le (h ▸ Nat.le_add_right ..)⟩ := by - ext; dsimp - conv => lhs; congr; rw [h] - rw [Nat.add_assoc, Nat.add_sub_cancel] - -@[simp] theorem rev_lt_rev {i j : Fin n} : rev i < rev j ↔ j < i := by - rw [← Fin.not_le, ← Fin.not_le, rev_le_rev] - -@[simp, norm_cast] theorem val_last (n : Nat) : last n = n := rfl - -theorem le_last (i : Fin (n + 1)) : i ≤ last n := Nat.le_of_lt_succ i.is_lt - -theorem last_pos : (0 : Fin (n + 2)) < last (n + 1) := Nat.succ_pos _ - -theorem eq_last_of_not_lt {i : Fin (n + 1)} (h : ¬(i : Nat) < n) : i = last n := - ext <| Nat.le_antisymm (le_last i) (Nat.not_lt.1 h) - -theorem val_lt_last {i : Fin (n + 1)} : i ≠ last n → (i : Nat) < n := - Decidable.not_imp_comm.1 eq_last_of_not_lt - -@[simp] theorem rev_last (n : Nat) : rev (last n) = 0 := ext <| by simp - -@[simp] theorem rev_zero (n : Nat) : rev 0 = last n := by - rw [← rev_rev (last _), rev_last] - -/-! ### addition, numerals, and coercion from Nat -/ - -@[simp] theorem val_one (n : Nat) : (1 : Fin (n + 2)).val = 1 := rfl - -@[simp] theorem mk_one : (⟨1, Nat.succ_lt_succ (Nat.succ_pos n)⟩ : Fin (n + 2)) = (1 : Fin _) := rfl - -theorem subsingleton_iff_le_one : Subsingleton (Fin n) ↔ n ≤ 1 := by - (match n with | 0 | 1 | n+2 => ?_) <;> try simp - · exact ⟨nofun⟩ - · exact ⟨fun ⟨0, _⟩ ⟨0, _⟩ => rfl⟩ - · exact iff_of_false (fun h => Fin.ne_of_lt zero_lt_one (h.elim ..)) (of_decide_eq_false rfl) - -instance subsingleton_zero : Subsingleton (Fin 0) := subsingleton_iff_le_one.2 (by decide) - -instance subsingleton_one : Subsingleton (Fin 1) := subsingleton_iff_le_one.2 (by decide) - -theorem fin_one_eq_zero (a : Fin 1) : a = 0 := Subsingleton.elim a 0 - -theorem add_def (a b : Fin n) : a + b = Fin.mk ((a + b) % n) (Nat.mod_lt _ a.size_pos) := rfl - -theorem val_add (a b : Fin n) : (a + b).val = (a.val + b.val) % n := rfl - -theorem val_add_one_of_lt {n : Nat} {i : Fin n.succ} (h : i < last _) : (i + 1).1 = i + 1 := by - match n with - | 0 => cases h - | n+1 => rw [val_add, val_one, Nat.mod_eq_of_lt (by exact Nat.succ_lt_succ h)] - -@[simp] theorem last_add_one : ∀ n, last n + 1 = 0 - | 0 => rfl - | n + 1 => by ext; rw [val_add, val_zero, val_last, val_one, Nat.mod_self] - -theorem val_add_one {n : Nat} (i : Fin (n + 1)) : - ((i + 1 : Fin (n + 1)) : Nat) = if i = last _ then (0 : Nat) else i + 1 := by - match Nat.eq_or_lt_of_le (le_last i) with - | .inl h => cases Fin.eq_of_val_eq h; simp - | .inr h => simpa [Fin.ne_of_lt h] using val_add_one_of_lt h - -@[simp] theorem val_two {n : Nat} : (2 : Fin (n + 3)).val = 2 := rfl - -theorem add_one_pos (i : Fin (n + 1)) (h : i < Fin.last n) : (0 : Fin (n + 1)) < i + 1 := by - match n with - | 0 => cases h - | n+1 => - rw [Fin.lt_def, val_last, ← Nat.add_lt_add_iff_right] at h - rw [Fin.lt_def, val_add, val_zero, val_one, Nat.mod_eq_of_lt h] - exact Nat.zero_lt_succ _ - -theorem one_pos : (0 : Fin (n + 2)) < 1 := Nat.succ_pos 0 - -theorem zero_ne_one : (0 : Fin (n + 2)) ≠ 1 := Fin.ne_of_lt one_pos - -/-! ### succ and casts into larger Fin types -/ - -@[simp] theorem val_succ (j : Fin n) : (j.succ : Nat) = j + 1 := rfl - -@[simp] theorem succ_pos (a : Fin n) : (0 : Fin (n + 1)) < a.succ := by - simp [Fin.lt_def, Nat.succ_pos] - -@[simp] theorem succ_le_succ_iff {a b : Fin n} : a.succ ≤ b.succ ↔ a ≤ b := Nat.succ_le_succ_iff - -@[simp] theorem succ_lt_succ_iff {a b : Fin n} : a.succ < b.succ ↔ a < b := Nat.succ_lt_succ_iff - -@[simp] theorem succ_inj {a b : Fin n} : a.succ = b.succ ↔ a = b := by - refine ⟨fun h => ext ?_, congrArg _⟩ - apply Nat.le_antisymm <;> exact succ_le_succ_iff.1 (h ▸ Nat.le_refl _) - -theorem succ_ne_zero {n} : ∀ k : Fin n, Fin.succ k ≠ 0 - | ⟨k, _⟩, heq => Nat.succ_ne_zero k <| ext_iff.1 heq - -@[simp] theorem succ_zero_eq_one : Fin.succ (0 : Fin (n + 1)) = 1 := rfl - -/-- Version of `succ_one_eq_two` to be used by `dsimp` -/ -@[simp] theorem succ_one_eq_two : Fin.succ (1 : Fin (n + 2)) = 2 := rfl - -@[simp] theorem succ_mk (n i : Nat) (h : i < n) : - Fin.succ ⟨i, h⟩ = ⟨i + 1, Nat.succ_lt_succ h⟩ := rfl - -theorem mk_succ_pos (i : Nat) (h : i < n) : - (0 : Fin (n + 1)) < ⟨i.succ, Nat.add_lt_add_right h 1⟩ := by - rw [lt_def, val_zero]; exact Nat.succ_pos i - -theorem one_lt_succ_succ (a : Fin n) : (1 : Fin (n + 2)) < a.succ.succ := by - let n+1 := n - rw [← succ_zero_eq_one, succ_lt_succ_iff]; exact succ_pos a - -@[simp] theorem add_one_lt_iff {n : Nat} {k : Fin (n + 2)} : k + 1 < k ↔ k = last _ := by - simp only [lt_def, val_add, val_last, ext_iff] - let ⟨k, hk⟩ := k - match Nat.eq_or_lt_of_le (Nat.le_of_lt_succ hk) with - | .inl h => cases h; simp [Nat.succ_pos] - | .inr hk' => simp [Nat.ne_of_lt hk', Nat.mod_eq_of_lt (Nat.succ_lt_succ hk'), Nat.le_succ] - -@[simp] theorem add_one_le_iff {n : Nat} : ∀ {k : Fin (n + 1)}, k + 1 ≤ k ↔ k = last _ := by - match n with - | 0 => - intro (k : Fin 1) - exact iff_of_true (Subsingleton.elim (α := Fin 1) (k+1) _ ▸ Nat.le_refl _) (fin_one_eq_zero ..) - | n + 1 => - intro (k : Fin (n+2)) - rw [← add_one_lt_iff, lt_def, le_def, Nat.lt_iff_le_and_ne, and_iff_left] - rw [val_add_one] - split <;> simp [*, (Nat.succ_ne_zero _).symm, Nat.ne_of_gt (Nat.lt_succ_self _)] - -@[simp] theorem last_le_iff {n : Nat} {k : Fin (n + 1)} : last n ≤ k ↔ k = last n := by - rw [ext_iff, Nat.le_antisymm_iff, le_def, and_iff_right (by apply le_last)] - -@[simp] theorem lt_add_one_iff {n : Nat} {k : Fin (n + 1)} : k < k + 1 ↔ k < last n := by - rw [← Decidable.not_iff_not]; simp - -@[simp] theorem le_zero_iff {n : Nat} {k : Fin (n + 1)} : k ≤ 0 ↔ k = 0 := - ⟨fun h => Fin.eq_of_val_eq <| Nat.eq_zero_of_le_zero h, (· ▸ Nat.le_refl _)⟩ - -theorem succ_succ_ne_one (a : Fin n) : Fin.succ (Fin.succ a) ≠ 1 := - Fin.ne_of_gt (one_lt_succ_succ a) - -@[simp] theorem coe_castLT (i : Fin m) (h : i.1 < n) : (castLT i h : Nat) = i := rfl - -@[simp] theorem castLT_mk (i n m : Nat) (hn : i < n) (hm : i < m) : castLT ⟨i, hn⟩ hm = ⟨i, hm⟩ := - rfl - -@[simp] theorem coe_castLE (h : n ≤ m) (i : Fin n) : (castLE h i : Nat) = i := rfl - -@[simp] theorem castLE_mk (i n m : Nat) (hn : i < n) (h : n ≤ m) : - castLE h ⟨i, hn⟩ = ⟨i, Nat.lt_of_lt_of_le hn h⟩ := rfl - -@[simp] theorem castLE_zero {n m : Nat} (h : n.succ ≤ m.succ) : castLE h 0 = 0 := by simp [ext_iff] - -@[simp] theorem castLE_succ {m n : Nat} (h : m + 1 ≤ n + 1) (i : Fin m) : - castLE h i.succ = (castLE (Nat.succ_le_succ_iff.mp h) i).succ := by simp [ext_iff] - -@[simp] theorem castLE_castLE {k m n} (km : k ≤ m) (mn : m ≤ n) (i : Fin k) : - Fin.castLE mn (Fin.castLE km i) = Fin.castLE (Nat.le_trans km mn) i := - Fin.ext (by simp only [coe_castLE]) - -@[simp] theorem castLE_comp_castLE {k m n} (km : k ≤ m) (mn : m ≤ n) : - Fin.castLE mn ∘ Fin.castLE km = Fin.castLE (Nat.le_trans km mn) := - funext (castLE_castLE km mn) - -@[simp] theorem coe_cast (h : n = m) (i : Fin n) : (cast h i : Nat) = i := rfl - -@[simp] theorem cast_last {n' : Nat} {h : n + 1 = n' + 1} : cast h (last n) = last n' := - ext (by rw [coe_cast, val_last, val_last, Nat.succ.inj h]) - -@[simp] theorem cast_mk (h : n = m) (i : Nat) (hn : i < n) : cast h ⟨i, hn⟩ = ⟨i, h ▸ hn⟩ := rfl - -@[simp] theorem cast_trans {k : Nat} (h : n = m) (h' : m = k) {i : Fin n} : - cast h' (cast h i) = cast (Eq.trans h h') i := rfl - -theorem castLE_of_eq {m n : Nat} (h : m = n) {h' : m ≤ n} : castLE h' = Fin.cast h := rfl - -@[simp] theorem coe_castAdd (m : Nat) (i : Fin n) : (castAdd m i : Nat) = i := rfl - -@[simp] theorem castAdd_zero : (castAdd 0 : Fin n → Fin (n + 0)) = cast rfl := rfl - -theorem castAdd_lt {m : Nat} (n : Nat) (i : Fin m) : (castAdd n i : Nat) < m := by simp - -@[simp] theorem castAdd_mk (m : Nat) (i : Nat) (h : i < n) : - castAdd m ⟨i, h⟩ = ⟨i, Nat.lt_add_right m h⟩ := rfl - -@[simp] theorem castAdd_castLT (m : Nat) (i : Fin (n + m)) (hi : i.val < n) : - castAdd m (castLT i hi) = i := rfl - -@[simp] theorem castLT_castAdd (m : Nat) (i : Fin n) : - castLT (castAdd m i) (castAdd_lt m i) = i := rfl - -/-- For rewriting in the reverse direction, see `Fin.cast_castAdd_left`. -/ -theorem castAdd_cast {n n' : Nat} (m : Nat) (i : Fin n') (h : n' = n) : - castAdd m (Fin.cast h i) = Fin.cast (congrArg (. + m) h) (castAdd m i) := ext rfl - -theorem cast_castAdd_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) : - cast h (castAdd m i) = castAdd m (cast (Nat.add_right_cancel h) i) := rfl - -@[simp] theorem cast_castAdd_right {n m m' : Nat} (i : Fin n) (h : n + m' = n + m) : - cast h (castAdd m' i) = castAdd m i := rfl - -theorem castAdd_castAdd {m n p : Nat} (i : Fin m) : - castAdd p (castAdd n i) = cast (Nat.add_assoc ..).symm (castAdd (n + p) i) := rfl - -/-- The cast of the successor is the successor of the cast. See `Fin.succ_cast_eq` for rewriting in -the reverse direction. -/ -@[simp] theorem cast_succ_eq {n' : Nat} (i : Fin n) (h : n.succ = n'.succ) : - cast h i.succ = (cast (Nat.succ.inj h) i).succ := rfl - -theorem succ_cast_eq {n' : Nat} (i : Fin n) (h : n = n') : - (cast h i).succ = cast (by rw [h]) i.succ := rfl - -@[simp] theorem coe_castSucc (i : Fin n) : (Fin.castSucc i : Nat) = i := rfl - -@[simp] theorem castSucc_mk (n i : Nat) (h : i < n) : castSucc ⟨i, h⟩ = ⟨i, Nat.lt.step h⟩ := rfl - -@[simp] theorem cast_castSucc {n' : Nat} {h : n + 1 = n' + 1} {i : Fin n} : - cast h (castSucc i) = castSucc (cast (Nat.succ.inj h) i) := rfl - -theorem castSucc_lt_succ (i : Fin n) : Fin.castSucc i < i.succ := - lt_def.2 <| by simp only [coe_castSucc, val_succ, Nat.lt_succ_self] - -theorem le_castSucc_iff {i : Fin (n + 1)} {j : Fin n} : i ≤ Fin.castSucc j ↔ i < j.succ := by - simpa [lt_def, le_def] using Nat.succ_le_succ_iff.symm - -theorem castSucc_lt_iff_succ_le {n : Nat} {i : Fin n} {j : Fin (n + 1)} : - Fin.castSucc i < j ↔ i.succ ≤ j := .rfl - -@[simp] theorem succ_last (n : Nat) : (last n).succ = last n.succ := rfl - -@[simp] theorem succ_eq_last_succ {n : Nat} (i : Fin n.succ) : - i.succ = last (n + 1) ↔ i = last n := by rw [← succ_last, succ_inj] - -@[simp] theorem castSucc_castLT (i : Fin (n + 1)) (h : (i : Nat) < n) : - castSucc (castLT i h) = i := rfl - -@[simp] theorem castLT_castSucc {n : Nat} (a : Fin n) (h : (a : Nat) < n) : - castLT (castSucc a) h = a := rfl - -@[simp] theorem castSucc_lt_castSucc_iff {a b : Fin n} : - Fin.castSucc a < Fin.castSucc b ↔ a < b := .rfl - -theorem castSucc_inj {a b : Fin n} : castSucc a = castSucc b ↔ a = b := by simp [ext_iff] - -theorem castSucc_lt_last (a : Fin n) : castSucc a < last n := a.is_lt - -@[simp] theorem castSucc_zero : castSucc (0 : Fin (n + 1)) = 0 := rfl - -@[simp] theorem castSucc_one {n : Nat} : castSucc (1 : Fin (n + 2)) = 1 := rfl - -/-- `castSucc i` is positive when `i` is positive -/ -theorem castSucc_pos {i : Fin (n + 1)} (h : 0 < i) : 0 < castSucc i := by - simpa [lt_def] using h - -@[simp] theorem castSucc_eq_zero_iff (a : Fin (n + 1)) : castSucc a = 0 ↔ a = 0 := by simp [ext_iff] - -theorem castSucc_ne_zero_iff (a : Fin (n + 1)) : castSucc a ≠ 0 ↔ a ≠ 0 := - not_congr <| castSucc_eq_zero_iff a - -theorem castSucc_fin_succ (n : Nat) (j : Fin n) : - castSucc (Fin.succ j) = Fin.succ (castSucc j) := by simp [Fin.ext_iff] - -@[simp] -theorem coeSucc_eq_succ {a : Fin n} : castSucc a + 1 = a.succ := by - cases n - · exact a.elim0 - · simp [ext_iff, add_def, Nat.mod_eq_of_lt (Nat.succ_lt_succ a.is_lt)] - -theorem lt_succ {a : Fin n} : castSucc a < a.succ := by - rw [castSucc, lt_def, coe_castAdd, val_succ]; exact Nat.lt_succ_self a.val - -theorem exists_castSucc_eq {n : Nat} {i : Fin (n + 1)} : (∃ j, castSucc j = i) ↔ i ≠ last n := - ⟨fun ⟨j, hj⟩ => hj ▸ Fin.ne_of_lt j.castSucc_lt_last, - fun hi => ⟨i.castLT <| Fin.val_lt_last hi, rfl⟩⟩ - -theorem succ_castSucc {n : Nat} (i : Fin n) : i.castSucc.succ = castSucc i.succ := rfl - -@[simp] theorem coe_addNat (m : Nat) (i : Fin n) : (addNat i m : Nat) = i + m := rfl - -@[simp] theorem addNat_one {i : Fin n} : addNat i 1 = i.succ := rfl - -theorem le_coe_addNat (m : Nat) (i : Fin n) : m ≤ addNat i m := - Nat.le_add_left _ _ - -@[simp] theorem addNat_mk (n i : Nat) (hi : i < m) : - addNat ⟨i, hi⟩ n = ⟨i + n, Nat.add_lt_add_right hi n⟩ := rfl - -@[simp] theorem cast_addNat_zero {n n' : Nat} (i : Fin n) (h : n + 0 = n') : - cast h (addNat i 0) = cast ((Nat.add_zero _).symm.trans h) i := rfl - -/-- For rewriting in the reverse direction, see `Fin.cast_addNat_left`. -/ -theorem addNat_cast {n n' m : Nat} (i : Fin n') (h : n' = n) : - addNat (cast h i) m = cast (congrArg (. + m) h) (addNat i m) := rfl - -theorem cast_addNat_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) : - cast h (addNat i m) = addNat (cast (Nat.add_right_cancel h) i) m := rfl - -@[simp] theorem cast_addNat_right {n m m' : Nat} (i : Fin n) (h : n + m' = n + m) : - cast h (addNat i m') = addNat i m := - ext <| (congrArg ((· + ·) (i : Nat)) (Nat.add_left_cancel h) : _) - -@[simp] theorem coe_natAdd (n : Nat) {m : Nat} (i : Fin m) : (natAdd n i : Nat) = n + i := rfl - -@[simp] theorem natAdd_mk (n i : Nat) (hi : i < m) : - natAdd n ⟨i, hi⟩ = ⟨n + i, Nat.add_lt_add_left hi n⟩ := rfl - -theorem le_coe_natAdd (m : Nat) (i : Fin n) : m ≤ natAdd m i := Nat.le_add_right .. - -theorem natAdd_zero {n : Nat} : natAdd 0 = cast (Nat.zero_add n).symm := by ext; simp - -/-- For rewriting in the reverse direction, see `Fin.cast_natAdd_right`. -/ -theorem natAdd_cast {n n' : Nat} (m : Nat) (i : Fin n') (h : n' = n) : - natAdd m (cast h i) = cast (congrArg _ h) (natAdd m i) := rfl - -theorem cast_natAdd_right {n n' m : Nat} (i : Fin n') (h : m + n' = m + n) : - cast h (natAdd m i) = natAdd m (cast (Nat.add_left_cancel h) i) := rfl - -@[simp] theorem cast_natAdd_left {n m m' : Nat} (i : Fin n) (h : m' + n = m + n) : - cast h (natAdd m' i) = natAdd m i := - ext <| (congrArg (· + (i : Nat)) (Nat.add_right_cancel h) : _) - -theorem castAdd_natAdd (p m : Nat) {n : Nat} (i : Fin n) : - castAdd p (natAdd m i) = cast (Nat.add_assoc ..).symm (natAdd m (castAdd p i)) := rfl - -theorem natAdd_castAdd (p m : Nat) {n : Nat} (i : Fin n) : - natAdd m (castAdd p i) = cast (Nat.add_assoc ..) (castAdd p (natAdd m i)) := rfl - -theorem natAdd_natAdd (m n : Nat) {p : Nat} (i : Fin p) : - natAdd m (natAdd n i) = cast (Nat.add_assoc ..) (natAdd (m + n) i) := - ext <| (Nat.add_assoc ..).symm - -@[simp] -theorem cast_natAdd_zero {n n' : Nat} (i : Fin n) (h : 0 + n = n') : - cast h (natAdd 0 i) = cast ((Nat.zero_add _).symm.trans h) i := - ext <| Nat.zero_add _ - -@[simp] -theorem cast_natAdd (n : Nat) {m : Nat} (i : Fin m) : - cast (Nat.add_comm ..) (natAdd n i) = addNat i n := ext <| Nat.add_comm .. - -@[simp] -theorem cast_addNat {n : Nat} (m : Nat) (i : Fin n) : - cast (Nat.add_comm ..) (addNat i m) = natAdd m i := ext <| Nat.add_comm .. - -@[simp] theorem natAdd_last {m n : Nat} : natAdd n (last m) = last (n + m) := rfl - -theorem natAdd_castSucc {m n : Nat} {i : Fin m} : natAdd n (castSucc i) = castSucc (natAdd n i) := - rfl - -theorem rev_castAdd (k : Fin n) (m : Nat) : rev (castAdd m k) = addNat (rev k) m := ext <| by - rw [val_rev, coe_castAdd, coe_addNat, val_rev, Nat.sub_add_comm (Nat.succ_le_of_lt k.is_lt)] - -theorem rev_addNat (k : Fin n) (m : Nat) : rev (addNat k m) = castAdd m (rev k) := by - rw [← rev_rev (castAdd ..), rev_castAdd, rev_rev] - -theorem rev_castSucc (k : Fin n) : rev (castSucc k) = succ (rev k) := k.rev_castAdd 1 - -theorem rev_succ (k : Fin n) : rev (succ k) = castSucc (rev k) := k.rev_addNat 1 - -/-! ### pred -/ - -@[simp] theorem coe_pred (j : Fin (n + 1)) (h : j ≠ 0) : (j.pred h : Nat) = j - 1 := rfl - -@[simp] theorem succ_pred : ∀ (i : Fin (n + 1)) (h : i ≠ 0), (i.pred h).succ = i - | ⟨0, h⟩, hi => by simp only [mk_zero, ne_eq, not_true] at hi - | ⟨n + 1, h⟩, hi => rfl - -@[simp] -theorem pred_succ (i : Fin n) {h : i.succ ≠ 0} : i.succ.pred h = i := by - cases i - rfl - -theorem pred_eq_iff_eq_succ {n : Nat} (i : Fin (n + 1)) (hi : i ≠ 0) (j : Fin n) : - i.pred hi = j ↔ i = j.succ := - ⟨fun h => by simp only [← h, Fin.succ_pred], fun h => by simp only [h, Fin.pred_succ]⟩ - -theorem pred_mk_succ (i : Nat) (h : i < n + 1) : - Fin.pred ⟨i + 1, Nat.add_lt_add_right h 1⟩ (ne_of_val_ne (Nat.ne_of_gt (mk_succ_pos i h))) = - ⟨i, h⟩ := by - simp only [ext_iff, coe_pred, Nat.add_sub_cancel] - -@[simp] theorem pred_mk_succ' (i : Nat) (h₁ : i + 1 < n + 1 + 1) (h₂) : - Fin.pred ⟨i + 1, h₁⟩ h₂ = ⟨i, Nat.lt_of_succ_lt_succ h₁⟩ := pred_mk_succ i _ - --- This is not a simp theorem by default, because `pred_mk_succ` is nicer when it applies. -theorem pred_mk {n : Nat} (i : Nat) (h : i < n + 1) (w) : Fin.pred ⟨i, h⟩ w = - ⟨i - 1, Nat.sub_lt_right_of_lt_add (Nat.pos_iff_ne_zero.2 (Fin.val_ne_of_ne w)) h⟩ := - rfl - -@[simp] theorem pred_le_pred_iff {n : Nat} {a b : Fin n.succ} {ha : a ≠ 0} {hb : b ≠ 0} : - a.pred ha ≤ b.pred hb ↔ a ≤ b := by rw [← succ_le_succ_iff, succ_pred, succ_pred] - -@[simp] theorem pred_lt_pred_iff {n : Nat} {a b : Fin n.succ} {ha : a ≠ 0} {hb : b ≠ 0} : - a.pred ha < b.pred hb ↔ a < b := by rw [← succ_lt_succ_iff, succ_pred, succ_pred] - -@[simp] theorem pred_inj : - ∀ {a b : Fin (n + 1)} {ha : a ≠ 0} {hb : b ≠ 0}, a.pred ha = b.pred hb ↔ a = b - | ⟨0, _⟩, _, ha, _ => by simp only [mk_zero, ne_eq, not_true] at ha - | ⟨i + 1, _⟩, ⟨0, _⟩, _, hb => by simp only [mk_zero, ne_eq, not_true] at hb - | ⟨i + 1, hi⟩, ⟨j + 1, hj⟩, ha, hb => by simp [ext_iff] - -@[simp] theorem pred_one {n : Nat} : - Fin.pred (1 : Fin (n + 2)) (Ne.symm (Fin.ne_of_lt one_pos)) = 0 := rfl - -theorem pred_add_one (i : Fin (n + 2)) (h : (i : Nat) < n + 1) : - pred (i + 1) (Fin.ne_of_gt (add_one_pos _ (lt_def.2 h))) = castLT i h := by - rw [ext_iff, coe_pred, coe_castLT, val_add, val_one, Nat.mod_eq_of_lt, Nat.add_sub_cancel] - exact Nat.add_lt_add_right h 1 - -@[simp] theorem coe_subNat (i : Fin (n + m)) (h : m ≤ i) : (i.subNat m h : Nat) = i - m := rfl - -@[simp] theorem subNat_mk {i : Nat} (h₁ : i < n + m) (h₂ : m ≤ i) : - subNat m ⟨i, h₁⟩ h₂ = ⟨i - m, Nat.sub_lt_right_of_lt_add h₂ h₁⟩ := rfl - -@[simp] theorem pred_castSucc_succ (i : Fin n) : - pred (castSucc i.succ) (Fin.ne_of_gt (castSucc_pos i.succ_pos)) = castSucc i := rfl - -@[simp] theorem addNat_subNat {i : Fin (n + m)} (h : m ≤ i) : addNat (subNat m i h) m = i := - ext <| Nat.sub_add_cancel h - -@[simp] theorem subNat_addNat (i : Fin n) (m : Nat) (h : m ≤ addNat i m := le_coe_addNat m i) : - subNat m (addNat i m) h = i := ext <| Nat.add_sub_cancel i m - -@[simp] theorem natAdd_subNat_cast {i : Fin (n + m)} (h : n ≤ i) : - natAdd n (subNat n (cast (Nat.add_comm ..) i) h) = i := by simp [← cast_addNat]; rfl - -/-! ### recursion and induction principles -/ - -/-- Define `motive n i` by induction on `i : Fin n` interpreted as `(0 : Fin (n - i)).succ.succ…`. -This function has two arguments: `zero n` defines `0`-th element `motive (n+1) 0` of an -`(n+1)`-tuple, and `succ n i` defines `(i+1)`-st element of `(n+1)`-tuple based on `n`, `i`, and -`i`-th element of `n`-tuple. -/ --- FIXME: Performance review -@[elab_as_elim] def succRec {motive : ∀ n, Fin n → Sort _} - (zero : ∀ n, motive n.succ (0 : Fin (n + 1))) - (succ : ∀ n i, motive n i → motive n.succ i.succ) : ∀ {n : Nat} (i : Fin n), motive n i - | 0, i => i.elim0 - | Nat.succ n, ⟨0, _⟩ => by rw [mk_zero]; exact zero n - | Nat.succ _, ⟨Nat.succ i, h⟩ => succ _ _ (succRec zero succ ⟨i, Nat.lt_of_succ_lt_succ h⟩) - -/-- Define `motive n i` by induction on `i : Fin n` interpreted as `(0 : Fin (n - i)).succ.succ…`. -This function has two arguments: -`zero n` defines the `0`-th element `motive (n+1) 0` of an `(n+1)`-tuple, and -`succ n i` defines the `(i+1)`-st element of an `(n+1)`-tuple based on `n`, `i`, -and the `i`-th element of an `n`-tuple. - -A version of `Fin.succRec` taking `i : Fin n` as the first argument. -/ --- FIXME: Performance review -@[elab_as_elim] def succRecOn {n : Nat} (i : Fin n) {motive : ∀ n, Fin n → Sort _} - (zero : ∀ n, motive (n + 1) 0) (succ : ∀ n i, motive n i → motive (Nat.succ n) i.succ) : - motive n i := i.succRec zero succ - -@[simp] theorem succRecOn_zero {motive : ∀ n, Fin n → Sort _} {zero succ} (n) : - @Fin.succRecOn (n + 1) 0 motive zero succ = zero n := by - cases n <;> rfl - -@[simp] theorem succRecOn_succ {motive : ∀ n, Fin n → Sort _} {zero succ} {n} (i : Fin n) : - @Fin.succRecOn (n + 1) i.succ motive zero succ = succ n i (Fin.succRecOn i zero succ) := by - cases i; rfl - -/-- Define `motive i` by induction on `i : Fin (n + 1)` via induction on the underlying `Nat` value. -This function has two arguments: `zero` handles the base case on `motive 0`, -and `succ` defines the inductive step using `motive i.castSucc`. --/ --- FIXME: Performance review -@[elab_as_elim] def induction {motive : Fin (n + 1) → Sort _} (zero : motive 0) - (succ : ∀ i : Fin n, motive (castSucc i) → motive i.succ) : - ∀ i : Fin (n + 1), motive i - | ⟨0, hi⟩ => by rwa [Fin.mk_zero] - | ⟨i+1, hi⟩ => succ ⟨i, Nat.lt_of_succ_lt_succ hi⟩ (induction zero succ ⟨i, Nat.lt_of_succ_lt hi⟩) - -@[simp] theorem induction_zero {motive : Fin (n + 1) → Sort _} (zero : motive 0) - (hs : ∀ i : Fin n, motive (castSucc i) → motive i.succ) : - (induction zero hs : ∀ i : Fin (n + 1), motive i) 0 = zero := rfl - -@[simp] theorem induction_succ {motive : Fin (n + 1) → Sort _} (zero : motive 0) - (succ : ∀ i : Fin n, motive (castSucc i) → motive i.succ) (i : Fin n) : - induction (motive := motive) zero succ i.succ = succ i (induction zero succ (castSucc i)) := rfl - -/-- Define `motive i` by induction on `i : Fin (n + 1)` via induction on the underlying `Nat` value. -This function has two arguments: `zero` handles the base case on `motive 0`, -and `succ` defines the inductive step using `motive i.castSucc`. - -A version of `Fin.induction` taking `i : Fin (n + 1)` as the first argument. --/ --- FIXME: Performance review -@[elab_as_elim] def inductionOn (i : Fin (n + 1)) {motive : Fin (n + 1) → Sort _} (zero : motive 0) - (succ : ∀ i : Fin n, motive (castSucc i) → motive i.succ) : motive i := induction zero succ i - -/-- Define `f : Π i : Fin n.succ, motive i` by separately handling the cases `i = 0` and -`i = j.succ`, `j : Fin n`. -/ -@[elab_as_elim] def cases {motive : Fin (n + 1) → Sort _} - (zero : motive 0) (succ : ∀ i : Fin n, motive i.succ) : - ∀ i : Fin (n + 1), motive i := induction zero fun i _ => succ i - -@[simp] theorem cases_zero {n} {motive : Fin (n + 1) → Sort _} {zero succ} : - @Fin.cases n motive zero succ 0 = zero := rfl - -@[simp] theorem cases_succ {n} {motive : Fin (n + 1) → Sort _} {zero succ} (i : Fin n) : - @Fin.cases n motive zero succ i.succ = succ i := rfl - -@[simp] theorem cases_succ' {n} {motive : Fin (n + 1) → Sort _} {zero succ} - {i : Nat} (h : i + 1 < n + 1) : - @Fin.cases n motive zero succ ⟨i.succ, h⟩ = succ ⟨i, Nat.lt_of_succ_lt_succ h⟩ := rfl - -theorem forall_fin_succ {P : Fin (n + 1) → Prop} : (∀ i, P i) ↔ P 0 ∧ ∀ i : Fin n, P i.succ := - ⟨fun H => ⟨H 0, fun _ => H _⟩, fun ⟨H0, H1⟩ i => Fin.cases H0 H1 i⟩ - -theorem exists_fin_succ {P : Fin (n + 1) → Prop} : (∃ i, P i) ↔ P 0 ∨ ∃ i : Fin n, P i.succ := - ⟨fun ⟨i, h⟩ => Fin.cases Or.inl (fun i hi => Or.inr ⟨i, hi⟩) i h, fun h => - (h.elim fun h => ⟨0, h⟩) fun ⟨i, hi⟩ => ⟨i.succ, hi⟩⟩ - -theorem forall_fin_one {p : Fin 1 → Prop} : (∀ i, p i) ↔ p 0 := - ⟨fun h => h _, fun h i => Subsingleton.elim i 0 ▸ h⟩ - -theorem exists_fin_one {p : Fin 1 → Prop} : (∃ i, p i) ↔ p 0 := - ⟨fun ⟨i, h⟩ => Subsingleton.elim i 0 ▸ h, fun h => ⟨_, h⟩⟩ - -theorem forall_fin_two {p : Fin 2 → Prop} : (∀ i, p i) ↔ p 0 ∧ p 1 := - forall_fin_succ.trans <| and_congr_right fun _ => forall_fin_one - -theorem exists_fin_two {p : Fin 2 → Prop} : (∃ i, p i) ↔ p 0 ∨ p 1 := - exists_fin_succ.trans <| or_congr_right exists_fin_one - -theorem fin_two_eq_of_eq_zero_iff : ∀ {a b : Fin 2}, (a = 0 ↔ b = 0) → a = b := by - simp only [forall_fin_two]; decide - -/-- -Define `motive i` by reverse induction on `i : Fin (n + 1)` via induction on the underlying `Nat` -value. This function has two arguments: `last` handles the base case on `motive (Fin.last n)`, -and `cast` defines the inductive step using `motive i.succ`, inducting downwards. --/ -@[elab_as_elim] def reverseInduction {motive : Fin (n + 1) → Sort _} (last : motive (Fin.last n)) - (cast : ∀ i : Fin n, motive i.succ → motive (castSucc i)) (i : Fin (n + 1)) : motive i := - if hi : i = Fin.last n then _root_.cast (congrArg motive hi.symm) last - else - let j : Fin n := ⟨i, Nat.lt_of_le_of_ne (Nat.le_of_lt_succ i.2) fun h => hi (Fin.ext h)⟩ - cast _ (reverseInduction last cast j.succ) -termination_by n + 1 - i -decreasing_by decreasing_with - -- FIXME: we put the proof down here to avoid getting a dummy `have` in the definition - exact Nat.add_sub_add_right .. ▸ Nat.sub_lt_sub_left i.2 (Nat.lt_succ_self i) - -@[simp] theorem reverseInduction_last {n : Nat} {motive : Fin (n + 1) → Sort _} {zero succ} : - (reverseInduction zero succ (Fin.last n) : motive (Fin.last n)) = zero := by - rw [reverseInduction]; simp; rfl - -@[simp] theorem reverseInduction_castSucc {n : Nat} {motive : Fin (n + 1) → Sort _} {zero succ} - (i : Fin n) : reverseInduction (motive := motive) zero succ (castSucc i) = - succ i (reverseInduction zero succ i.succ) := by - rw [reverseInduction, dif_neg (Fin.ne_of_lt (Fin.castSucc_lt_last i))]; rfl - -/-- Define `f : Π i : Fin n.succ, motive i` by separately handling the cases `i = Fin.last n` and -`i = j.castSucc`, `j : Fin n`. -/ -@[elab_as_elim] def lastCases {n : Nat} {motive : Fin (n + 1) → Sort _} (last : motive (Fin.last n)) - (cast : ∀ i : Fin n, motive (castSucc i)) (i : Fin (n + 1)) : motive i := - reverseInduction last (fun i _ => cast i) i - -@[simp] theorem lastCases_last {n : Nat} {motive : Fin (n + 1) → Sort _} {last cast} : - (Fin.lastCases last cast (Fin.last n) : motive (Fin.last n)) = last := - reverseInduction_last .. - -@[simp] theorem lastCases_castSucc {n : Nat} {motive : Fin (n + 1) → Sort _} {last cast} - (i : Fin n) : (Fin.lastCases last cast (Fin.castSucc i) : motive (Fin.castSucc i)) = cast i := - reverseInduction_castSucc .. - -/-- Define `f : Π i : Fin (m + n), motive i` by separately handling the cases `i = castAdd n i`, -`j : Fin m` and `i = natAdd m j`, `j : Fin n`. -/ -@[elab_as_elim] def addCases {m n : Nat} {motive : Fin (m + n) → Sort u} - (left : ∀ i, motive (castAdd n i)) (right : ∀ i, motive (natAdd m i)) - (i : Fin (m + n)) : motive i := - if hi : (i : Nat) < m then (castAdd_castLT n i hi) ▸ (left (castLT i hi)) - else (natAdd_subNat_cast (Nat.le_of_not_lt hi)) ▸ (right _) - -@[simp] theorem addCases_left {m n : Nat} {motive : Fin (m + n) → Sort _} {left right} (i : Fin m) : - addCases (motive := motive) left right (Fin.castAdd n i) = left i := by - rw [addCases, dif_pos (castAdd_lt _ _)]; rfl - -@[simp] -theorem addCases_right {m n : Nat} {motive : Fin (m + n) → Sort _} {left right} (i : Fin n) : - addCases (motive := motive) left right (natAdd m i) = right i := by - have : ¬(natAdd m i : Nat) < m := Nat.not_lt.2 (le_coe_natAdd ..) - rw [addCases, dif_neg this]; exact eq_of_heq <| (eqRec_heq _ _).trans (by congr 1; simp) - -/-! ### clamp -/ - -@[simp] theorem coe_clamp (n m : Nat) : (clamp n m : Nat) = min n m := rfl - -/-! ### add -/ - -@[simp] theorem ofNat'_add (x : Nat) (lt : 0 < n) (y : Fin n) : - Fin.ofNat' x lt + y = Fin.ofNat' (x + y.val) lt := by - apply Fin.eq_of_val_eq - simp [Fin.ofNat', Fin.add_def] - -@[simp] theorem add_ofNat' (x : Fin n) (y : Nat) (lt : 0 < n) : - x + Fin.ofNat' y lt = Fin.ofNat' (x.val + y) lt := by - apply Fin.eq_of_val_eq - simp [Fin.ofNat', Fin.add_def] - -/-! ### sub -/ - -protected theorem coe_sub (a b : Fin n) : ((a - b : Fin n) : Nat) = (a + (n - b)) % n := by - cases a; cases b; rfl - -@[simp] theorem ofNat'_sub (x : Nat) (lt : 0 < n) (y : Fin n) : - Fin.ofNat' x lt - y = Fin.ofNat' (x + (n - y.val)) lt := by - apply Fin.eq_of_val_eq - simp [Fin.ofNat', Fin.sub_def] - -@[simp] theorem sub_ofNat' (x : Fin n) (y : Nat) (lt : 0 < n) : - x - Fin.ofNat' y lt = Fin.ofNat' (x.val + (n - y % n)) lt := by - apply Fin.eq_of_val_eq - simp [Fin.ofNat', Fin.sub_def] - -private theorem _root_.Nat.mod_eq_sub_of_lt_two_mul {x n} (h₁ : n ≤ x) (h₂ : x < 2 * n) : - x % n = x - n := by - rw [Nat.mod_eq, if_pos (by omega), Nat.mod_eq_of_lt (by omega)] - -theorem coe_sub_iff_le {a b : Fin n} : (↑(a - b) : Nat) = a - b ↔ b ≤ a := by - rw [sub_def, le_def] - dsimp only - if h : n ≤ a + (n - b) then - rw [Nat.mod_eq_sub_of_lt_two_mul h] - all_goals omega - else - rw [Nat.mod_eq_of_lt] - all_goals omega - -theorem coe_sub_iff_lt {a b : Fin n} : (↑(a - b) : Nat) = n + a - b ↔ a < b := by - rw [sub_def, lt_def] - dsimp only - if h : n ≤ a + (n - b) then - rw [Nat.mod_eq_sub_of_lt_two_mul h] - all_goals omega - else - rw [Nat.mod_eq_of_lt] - all_goals omega - -/-! ### mul -/ - -theorem val_mul {n : Nat} : ∀ a b : Fin n, (a * b).val = a.val * b.val % n - | ⟨_, _⟩, ⟨_, _⟩ => rfl - -theorem coe_mul {n : Nat} : ∀ a b : Fin n, ((a * b : Fin n) : Nat) = a * b % n - | ⟨_, _⟩, ⟨_, _⟩ => rfl - -protected theorem mul_one (k : Fin (n + 1)) : k * 1 = k := by - match n with - | 0 => exact Subsingleton.elim (α := Fin 1) .. - | n+1 => simp [ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)] - -protected theorem mul_comm (a b : Fin n) : a * b = b * a := - ext <| by rw [mul_def, mul_def, Nat.mul_comm] - -protected theorem one_mul (k : Fin (n + 1)) : (1 : Fin (n + 1)) * k = k := by - rw [Fin.mul_comm, Fin.mul_one] - -protected theorem mul_zero (k : Fin (n + 1)) : k * 0 = 0 := by simp [ext_iff, mul_def] - -protected theorem zero_mul (k : Fin (n + 1)) : (0 : Fin (n + 1)) * k = 0 := by - simp [ext_iff, mul_def] - -end Fin - -namespace USize - -@[simp] theorem lt_def {a b : USize} : a < b ↔ a.toNat < b.toNat := .rfl - -@[simp] theorem le_def {a b : USize} : a ≤ b ↔ a.toNat ≤ b.toNat := .rfl - -@[simp] theorem zero_toNat : (0 : USize).toNat = 0 := Nat.zero_mod _ - -@[simp] theorem mod_toNat (a b : USize) : (a % b).toNat = a.toNat % b.toNat := - Fin.mod_val .. - -@[simp] theorem div_toNat (a b : USize) : (a / b).toNat = a.toNat / b.toNat := - Fin.div_val .. - -@[simp] theorem modn_toNat (a : USize) (b : Nat) : (a.modn b).toNat = a.toNat % b := - Fin.modn_val .. - -theorem mod_lt (a b : USize) (h : 0 < b) : a % b < b := USize.modn_lt _ (by simp at h; exact h) - -theorem toNat.inj : ∀ {a b : USize}, a.toNat = b.toNat → a = b - | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl - -end USize +attribute [norm_cast] val_last diff --git a/Std/Data/Int/Gcd.lean b/Std/Data/Int/Gcd.lean index 2e12ac3e86..a825845693 100644 --- a/Std/Data/Int/Gcd.lean +++ b/Std/Data/Int/Gcd.lean @@ -5,7 +5,6 @@ Authors: Scott Morrison -/ import Std.Data.Int.DivMod import Std.Data.Nat.Gcd -import Std.Tactic.Simpa /-! # Results about `Int.gcd`. diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index 6b4dec0e2d..7669d72823 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -200,12 +200,8 @@ def enumFromTR (n : Nat) (l : List α) : List (Nat × α) := | a::as, n => by rw [← show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as] simp [enumFrom, f] - -- Note: there was a regression here caused by leanprover/lean4#3388. - -- Previously the `go` was in the `simp`, not the `rw`, but currently `simp` can't use it. - -- A fix will land in nightly-2024-02-20 - -- https://github.com/leanprover/lean4/pull/3406 - rw [Array.foldr_eq_foldr_data, go] - simp + rw [Array.foldr_eq_foldr_data] + simp [go] theorem replicateTR_loop_eq : ∀ n, replicateTR.loop a n acc = replicate n a ++ acc | 0 => rfl @@ -660,21 +656,6 @@ partitionMap (id : Nat ⊕ Nat → Nat ⊕ Nat) [inl 0, inr 1, inl 2] = ([0, 2], | .inl a => go xs (acc₁.push a) acc₂ | .inr b => go xs acc₁ (acc₂.push b) -/-- Monadic generalization of `List.partition`. -/ -@[inline] def partitionM [Monad m] (p : α → m Bool) (l : List α) : m (List α × List α) := - go l #[] #[] -where - /-- Auxiliary for `partitionM`: - `partitionM.go p l acc₁ acc₂` returns `(acc₁.toList ++ left, acc₂.toList ++ right)` - if `partitionM p l` returns `(left, right)`. -/ - @[specialize] go : List α → Array α → Array α → m (List α × List α) - | [], acc₁, acc₂ => pure (acc₁.toList, acc₂.toList) - | x :: xs, acc₁, acc₂ => do - if ← p x then - go xs (acc₁.push x) acc₂ - else - go xs acc₁ (acc₂.push x) - /-- Fold a list from left to right as with `foldl`, but the combining function also receives each element's index. diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 7370f269e4..03d1fc1788 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -10,7 +10,6 @@ import Std.Data.Nat.Lemmas import Std.Data.List.Basic import Std.Data.Option.Lemmas import Std.Classes.BEq -import Std.Tactic.Simpa namespace List @@ -794,16 +793,6 @@ theorem get_of_eq {l l' : List α} (h : l = l') (i : Fin l.length) : theorem get_zero : ∀ {l : List α} (h : 0 < l.length), l.get ⟨0, h⟩ = l.head? | _::_, _ => rfl -theorem get_append : ∀ {l₁ l₂ : List α} (n : Nat) (h : n < l₁.length), - (l₁ ++ l₂).get ⟨n, length_append .. ▸ Nat.lt_add_right _ h⟩ = l₁.get ⟨n, h⟩ -| a :: l, _, 0, h => rfl -| a :: l, _, n+1, h => by simp only [get, cons_append]; apply get_append - -theorem get?_append_right : ∀ {l₁ l₂ : List α} {n : Nat}, l₁.length ≤ n → - (l₁ ++ l₂).get? n = l₂.get? (n - l₁.length) -| [], _, n, _ => rfl -| a :: l, _, n+1, h₁ => by rw [cons_append]; simp [get?_append_right (Nat.lt_succ.1 h₁)] - theorem get_append_right_aux {l₁ l₂ : List α} {n : Nat} (h₁ : l₁.length ≤ n) (h₂ : n < (l₁ ++ l₂).length) : n - l₁.length < l₂.length := by rw [length_append] at h₂ @@ -823,12 +812,6 @@ theorem get_of_append {l : List α} (eq : l = l₁ ++ a :: l₂) (h : l₁.lengt @[simp] theorem get_replicate (a : α) {n : Nat} (m : Fin _) : (replicate n a).get m = a := eq_of_mem_replicate (get_mem _ _ _) -theorem get?_append {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) : - (l₁ ++ l₂).get? n = l₁.get? n := by - have hn' : n < (l₁ ++ l₂).length := Nat.lt_of_lt_of_le hn <| - length_append .. ▸ Nat.le_add_right .. - rw [get?_eq_get hn, get?_eq_get hn', get_append] - @[simp] theorem getLastD_concat (a b l) : @getLastD α (l ++ [b]) a = b := by rw [getLastD_eq_getLast?, getLast?_concat]; rfl @@ -853,30 +836,10 @@ theorem ext_get {l₁ l₂ : List α} (hl : length l₁ = length l₂) have h₁ := Nat.le_of_not_lt h₁ rw [get?_len_le h₁, get?_len_le]; rwa [← hl] -theorem get?_reverse' : ∀ {l : List α} (i j), i + j + 1 = length l → - get? l.reverse i = get? l j - | [], _, _, _ => rfl - | a::l, i, 0, h => by simp at h; simp [h, get?_append_right] - | a::l, i, j+1, h => by - have := Nat.succ.inj h; simp at this ⊢ - rw [get?_append, get?_reverse' _ j this] - rw [length_reverse, ← this]; apply Nat.lt_add_of_pos_right (Nat.succ_pos _) - -theorem get?_reverse {l : List α} (i) (h : i < length l) : - get? l.reverse i = get? l (l.length - 1 - i) := - get?_reverse' _ _ <| by - rw [Nat.add_sub_of_le (Nat.le_sub_one_of_lt h), - Nat.sub_add_cancel (Nat.lt_of_le_of_lt (Nat.zero_le _) h)] - theorem get!_of_get? [Inhabited α] : ∀ {l : List α} {n}, get? l n = some a → get! l n = a | _a::_, 0, rfl => rfl | _::l, _+1, e => get!_of_get? (l := l) e -theorem getD_eq_get? : ∀ l n (a : α), getD l n a = (get? l n).getD a - | [], _, _ => rfl - | _a::_, 0, _ => rfl - | _::l, _+1, _ => getD_eq_get? (l := l) .. - @[simp] theorem get!_eq_getD [Inhabited α] : ∀ (l : List α) n, l.get! n = l.getD n default | [], _ => rfl | _a::_, 0 => rfl diff --git a/Std/Data/Nat.lean b/Std/Data/Nat.lean index 6fd2edd7ca..3ae228fe3e 100644 --- a/Std/Data/Nat.lean +++ b/Std/Data/Nat.lean @@ -1,5 +1,4 @@ import Std.Data.Nat.Basic -import Std.Data.Nat.Bitwise import Std.Data.Nat.Gcd import Std.Data.Nat.Init.Basic import Std.Data.Nat.Lemmas diff --git a/Std/Data/Nat/Basic.lean b/Std/Data/Nat/Basic.lean index 155bf0d2c9..aaa4e6bfed 100644 --- a/Std/Data/Nat/Basic.lean +++ b/Std/Data/Nat/Basic.lean @@ -122,12 +122,3 @@ where else guess termination_by guess - -/-! -### testBit -We define an operation for testing individual bits in the binary representation -of a number. --/ - -/-- `testBit m n` returns whether the `(n+1)` least significant bit is `1` or `0`-/ -def testBit (m n : Nat) : Bool := (m >>> n) &&& 1 != 0 diff --git a/Std/Data/Nat/Bitwise.lean b/Std/Data/Nat/Bitwise.lean deleted file mode 100644 index ddf2f7c112..0000000000 --- a/Std/Data/Nat/Bitwise.lean +++ /dev/null @@ -1,497 +0,0 @@ -/- -Copyright (c) 2023 by the authors listed in the file AUTHORS and their -institutional affiliations. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix --/ - -/- -This module defines properties of the bitwise operations on Natural numbers. - -It is primarily intended to support the bitvector library. --/ -import Std.Data.Nat.Basic -import Std.Tactic.Simpa -import Std.Tactic.Basic - -namespace Nat - -@[local simp] -private theorem one_div_two : 1/2 = 0 := by trivial - -private theorem two_pow_succ_sub_succ_div_two : (2 ^ (n+1) - (x + 1)) / 2 = 2^n - (x/2 + 1) := by - if h : x + 1 ≤ 2 ^ (n + 1) then - apply fun x => (Nat.sub_eq_of_eq_add x).symm - apply Eq.trans _ - apply Nat.add_mul_div_left _ _ Nat.zero_lt_two - rw [← Nat.sub_add_comm h] - rw [Nat.add_sub_assoc (by omega)] - rw [Nat.pow_succ'] - rw [Nat.mul_add_div Nat.zero_lt_two] - simp [show (2 * (x / 2 + 1) - (x + 1)) / 2 = 0 by omega] - else - rw [Nat.pow_succ'] at * - omega - -private theorem two_pow_succ_sub_one_div_two : (2 ^ (n+1) - 1) / 2 = 2^n - 1 := - two_pow_succ_sub_succ_div_two - -private theorem two_mul_sub_one {n : Nat} (n_pos : n > 0) : (2*n - 1) % 2 = 1 := by - match n with - | 0 => contradiction - | n + 1 => simp [Nat.mul_succ, Nat.mul_add_mod, mod_eq_of_lt] - -/-! ### Preliminaries -/ - -/-- -An induction principal that works on divison by two. --/ -noncomputable def div2Induction {motive : Nat → Sort u} - (n : Nat) (ind : ∀(n : Nat), (n > 0 → motive (n/2)) → motive n) : motive n := by - induction n using Nat.strongInductionOn with - | ind n hyp => - apply ind - intro n_pos - if n_eq : n = 0 then - simp [n_eq] at n_pos - else - apply hyp - exact Nat.div_lt_self n_pos (Nat.le_refl _) - -@[simp] theorem zero_and (x : Nat) : 0 &&& x = 0 := by rfl - -@[simp] theorem and_zero (x : Nat) : x &&& 0 = 0 := by - simp only [HAnd.hAnd, AndOp.and, land] - unfold bitwise - simp - -@[simp] theorem and_one_is_mod (x : Nat) : x &&& 1 = x % 2 := by - if xz : x = 0 then - simp [xz, zero_and] - else - have andz := and_zero (x/2) - simp only [HAnd.hAnd, AndOp.and, land] at andz - simp only [HAnd.hAnd, AndOp.and, land] - unfold bitwise - cases mod_two_eq_zero_or_one x with | _ p => - simp [xz, p, andz, one_div_two, mod_eq_of_lt] - -/-! ### testBit -/ - -@[simp] theorem zero_testBit (i : Nat) : testBit 0 i = false := by - simp only [testBit, zero_shiftRight, zero_and, bne_self_eq_false] - -@[simp] theorem testBit_zero (x : Nat) : testBit x 0 = decide (x % 2 = 1) := by - cases mod_two_eq_zero_or_one x with | _ p => simp [testBit, p] - -@[simp] theorem testBit_succ (x i : Nat) : testBit x (succ i) = testBit (x/2) i := by - unfold testBit - simp [shiftRight_succ_inside] - -theorem testBit_to_div_mod {x : Nat} : testBit x i = decide (x / 2^i % 2 = 1) := by - induction i generalizing x with - | zero => - unfold testBit - cases mod_two_eq_zero_or_one x with | _ xz => simp [xz] - | succ i hyp => - simp [hyp, Nat.div_div_eq_div_mul, Nat.pow_succ'] - -theorem ne_zero_implies_bit_true {x : Nat} (xnz : x ≠ 0) : ∃ i, testBit x i := by - induction x using div2Induction with - | ind x hyp => - have x_pos : x > 0 := Nat.pos_of_ne_zero xnz - match mod_two_eq_zero_or_one x with - | Or.inl mod2_eq => - rw [←div_add_mod x 2] at xnz - simp only [mod2_eq, ne_eq, Nat.mul_eq_zero, Nat.add_zero, false_or] at xnz - have ⟨d, dif⟩ := hyp x_pos xnz - apply Exists.intro (d+1) - simp_all - | Or.inr mod2_eq => - apply Exists.intro 0 - simp_all - -theorem ne_implies_bit_diff {x y : Nat} (p : x ≠ y) : ∃ i, testBit x i ≠ testBit y i := by - induction y using Nat.div2Induction generalizing x with - | ind y hyp => - cases Nat.eq_zero_or_pos y with - | inl yz => - simp only [yz, Nat.zero_testBit, Bool.eq_false_iff] - simp only [yz] at p - have ⟨i,ip⟩ := ne_zero_implies_bit_true p - apply Exists.intro i - simp [ip] - | inr ypos => - if lsb_diff : x % 2 = y % 2 then - rw [←Nat.div_add_mod x 2, ←Nat.div_add_mod y 2] at p - simp only [ne_eq, lsb_diff, Nat.add_right_cancel_iff, - Nat.zero_lt_succ, Nat.mul_left_cancel_iff] at p - have ⟨i, ieq⟩ := hyp ypos p - apply Exists.intro (i+1) - simpa - else - apply Exists.intro 0 - simp only [testBit_zero] - revert lsb_diff - cases mod_two_eq_zero_or_one x with | _ p => - cases mod_two_eq_zero_or_one y with | _ q => - simp [p,q] - -/-- -`eq_of_testBit_eq` allows proving two natural numbers are equal -if their bits are all equal. --/ -theorem eq_of_testBit_eq {x y : Nat} (pred : ∀i, testBit x i = testBit y i) : x = y := by - if h : x = y then - exact h - else - let ⟨i,eq⟩ := ne_implies_bit_diff h - have p := pred i - contradiction - -theorem ge_two_pow_implies_high_bit_true {x : Nat} (p : x ≥ 2^n) : ∃ i, i ≥ n ∧ testBit x i := by - induction x using div2Induction generalizing n with - | ind x hyp => - have x_pos : x > 0 := Nat.lt_of_lt_of_le (Nat.two_pow_pos n) p - have x_ne_zero : x ≠ 0 := Nat.ne_of_gt x_pos - match n with - | zero => - let ⟨j, jp⟩ := ne_zero_implies_bit_true x_ne_zero - exact Exists.intro j (And.intro (Nat.zero_le _) jp) - | succ n => - have x_ge_n : x / 2 ≥ 2 ^ n := by - simpa [le_div_iff_mul_le, ← Nat.pow_succ'] using p - have ⟨j, jp⟩ := @hyp x_pos n x_ge_n - apply Exists.intro (j+1) - apply And.intro - case left => - exact (Nat.succ_le_succ jp.left) - case right => - simpa using jp.right - -theorem testBit_implies_ge {x : Nat} (p : testBit x i = true) : x ≥ 2^i := by - simp only [testBit_to_div_mod] at p - by_contra not_ge - have x_lt : x < 2^i := Nat.lt_of_not_le not_ge - simp [div_eq_of_lt x_lt] at p - -theorem testBit_lt_two_pow {x i : Nat} (lt : x < 2^i) : x.testBit i = false := by - match p : x.testBit i with - | false => trivial - | true => - exfalso - exact Nat.not_le_of_gt lt (testBit_implies_ge p) - -theorem lt_pow_two_of_testBit (x : Nat) (p : ∀i, i ≥ n → testBit x i = false) : x < 2^n := by - by_contra not_lt - have x_ge_n := Nat.ge_of_not_lt not_lt - have ⟨i, ⟨i_ge_n, test_true⟩⟩ := ge_two_pow_implies_high_bit_true x_ge_n - have test_false := p _ i_ge_n - simp only [test_true] at test_false - -/-! ### testBit -/ - -private theorem succ_mod_two : succ x % 2 = 1 - x % 2 := by - induction x with - | zero => - trivial - | succ x hyp => - have p : 2 ≤ x + 2 := Nat.le_add_left _ _ - simp [Nat.mod_eq (x+2) 2, p, hyp] - cases Nat.mod_two_eq_zero_or_one x with | _ p => simp [p] - -private theorem testBit_succ_zero : testBit (x + 1) 0 = not (testBit x 0) := by - simp [testBit_to_div_mod, succ_mod_two] - cases Nat.mod_two_eq_zero_or_one x with | _ p => - simp [p] - -theorem testBit_two_pow_add_eq (x i : Nat) : testBit (2^i + x) i = not (testBit x i) := by - simp [testBit_to_div_mod, add_div_left, Nat.two_pow_pos, succ_mod_two] - cases mod_two_eq_zero_or_one (x / 2 ^ i) with - | _ p => simp [p] - -theorem testBit_mul_two_pow_add_eq (a b i : Nat) : - testBit (2^i*a + b) i = Bool.xor (a%2 = 1) (testBit b i) := by - match a with - | 0 => simp - | a+1 => - simp [Nat.mul_succ, Nat.add_assoc, - testBit_mul_two_pow_add_eq a, - testBit_two_pow_add_eq, - Nat.succ_mod_two] - cases mod_two_eq_zero_or_one a with - | _ p => simp [p] - -theorem testBit_two_pow_add_gt {i j : Nat} (j_lt_i : j < i) (x : Nat) : - testBit (2^i + x) j = testBit x j := by - have i_def : i = j + (i-j) := (Nat.add_sub_cancel' (Nat.le_of_lt j_lt_i)).symm - rw [i_def] - simp only [testBit_to_div_mod, Nat.pow_add, - Nat.add_comm x, Nat.mul_add_div (Nat.two_pow_pos _)] - match i_sub_j_eq : i - j with - | 0 => - exfalso - rw [Nat.sub_eq_zero_iff_le] at i_sub_j_eq - exact Nat.not_le_of_gt j_lt_i i_sub_j_eq - | d+1 => - simp [pow_succ, Nat.mul_comm _ 2, Nat.mul_add_mod] - -@[simp] theorem testBit_mod_two_pow (x j i : Nat) : - testBit (x % 2^j) i = (decide (i < j) && testBit x i) := by - induction x using Nat.strongInductionOn generalizing j i with - | ind x hyp => - rw [mod_eq] - rcases Nat.lt_or_ge x (2^j) with x_lt_j | x_ge_j - · have not_j_le_x := Nat.not_le_of_gt x_lt_j - simp [not_j_le_x] - rcases Nat.lt_or_ge i j with i_lt_j | i_ge_j - · simp [i_lt_j] - · have x_lt : x < 2^i := - calc x < 2^j := x_lt_j - _ ≤ 2^i := Nat.pow_le_pow_of_le_right Nat.zero_lt_two i_ge_j - simp [Nat.testBit_lt_two_pow x_lt] - · generalize y_eq : x - 2^j = y - have x_eq : x = y + 2^j := Nat.eq_add_of_sub_eq x_ge_j y_eq - simp only [Nat.two_pow_pos, x_eq, Nat.le_add_left, true_and, ite_true] - have y_lt_x : y < x := by - simp [x_eq] - exact Nat.lt_add_of_pos_right (Nat.two_pow_pos j) - simp only [hyp y y_lt_x] - if i_lt_j : i < j then - rw [ Nat.add_comm _ (2^_), testBit_two_pow_add_gt i_lt_j] - else - simp [i_lt_j] - -theorem testBit_one_zero : testBit 1 0 = true := by trivial - -theorem testBit_two_pow_sub_succ (h₂ : x < 2 ^ n) (i : Nat) : - testBit (2^n - (x + 1)) i = (decide (i < n) && ! testBit x i) := by - induction i generalizing n x with - | zero => - simp only [testBit_zero, zero_eq, Bool.and_eq_true, decide_eq_true_eq, - Bool.not_eq_true'] - match n with - | 0 => simp - | n+1 => - -- just logic + omega: - simp only [zero_lt_succ, decide_True, Bool.true_and] - rw [Nat.pow_succ', ← decide_not, decide_eq_decide] - rw [Nat.pow_succ'] at h₂ - omega - | succ i ih => - simp only [testBit_succ] - match n with - | 0 => - simp only [pow_zero, succ_sub_succ_eq_sub, Nat.zero_sub, Nat.zero_div, zero_testBit] - rw [decide_eq_false] <;> simp - | n+1 => - rw [Nat.two_pow_succ_sub_succ_div_two, ih] - · simp [Nat.succ_lt_succ_iff] - · rw [Nat.pow_succ'] at h₂ - omega - -@[simp] theorem testBit_two_pow_sub_one (n i : Nat) : testBit (2^n-1) i = decide (i < n) := by - rw [testBit_two_pow_sub_succ] - · simp - · exact Nat.two_pow_pos _ - -theorem testBit_bool_to_nat (b : Bool) (i : Nat) : - testBit (Bool.toNat b) i = (decide (i = 0) && b) := by - cases b <;> cases i <;> - simp [testBit_to_div_mod, Nat.pow_succ, Nat.mul_comm _ 2, - ←Nat.div_div_eq_div_mul _ 2, one_div_two, - Nat.mod_eq_of_lt] - -/-! ### bitwise -/ - -theorem testBit_bitwise - (false_false_axiom : f false false = false) (x y i : Nat) -: (bitwise f x y).testBit i = f (x.testBit i) (y.testBit i) := by - induction i using Nat.strongInductionOn generalizing x y with - | ind i hyp => - unfold bitwise - if x_zero : x = 0 then - cases p : f false true <;> - cases yi : testBit y i <;> - simp [x_zero, p, yi, false_false_axiom] - else if y_zero : y = 0 then - simp [x_zero, y_zero] - cases p : f true false <;> - cases xi : testBit x i <;> - simp [p, xi, false_false_axiom] - else - simp only [x_zero, y_zero, ←Nat.two_mul] - cases i with - | zero => - cases p : f (decide (x % 2 = 1)) (decide (y % 2 = 1)) <;> - simp [p, Nat.mul_add_mod, mod_eq_of_lt] - | succ i => - have hyp_i := hyp i (Nat.le_refl (i+1)) - cases p : f (decide (x % 2 = 1)) (decide (y % 2 = 1)) <;> - simp [p, one_div_two, hyp_i, Nat.mul_add_div] - -/-! ### bitwise -/ - -@[local simp] -private theorem eq_0_of_lt_one (x : Nat) : x < 1 ↔ x = 0 := - Iff.intro - (fun p => - match x with - | 0 => Eq.refl 0 - | _+1 => False.elim (not_lt_zero _ (Nat.lt_of_succ_lt_succ p))) - (fun p => by simp [p, Nat.zero_lt_succ]) - -private theorem eq_0_of_lt (x : Nat) : x < 2^ 0 ↔ x = 0 := eq_0_of_lt_one x - -@[local simp] -private theorem zero_lt_pow (n : Nat) : 0 < 2^n := by - induction n - case zero => simp [eq_0_of_lt] - case succ n hyp => simpa [pow_succ] - -private theorem div_two_le_of_lt_two {m n : Nat} (p : m < 2 ^ succ n) : m / 2 < 2^n := by - simp [div_lt_iff_lt_mul Nat.zero_lt_two] - exact p - -/-- This provides a bound on bitwise operations. -/ -theorem bitwise_lt_two_pow (left : x < 2^n) (right : y < 2^n) : (Nat.bitwise f x y) < 2^n := by - induction n generalizing x y with - | zero => - simp only [eq_0_of_lt] at left right - unfold bitwise - simp [left, right] - | succ n hyp => - unfold bitwise - if x_zero : x = 0 then - simp only [x_zero, if_pos] - by_cases p : f false true = true <;> simp [p, right] - else if y_zero : y = 0 then - simp only [x_zero, y_zero, if_neg, if_pos] - by_cases p : f true false = true <;> simp [p, left] - else - simp only [x_zero, y_zero, if_neg] - have hyp1 := hyp (div_two_le_of_lt_two left) (div_two_le_of_lt_two right) - by_cases p : f (decide (x % 2 = 1)) (decide (y % 2 = 1)) = true <;> - simp [p, pow_succ, mul_succ, Nat.add_assoc] - case pos => - apply lt_of_succ_le - simp only [← Nat.succ_add] - apply Nat.add_le_add <;> exact hyp1 - case neg => - apply Nat.add_lt_add <;> exact hyp1 - -/-! ### and -/ - -@[simp] theorem testBit_and (x y i : Nat) : (x &&& y).testBit i = (x.testBit i && y.testBit i) := by - simp [HAnd.hAnd, AndOp.and, land, testBit_bitwise ] - -theorem and_lt_two_pow (x : Nat) {y n : Nat} (right : y < 2^n) : (x &&& y) < 2^n := by - apply lt_pow_two_of_testBit - intro i i_ge_n - have yf : testBit y i = false := by - apply Nat.testBit_lt_two_pow - apply Nat.lt_of_lt_of_le right - exact pow_le_pow_of_le_right Nat.zero_lt_two i_ge_n - simp [testBit_and, yf] - -@[simp] theorem and_pow_two_is_mod (x n : Nat) : x &&& (2^n-1) = x % 2^n := by - apply eq_of_testBit_eq - intro i - simp only [testBit_and, testBit_mod_two_pow] - cases testBit x i <;> simp - -theorem and_pow_two_identity {x : Nat} (lt : x < 2^n) : x &&& 2^n-1 = x := by - rw [and_pow_two_is_mod] - apply Nat.mod_eq_of_lt lt - -/-! ### lor -/ - -@[simp] theorem or_zero (x : Nat) : 0 ||| x = x := by - simp only [HOr.hOr, OrOp.or, lor] - unfold bitwise - simp [@eq_comm _ 0] - -@[simp] theorem zero_or (x : Nat) : x ||| 0 = x := by - simp only [HOr.hOr, OrOp.or, lor] - unfold bitwise - simp [@eq_comm _ 0] - -@[simp] theorem testBit_or (x y i : Nat) : (x ||| y).testBit i = (x.testBit i || y.testBit i) := by - simp [HOr.hOr, OrOp.or, lor, testBit_bitwise ] - -theorem or_lt_two_pow {x y n : Nat} (left : x < 2^n) (right : y < 2^n) : x ||| y < 2^n := - bitwise_lt_two_pow left right - -/-! ### xor -/ - -@[simp] theorem testBit_xor (x y i : Nat) : - (x ^^^ y).testBit i = Bool.xor (x.testBit i) (y.testBit i) := by - simp [HXor.hXor, Xor.xor, xor, testBit_bitwise ] - -theorem xor_lt_two_pow {x y n : Nat} (left : x < 2^n) (right : y < 2^n) : x ^^^ y < 2^n := - bitwise_lt_two_pow left right - -/-! ### Arithmetic -/ - -theorem testBit_mul_pow_two_add (a : Nat) {b i : Nat} (b_lt : b < 2^i) (j : Nat) : - testBit (2 ^ i * a + b) j = - if j < i then - testBit b j - else - testBit a (j - i) := by - cases Nat.lt_or_ge j i with - | inl j_lt => - simp only [j_lt] - have i_ge := Nat.le_of_lt j_lt - have i_sub_j_nez : i-j ≠ 0 := Nat.sub_ne_zero_of_lt j_lt - have i_def : i = j + succ (pred (i-j)) := - calc i = j + (i-j) := (Nat.add_sub_cancel' i_ge).symm - _ = j + succ (pred (i-j)) := by - rw [← congrArg (j+·) (Nat.succ_pred i_sub_j_nez)] - rw [i_def] - simp only [testBit_to_div_mod, Nat.pow_add, Nat.mul_assoc] - simp only [Nat.mul_add_div (Nat.two_pow_pos _), Nat.mul_add_mod] - simp [Nat.pow_succ, Nat.mul_comm _ 2, Nat.mul_assoc, Nat.mul_add_mod] - | inr j_ge => - have j_def : j = i + (j-i) := (Nat.add_sub_cancel' j_ge).symm - simp only [ - testBit_to_div_mod, - Nat.not_lt_of_le, - j_ge, - ite_false] - simp [congrArg (2^·) j_def, Nat.pow_add, - ←Nat.div_div_eq_div_mul, - Nat.mul_add_div, - Nat.div_eq_of_lt b_lt, - Nat.two_pow_pos i] - -theorem testBit_mul_pow_two : - testBit (2 ^ i * a) j = (decide (j ≥ i) && testBit a (j-i)) := by - have gen := testBit_mul_pow_two_add a (Nat.two_pow_pos i) j - simp at gen - rw [gen] - cases Nat.lt_or_ge j i with - | _ p => simp [p, Nat.not_le_of_lt, Nat.not_lt_of_le] - -theorem mul_add_lt_is_or {b : Nat} (b_lt : b < 2^i) (a : Nat) : 2^i * a + b = 2^i * a ||| b := by - apply eq_of_testBit_eq - intro j - simp only [testBit_mul_pow_two_add _ b_lt, - testBit_or, testBit_mul_pow_two] - if j_lt : j < i then - simp [Nat.not_le_of_lt, j_lt] - else - have i_le : i ≤ j := Nat.le_of_not_lt j_lt - have b_lt_j := - calc b < 2 ^ i := b_lt - _ ≤ 2 ^ j := Nat.pow_le_pow_of_le_right Nat.zero_lt_two i_le - simp [i_le, j_lt, testBit_lt_two_pow, b_lt_j] - -/-! ### shiftLeft and shiftRight -/ - -@[simp] theorem testBit_shiftLeft (x : Nat) : testBit (x <<< i) j = - (decide (j ≥ i) && testBit x (j-i)) := by - simp [shiftLeft_eq, Nat.mul_comm _ (2^_), testBit_mul_pow_two] - -@[simp] theorem testBit_shiftRight (x : Nat) : testBit (x >>> i) j = testBit x (i+j) := by - simp [testBit, ←shiftRight_add] diff --git a/Std/Data/Rat/Lemmas.lean b/Std/Data/Rat/Lemmas.lean index 3b749f9593..ced2a09c08 100644 --- a/Std/Data/Rat/Lemmas.lean +++ b/Std/Data/Rat/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Rat.Basic -import Std.Tactic.NormCast.Ext import Std.Tactic.SeqFocus /-! # Additional lemmas about the Rational Numbers -/ diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 013b21e084..11aee37ec7 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -9,7 +9,6 @@ import Std.Data.List.Lemmas import Std.Data.String.Basic import Std.Tactic.Lint.Misc import Std.Tactic.SeqFocus -import Std.Tactic.Simpa @[simp] theorem Char.length_toString (c : Char) : c.toString.length = 1 := rfl diff --git a/Std/Data/Sum/Basic.lean b/Std/Data/Sum/Basic.lean index c5e93ed8f3..9ec75129b8 100644 --- a/Std/Data/Sum/Basic.lean +++ b/Std/Data/Sum/Basic.lean @@ -63,16 +63,6 @@ def getLeft : (ab : α ⊕ β) → ab.isLeft → α 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 diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index 8bdaecf130..cb9a4bc166 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -99,133 +99,11 @@ Erase any assignment or delayed assignment of the given metavariable. def eraseAssignment [MonadMCtx m] (mvarId : MVarId) : m Unit := modifyMCtx (·.eraseExprMVarAssignment mvarId) -/-- -Collect the metavariables which `mvarId` depends on. These are the metavariables -which appear in the type and local context of `mvarId`, as well as the -metavariables which *those* metavariables depend on, etc. --/ -partial def getMVarDependencies (mvarId : MVarId) (includeDelayed := false) : - MetaM (HashSet MVarId) := - (·.snd) <$> (go mvarId).run {} -where - /-- Auxiliary definition for `getMVarDependencies`. -/ - addMVars (e : Expr) : StateRefT (HashSet MVarId) MetaM Unit := do - let mvars ← getMVars e - let mut s ← get - set ({} : HashSet MVarId) -- Ensure that `s` is not shared. - for mvarId in mvars do - if ← pure includeDelayed <||> notM (mvarId.isDelayedAssigned) then - s := s.insert mvarId - set s - mvars.forM go - - /-- Auxiliary definition for `getMVarDependencies`. -/ - go (mvarId : MVarId) : StateRefT (HashSet MVarId) MetaM Unit := - withIncRecDepth do - let mdecl ← mvarId.getDecl - addMVars mdecl.type - for ldecl in mdecl.lctx do - addMVars ldecl.type - if let (some val) := ldecl.value? then - addMVars val - if let (some ass) ← getDelayedMVarAssignment? mvarId then - let pendingMVarId := ass.mvarIdPending - if ← notM pendingMVarId.isAssignedOrDelayedAssigned then - modify (·.insert pendingMVarId) - go pendingMVarId - -/-- Check if a goal is of a subsingleton type. -/ -def isSubsingleton (g : MVarId) : MetaM Bool := do - try - discard <| synthInstance (← mkAppM ``Subsingleton #[← g.getType]) - return true - catch _ => - return false - -/-- -Check if a goal is "independent" of a list of other goals. -We say a goal is independent of other goals if assigning a value to it -can not change the assignability of the other goals. - -Examples: -* `?m_1 : Type` is not independent of `?m_2 : ?m_1`, - because we could assign `true : Bool` to `?m_2`, - but if we first assign `Nat` to `?m_1` then that is no longer possible. -* `?m_1 : Nat` is not independent of `?m_2 : Fin ?m_1`, - because we could assign `37 : Fin 42` to `?m_2`, - but if we first assign `2` to `?m_1` then that is no longer possible. -* `?m_1 : ?m_2` is not independent of `?m_2 : Type`, because we could assign `Bool` to ?m_2`, - but if we first assign `0 : Nat` to `?m_1` then that is no longer possible. -* Given `P : Prop` and `f : P → Type`, `?m_1 : P` is independent of `?m_2 : f ?m_1` - by proof irrelevance. -* Similarly given `f : Fin 0 → Type`, `?m_1 : Fin 0` is independent of `?m_2 : f ?m_1`, - because `Fin 0` is a subsingleton. -* Finally `?m_1 : Nat` is independent of `?m_2 : α`, - as long as `?m_1` does not appear in `Meta.getMVars α` - (note that `Meta.getMVars` follows delayed assignments). - -This function only calculates a conservative approximation of this condition. -That is, it may return `false` when it should return `true`. -(In particular it returns false whenever the type of `g` contains a metavariable, -regardless of whether this is related to the metavariables in `L`.) --/ -def isIndependentOf (L : List MVarId) (g : MVarId) : MetaM Bool := g.withContext do - let t ← instantiateMVars (← g.getType) - if t.hasExprMVar then - -- If the goal's type contains other meta-variables, - -- we conservatively say that `g` is not independent. - -- It would be possible to check if `L` depends on these meta-variables. - return false - if (← inferType t).isProp then - -- If the goal is propositional, - -- proof-irrelevance ensures it is independent of any other goals. - return true - if ← g.isSubsingleton then - -- If the goal is a subsingleton, it is independent of any other goals. - return true - -- Finally, we check if the goal `g` appears in the type of any of the goals `L`. - L.allM fun g' => do pure !((← getMVarDependencies g').contains g) - /-- Solve a goal by synthesizing an instance. -/ -- FIXME: probably can just be `g.inferInstance` once leanprover/lean4#2054 is fixed def synthInstance (g : MVarId) : MetaM Unit := do g.assign (← Lean.Meta.synthInstance (← g.getType)) -/-- -Replace hypothesis `hyp` in goal `g` with `proof : typeNew`. -The new hypothesis is given the same user name as the original, -it attempts to avoid reordering hypotheses, and the original is cleared if possible. --/ --- adapted from Lean.Meta.replaceLocalDeclCore -def replace (g : MVarId) (hyp : FVarId) (proof : Expr) (typeNew : Option Expr := none) : - MetaM AssertAfterResult := - g.withContext do - let typeNew ← match typeNew with - | some t => pure t - | none => inferType proof - let ldecl ← hyp.getDecl - -- `typeNew` may contain variables that occur after `hyp`. - -- Thus, we use the auxiliary function `findMaxFVar` to ensure `typeNew` is well-formed - -- at the position we are inserting it. - let (_, ldecl') ← findMaxFVar typeNew |>.run ldecl - let result ← g.assertAfter ldecl'.fvarId ldecl.userName typeNew proof - (return { result with mvarId := ← result.mvarId.clear hyp }) <|> pure result -where - /-- Finds the `LocalDecl` for the FVar in `e` with the highest index. -/ - findMaxFVar (e : Expr) : StateRefT LocalDecl MetaM Unit := - e.forEach' fun e => do - if e.isFVar then - let ldecl' ← e.fvarId!.getDecl - modify fun ldecl => if ldecl'.index > ldecl.index then ldecl' else ldecl - return false - else - return e.hasFVar - -/-- Add the hypothesis `h : t`, given `v : t`, and return the new `FVarId`. -/ -def note (g : MVarId) (h : Name) (v : Expr) (t? : Option Expr := .none) : - MetaM (FVarId × MVarId) := do - (← g.assert h (← match t? with | some t => pure t | none => inferType v) v).intro1P - /-- Get the type the given metavariable after instantiating metavariables and cleaning up annotations. -/ def getTypeCleanup (mvarId : MVarId) : MetaM Expr := diff --git a/Std/Lean/Meta/Iterator.lean b/Std/Lean/Meta/Iterator.lean deleted file mode 100644 index cbfa5aac08..0000000000 --- a/Std/Lean/Meta/Iterator.lean +++ /dev/null @@ -1,69 +0,0 @@ -import Lean.Meta.Basic - -namespace Lean.Meta - -/-- -Provides an iterface for iterating over values that are bundled with the `Meta` state -they are valid in. --/ -protected structure Iterator (α : Type) where - /-- Function for getting next value and state pair. -/ - next : MetaM (Option (α × Meta.SavedState)) - -namespace Iterator - -/-- -Convert a list into an iterator with the current state. --/ -def ofList (l : List α) : MetaM (Meta.Iterator α) := do - let s ← saveState - let ref ← IO.mkRef l - let next := do - restoreState s - match ← ref.get with - | [] => - pure none - | r :: l => - ref.set l - pure <| some (r, ←saveState) - pure { next } - -/-- -Map and filter results of iterator and returning only those values returned -by `f`. --/ -partial def filterMapM (f : α → MetaM (Option β)) (L : Meta.Iterator α) : Meta.Iterator β := - { next := _next } - where _next := do - match ← L.next with - | none => - pure none - | some (v, s) => - restoreState s - let r ← f v - match r with - | none => - _next - | some r => - pure <| some (r, ←saveState) - -/-- -Find the first value in the iterator while resetting state or call `failure` -if empty. --/ -def head (L : Meta.Iterator α) : MetaM α := do - match ← L.next with - | none => - failure - | some (x, s) => - restoreState s - pure x - -/-- -Return the first value returned by the iterator that `f` succeeds on. --/ -def firstM (L : Meta.Iterator α) (f : α → MetaM (Option β)) : MetaM β := L.filterMapM f |>.head - -end Iterator - -end Lean.Meta diff --git a/Std/Lean/Parser.lean b/Std/Lean/Parser.lean deleted file mode 100644 index 0d8064c8d7..0000000000 --- a/Std/Lean/Parser.lean +++ /dev/null @@ -1,37 +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 --/ - -namespace Lean.Parser.Tactic - --- syntax simpArg := simpStar <|> simpErase <|> simpLemma -/-- -A `simpArg` is either a `*`, `-lemma` or a simp lemma specification -(which includes the `↑` `↓` `←` specifications for pre, post, reverse rewriting). --/ -def simpArg := simpStar.binary `orelse (simpErase.binary `orelse simpLemma) - -/-- A simp args list is a list of `simpArg`. This is the main argument to `simp`. -/ -syntax simpArgs := " [" simpArg,* "]" - -/-- Extract the arguments from a `simpArgs` syntax as an array of syntaxes -/ -def getSimpArgs? : Syntax → Option (Array Syntax) - | `(simpArgs| [$args,*]) => pure args.getElems - | _ => none - --- syntax dsimpArg := simpErase <|> simpLemma -/-- -A `dsimpArg` is similar to `simpArg`, but it does not have the `simpStar` form -because it does not make sense to use hypotheses in `dsimp`. --/ -def dsimpArg := simpErase.binary `orelse simpLemma - -/-- A dsimp args list is a list of `dsimpArg`. This is the main argument to `dsimp`. -/ -syntax dsimpArgs := " [" dsimpArg,* "]" - -/-- Extract the arguments from a `dsimpArgs` syntax as an array of syntaxes -/ -def getDSimpArgs? : Syntax → Option (Array Syntax) - | `(dsimpArgs| [$args,*]) => pure args.getElems - | _ => none diff --git a/Std/Tactic/Basic.lean b/Std/Tactic/Basic.lean index 0b21cf03f2..bda6786db5 100644 --- a/Std/Tactic/Basic.lean +++ b/Std/Tactic/Basic.lean @@ -3,7 +3,6 @@ import Std.Linter import Std.Tactic.Init import Std.Tactic.SeqFocus import Std.Tactic.ShowTerm -import Std.Tactic.SimpTrace import Std.Util.ProofWanted -- This is an import only file for common tactics used throughout Std diff --git a/Std/Tactic/LabelAttr.lean b/Std/Tactic/LabelAttr.lean deleted file mode 100644 index c6b5fcba67..0000000000 --- a/Std/Tactic/LabelAttr.lean +++ /dev/null @@ -1,95 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Lean.ScopedEnvExtension -import Lean.DocString - -/-! -# "Label" attributes - -Allow creating attributes using `register_label_attr`, -and retrieving the array of `Name`s of declarations which have been tagged with such an attribute. - -These differ slightly from the built-in "tag attributes" which can be initialized with the syntax: -``` -initialize someName : TagAttribute ← registerTagAttribute `tagName "description" -``` -in that a "tag attribute" can only be put on a declaration at the moment it is declared, -and can not be modified by scoping commands. - -The "label attributes" constructed here support adding (or locally removing) the attribute -either at the moment of declaration, or later. - --/ - -namespace Std.Tactic.LabelAttr - -open Lean - -/-- An environment extension that just tracks an array of names. -/ -abbrev LabelExtension := SimpleScopedEnvExtension Name (Array Name) - -/-- The collection of all current `LabelExtension`s, indexed by name. -/ -abbrev LabelExtensionMap := HashMap Name LabelExtension - -/-- Store the current `LabelExtension`s. -/ -initialize labelExtensionMapRef : IO.Ref LabelExtensionMap ← IO.mkRef {} - -/-- Helper function for `registerLabelAttr`. -/ -def mkLabelExt (name : Name := by exact decl_name%) : IO LabelExtension := - registerSimpleScopedEnvExtension { - name := name - initial := #[] - addEntry := fun d e => if d.contains e then d else d.push e - } - -/-- Helper function for `registerLabelAttr`. -/ -def mkLabelAttr (attrName : Name) (attrDescr : String) (ext : LabelExtension) - (ref : Name := by exact decl_name%) : IO Unit := -registerBuiltinAttribute { - ref := ref - name := attrName - descr := attrDescr - applicationTime := AttributeApplicationTime.afterCompilation - add := fun declName _ _ => - ext.add declName - erase := fun declName => do - let s := ext.getState (← getEnv) - modifyEnv fun env => ext.modifyState env fun _ => s.erase declName -} - -/-- -Construct a new "label attribute", -which does nothing except keep track of the names of the declarations with that attribute. - -Users will generally use the `register_label_attr` macro defined below. --/ -def registerLabelAttr (attrName : Name) (attrDescr : String) - (ref : Name := by exact decl_name%) : IO LabelExtension := do - let ext ← mkLabelExt ref - mkLabelAttr attrName attrDescr ext ref - labelExtensionMapRef.modify fun map => map.insert attrName ext - return ext - -/-- -Initialize a new "label" attribute. -Declarations tagged with the attribute can be retrieved using `Std.Tactic.LabelAttr.labelled`. --/ -macro (name := _root_.Lean.Parser.Command.registerLabelAttr) doc:(docComment)? - "register_label_attr " id:ident : command => do - let str := id.getId.toString - let idParser := mkIdentFrom id (`Parser.Attr ++ id.getId) - let descr := quote (removeLeadingSpaces - (doc.map (·.getDocString) |>.getD s!"labelled declarations for {id.getId.toString}")) - `($[$doc:docComment]? initialize ext : LabelExtension ← - registerLabelAttr $(quote id.getId) $descr $(quote id.getId) - $[$doc:docComment]? syntax (name := $idParser:ident) $(quote str):str : attr) - -/-- When `attrName` is an attribute created using `register_labelled_attr`, -return the names of all declarations labelled using that attribute. -/ -def labelled (attrName : Name) : CoreM (Array Name) := do - match (← labelExtensionMapRef.get).find? attrName with - | none => throwError "No extension named {attrName}" - | some ext => pure <| ext.getState (← getEnv) diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean index 104c8c67f3..ff33412e0b 100644 --- a/Std/Tactic/LibrarySearch.lean +++ b/Std/Tactic/LibrarySearch.lean @@ -8,8 +8,7 @@ import Std.Lean.CoreM import Std.Lean.Expr import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.LazyDiscrTree -import Std.Lean.Parser -import Std.Tactic.SolveByElim +import Lean.Elab.Tactic.SolveByElim import Std.Util.Pickle /-! @@ -362,11 +361,13 @@ def mkHeartbeatCheck (leavePercent : Nat) : MetaM (MetaM Bool) := do else do return (← getRemainingHeartbeats) < hbThreshold +open SolveByElim + /-- Shortcut for calling `solveByElim`. -/ def solveByElim (required : List Expr) (exfalso : Bool) (goals : List MVarId) (maxDepth : Nat) := do -- There is only a marginal decrease in performance for using the `symm` option for `solveByElim`. -- (measured via `lake build && time lake env lean test/librarySearch.lean`). - let cfg : SolveByElim.Config := + let cfg : SolveByElimConfig := { maxDepth, exfalso := exfalso, symm := true, commitIndependentGoals := true, transparency := ← getTransparency, -- `constructor` has been observed to significantly slow down `exact?` in Mathlib. diff --git a/Std/Tactic/NormCast.lean b/Std/Tactic/NormCast.lean deleted file mode 100644 index 034c16497c..0000000000 --- a/Std/Tactic/NormCast.lean +++ /dev/null @@ -1,349 +0,0 @@ -/- -Copyright (c) 2019 Paul-Nicolas Madelaine. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner --/ -import Lean.Elab.Tactic.Conv.Simp -import Std.Lean.Meta.Simp -import Std.Tactic.NormCast.Ext -import Std.Tactic.NormCast.Lemmas -import Std.Classes.Cast - -/-! -# The `norm_cast` family of tactics. --/ - -open Lean Meta Simp -open Std.Tactic.NormCast - -namespace Int - -/- These will be attached to definitions once norm_cast is in core. -/ -attribute [norm_cast] Nat.cast_ofNat_Int -attribute [norm_cast] ofNat_add -attribute [norm_cast] ofNat_sub -attribute [norm_cast] ofNat_mul -attribute [norm_cast] ofNat_inj -attribute [norm_cast] ofNat_ediv -attribute [norm_cast] ofNat_emod -attribute [norm_cast] ofNat_dvd -attribute [norm_cast] ofNat_le -attribute [norm_cast] ofNat_lt -attribute [norm_cast] ofNat_pos - -end Int - -namespace Std.Tactic.NormCast - -initialize registerTraceClass `Tactic.norm_cast - -/-- Prove `a = b` using the given simp set. -/ -def proveEqUsing (s : SimpTheorems) (a b : Expr) : MetaM (Option Simp.Result) := do - let go : SimpM (Option Simp.Result) := do - let a' ← Simp.simp a - let b' ← Simp.simp b - unless ← isDefEq a'.expr b'.expr do return none - a'.mkEqTrans (← mkEqSymm b b') - withReducible do - (go (← Simp.mkDefaultMethods).toMethodsRef - { simpTheorems := #[s], congrTheorems := ← Meta.getSimpCongrTheorems }).run' {} - -/-- Prove `a = b` by simplifying using move and squash lemmas. -/ -def proveEqUsingDown (a b : Expr) : MetaM (Option Simp.Result) := do - withTraceNode `Tactic.norm_cast (return m!"{exceptOptionEmoji ·} proving: {← mkEq a b}") do - proveEqUsing (← normCastExt.down.getTheorems) a b - -/-- Construct the expression `(e : ty)`. -/ -def mkCoe (e : Expr) (ty : Expr) : MetaM Expr := do - let .some e' ← coerce? e ty | failure - return e' - -/-- -Check if an expression is the coercion of some other expression, -and if so return that expression. --/ -def isCoeOf? (e : Expr) : MetaM (Option Expr) := do - if let Expr.const fn .. := e.getAppFn then - if let some info ← getCoeFnInfo? fn then - if e.getAppNumArgs == info.numArgs then - return e.getArg! info.coercee - return none - -/-- -Check if an expression is a numeral in some type, -and if so return that type and the natural number. --/ -def isNumeral? (e : Expr) : Option (Expr × Nat) := - if e.isConstOf ``Nat.zero then - (mkConst ``Nat, 0) - else if let Expr.app (Expr.app (Expr.app (Expr.const ``OfNat.ofNat ..) α ..) - (Expr.lit (Literal.natVal n) ..) ..) .. := e then - some (α, n) - else - none - -/-- -This is the main heuristic used alongside the elim and move lemmas. -The goal is to help casts move past operators by adding intermediate casts. -An expression of the shape: op (↑(x : α) : γ) (↑(y : β) : γ) -is rewritten to: op (↑(↑(x : α) : β) : γ) (↑(y : β) : γ) -when (↑(↑(x : α) : β) : γ) = (↑(x : α) : γ) can be proven with a squash lemma --/ -def splittingProcedure (expr : Expr) : MetaM Simp.Result := do - let Expr.app (Expr.app op x ..) y .. := expr | return {expr} - - let Expr.forallE _ γ (Expr.forallE _ γ' ty ..) .. ← inferType op | return {expr} - if γ'.hasLooseBVars || ty.hasLooseBVars then return {expr} - unless ← isDefEq γ γ' do return {expr} - - let msg := m!"splitting {expr}" - let msg - | .error _ => return m!"{bombEmoji} {msg}" - | .ok r => return if r.expr == expr then m!"{crossEmoji} {msg}" else - m!"{checkEmoji} {msg} to {r.expr}" - withTraceNode `Tactic.norm_cast msg do - - try - let some x' ← isCoeOf? x | failure - let some y' ← isCoeOf? y | failure - let α ← inferType x' - let β ← inferType y' - - -- TODO: fast timeout - (try - let x2 ← mkCoe (← mkCoe x' β) γ - let some x_x2 ← proveEqUsingDown x x2 | failure - Simp.mkCongrFun (← Simp.mkCongr {expr := op} x_x2) y - catch _ => - let y2 ← mkCoe (← mkCoe y' α) γ - let some y_y2 ← proveEqUsingDown y y2 | failure - Simp.mkCongr {expr := mkApp op x} y_y2) - catch _ => try - let some (_, n) := isNumeral? y | failure - let some x' ← isCoeOf? x | failure - let α ← inferType x' - let y2 ← mkCoe (← mkNumeral α n) γ - let some y_y2 ← proveEqUsingDown y y2 | failure - Simp.mkCongr {expr := mkApp op x} y_y2 - catch _ => try - let some (_, n) := isNumeral? x | failure - let some y' ← isCoeOf? y | failure - let β ← inferType y' - let x2 ← mkCoe (← mkNumeral β n) γ - let some x_x2 ← proveEqUsingDown x x2 | failure - Simp.mkCongrFun (← Simp.mkCongr {expr := op} x_x2) y - catch _ => - return {expr} - -/-- -Discharging function used during simplification in the "squash" step. --/ --- TODO: normCast takes a list of expressions to use as lemmas for the discharger --- TODO: a tactic to print the results the discharger fails to prove -def prove (e : Expr) : SimpM (Option Expr) := do - withTraceNode `Tactic.norm_cast (return m!"{exceptOptionEmoji ·} discharging: {e}") do - return (← findLocalDeclWithType? e).map mkFVar - -/-- -Core rewriting function used in the "squash" step, which moves casts upwards -and eliminates them. - -It tries to rewrite an expression using the elim and move lemmas. -On failure, it calls the splitting procedure heuristic. --/ -partial def upwardAndElim (up : SimpTheorems) (e : Expr) : SimpM Simp.Step := do - let r ← withDischarger prove do - Simp.rewrite? e up.post up.erased (tag := "squash") (rflOnly := false) - let r := r.getD { expr := e } - let r ← r.mkEqTrans (← splittingProcedure r.expr) - if r.expr == e then return Simp.Step.done {expr := e} - return Simp.Step.visit r - -/-- -If possible, rewrite `(n : α)` to `(Nat.cast n : α)` where `n` is a numeral and `α ≠ ℕ`. -Returns a pair of the new expression and proof that they are equal. --/ -def numeralToCoe (e : Expr) : MetaM Simp.Result := do - let some (α, n) := isNumeral? e | failure - if (← whnf α).isConstOf ``Nat then failure - let newE ← mkAppOptM ``Nat.cast #[α, none, toExpr n] - let some pr ← proveEqUsingDown e newE | failure - return pr - -/-- -The core simplification routine of `normCast`. --/ -def derive (e : Expr) : MetaM Simp.Result := do - withTraceNode `Tactic.norm_cast (fun _ => return m!"{e}") do - let e ← instantiateMVars e - - let config : Simp.Config := { - zeta := false - beta := false - eta := false - proj := false - iota := false - } - let congrTheorems ← Meta.getSimpCongrTheorems - - let r : Simp.Result := { expr := e } - - let withTrace phase := withTraceNode `Tactic.norm_cast fun - | .ok r => return m!"{r.expr} (after {phase})" - | .error _ => return m!"{bombEmoji} {phase}" - - -- step 1: pre-processing of numerals - let r ← withTrace "pre-processing numerals" do - let post e := return Simp.Step.done (← try numeralToCoe e catch _ => pure {expr := e}) - r.mkEqTrans (← Simp.main r.expr { config, congrTheorems } (methods := { post })).1 - - -- step 2: casts are moved upwards and eliminated - let r ← withTrace "moving upward, splitting and eliminating" do - let post := upwardAndElim (← normCastExt.up.getTheorems) - r.mkEqTrans (← Simp.main r.expr { config, congrTheorems } (methods := { post })).1 - - -- step 3: casts are squashed - let r ← withTrace "squashing" do - let simpTheorems := #[← normCastExt.squash.getTheorems] - r.mkEqTrans (← simp r.expr { simpTheorems, config, congrTheorems }).1 - - return r - -open Elab.Term in -/-- Term elaborator which uses the expected type to insert coercions. -/ -elab "mod_cast " e:term : term <= expectedType => do - if (← instantiateMVars expectedType).hasExprMVar then tryPostpone - let expectedType' ← derive expectedType - let e ← elabTerm e expectedType'.expr - synthesizeSyntheticMVars - let eTy ← instantiateMVars (← inferType e) - if eTy.hasExprMVar then tryPostpone - let eTy' ← derive eTy - unless ← isDefEq eTy'.expr expectedType'.expr do - throwTypeMismatchError "mod_cast" expectedType'.expr eTy'.expr e - let eTy_eq_expectedType ← eTy'.mkEqTrans (← mkEqSymm expectedType expectedType') - mkCast eTy_eq_expectedType e - -open Tactic Parser.Tactic Elab.Tactic - -/-- Implementation of the `norm_cast` tactic when operating on the main goal. -/ -def normCastTarget : TacticM Unit := - liftMetaTactic1 fun goal => do - let tgt ← instantiateMVars (← goal.getType) - let prf ← derive tgt - applySimpResultToTarget goal tgt prf - -/-- Implementation of the `norm_cast` tactic when operating on a hypothesis. -/ -def normCastHyp (fvarId : FVarId) : TacticM Unit := - liftMetaTactic1 fun goal => do - let hyp ← instantiateMVars (← fvarId.getDecl).type - let prf ← derive hyp - return (← applySimpResultToLocalDecl goal fvarId prf false).map (·.snd) - -/-- Implementation of `norm_cast` (the full `norm_cast` calls `trivial` afterwards). -/ -elab "norm_cast0" loc:((location)?) : tactic => - withMainContext do - match expandOptLocation loc with - | Location.targets hyps target => - if target then normCastTarget - (← getFVarIds hyps).forM normCastHyp - | Location.wildcard => - normCastTarget - (← (← getMainGoal).getNondepPropHyps).forM normCastHyp - -/-- `assumption_mod_cast` runs `norm_cast` on the goal. For each local hypothesis `h`, it also -normalizes `h` and tries to use that to close the goal. -/ -macro "assumption_mod_cast" : tactic => `(tactic| norm_cast0 at * <;> assumption) - -/-- -The `norm_cast` family of tactics is used to normalize casts inside expressions. -It is basically a simp tactic with a specific set of lemmas to move casts -upwards in the expression. -Therefore it can be used more safely as a non-terminating tactic. -It also has special handling of numerals. - -For instance, given an assumption -```lean -a b : ℤ -h : ↑a + ↑b < (10 : ℚ) -``` - -writing `norm_cast at h` will turn `h` into -```lean -h : a + b < 10 -``` - -You can also use `exact_mod_cast`, `apply_mod_cast`, `rw_mod_cast` -or `assumption_mod_cast`. -Writing `exact_mod_cast h` and `apply_mod_cast h` will normalize the goal and -`h` before using `exact h` or `apply h`. -Writing `assumption_mod_cast` will normalize the goal and for every -expression `h` in the context it will try to normalize `h` and use -`exact h`. -`rw_mod_cast` acts like the `rw` tactic but it applies `norm_cast` between steps. - -See also `push_cast`, for move casts inwards. - -The implementation and behavior of the `norm_cast` family is described in detail at -. --/ -macro "norm_cast" loc:(location)? : tactic => - `(tactic| norm_cast0 $[$loc]? <;> try trivial) - -/-- -Rewrite with the given rules and normalize casts between steps. --/ -syntax "rw_mod_cast" (config)? rwRuleSeq (location)? : tactic -macro_rules - | `(tactic| rw_mod_cast $[$config]? [$rules,*] $[$loc]?) => do - let tacs ← rules.getElems.mapM fun rule => - `(tactic| (norm_cast at *; rw $[$config]? [$rule] $[$loc]?)) - `(tactic| ($[$tacs]*)) - -/-- -Normalize the goal and the given expression, then close the goal with exact. --/ -macro "exact_mod_cast " e:term : tactic => `(tactic| exact mod_cast ($e : _)) - -/-- -Normalize the goal and the given expression, then apply the expression to the goal. --/ -macro "apply_mod_cast " e:term : tactic => `(tactic| apply mod_cast ($e : _)) - -/-- `norm_cast` tactic in `conv` mode. -/ -syntax (name := convNormCast) "norm_cast" : conv - -@[inherit_doc convNormCast, tactic convNormCast] def evalConvNormCast : Tactic := - open Elab.Tactic.Conv in fun _ => withMainContext do - applySimpResult (← derive (← getLhs)) - -/-- -`push_cast` rewrites the expression to move casts toward the leaf nodes. -This uses `norm_cast` lemmas in the forward direction. -For example, `↑(a + b)` will be written to `↑a + ↑b`. -It is equivalent to `simp only with push_cast`. -It can also be used at hypotheses with `push_cast at h` -and with extra simp lemmas with `push_cast [int.add_zero]`. - -```lean -example (a b : ℕ) (h1 : ((a + b : ℕ) : ℤ) = 10) (h2 : ((a + b + 0 : ℕ) : ℤ) = 10) : - ((a + b : ℕ) : ℤ) = 10 := -begin - push_cast, - push_cast at h1, - push_cast [int.add_zero] at h2, -end -``` - -The implementation and behavior of the `norm_cast` family is described in detail at -. --/ -syntax (name := pushCast) "push_cast" (config)? (discharger)? (&" only")? - (" [" (simpStar <|> simpErase <|> simpLemma),* "]")? (location)? : tactic - -@[inherit_doc pushCast, tactic pushCast] def evalPushCast : Tactic := fun stx => do - let { ctx, simprocs, dischargeWrapper } ← withMainContext do - mkSimpContext' (← pushCastExt.getTheorems) stx (eraseLocal := false) - let ctx := { ctx with config := { ctx.config with failIfUnchanged := false } } - dischargeWrapper.with fun discharge? => - discard <| simpLocation ctx simprocs discharge? (expandOptLocation stx[5]) diff --git a/Std/Tactic/NormCast/Ext.lean b/Std/Tactic/NormCast/Ext.lean deleted file mode 100644 index b43ae5bad2..0000000000 --- a/Std/Tactic/NormCast/Ext.lean +++ /dev/null @@ -1,219 +0,0 @@ -/- -Copyright (c) 2019 Paul-Nicolas Madelaine. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner --/ -import Lean.Meta.CoeAttr -import Lean.Meta.CongrTheorems -import Lean.Meta.Tactic.Simp.SimpTheorems - -open Lean Meta - -namespace Std.Tactic.NormCast - -/-- -`Label` is a type used to classify `norm_cast` lemmas. -* elim lemma: LHS has 0 head coes and ≥ 1 internal coe -* move lemma: LHS has 1 head coe and 0 internal coes, RHS has 0 head coes and ≥ 1 internal coes -* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes --/ -inductive Label - /-- elim lemma: LHS has 0 head coes and ≥ 1 internal coe -/ - | elim - /-- move lemma: LHS has 1 head coe and 0 internal coes, - RHS has 0 head coes and ≥ 1 internal coes -/ - | move - /-- squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes -/ - | squash - deriving DecidableEq, Repr, Inhabited - -/-- Assuming `e` is an application, returns the list of subterms that `simp` will rewrite in. -/ -def getSimpArgs (e : Expr) : MetaM (Array Expr) := do - match ← mkCongrSimp? e.getAppFn with - | none => return e.getAppArgs - | some {argKinds, ..} => - let mut args := #[] - for a in e.getAppArgs, k in argKinds do - if k matches .eq then - args := args.push a - return args - -/-- Count how many coercions are at the top of the expression. -/ -partial def countHeadCoes (e : Expr) : MetaM Nat := do - if let Expr.const fn .. := e.getAppFn then - if let some info ← getCoeFnInfo? fn then - if e.getAppNumArgs >= info.numArgs then - return (← countHeadCoes (e.getArg! info.coercee)) + 1 - return 0 - -/-- Count how many coercions are inside the expression, including the top ones. -/ -partial def countCoes (e : Expr) : MetaM Nat := - lambdaTelescope e fun _ e => do - if let Expr.const fn .. := e.getAppFn then - if let some info ← getCoeFnInfo? fn then - if e.getAppNumArgs >= info.numArgs then - let mut coes := (← countHeadCoes (e.getArg! info.coercee)) + 1 - for i in [info.numArgs:e.getAppNumArgs] do - coes := coes + (← countCoes (e.getArg! i)) - return coes - return (← (← getSimpArgs e).mapM countCoes).foldl (·+·) 0 - -/-- Count how many coercions are inside the expression, excluding the top ones. -/ -def countInternalCoes (e : Expr) : MetaM Nat := - return (← countCoes e) - (← countHeadCoes e) - -/-- Classifies a declaration of type `ty` as a `norm_cast` rule. -/ -def classifyType (ty : Expr) : MetaM Label := - forallTelescopeReducing ty fun _ ty => do - let ty ← whnf ty - let (lhs, rhs) ← - if ty.isAppOfArity ``Eq 3 then pure (ty.getArg! 1, ty.getArg! 2) - else if ty.isAppOfArity ``Iff 2 then pure (ty.getArg! 0, ty.getArg! 1) - else throwError "norm_cast: lemma must be = or ↔, but is{indentExpr ty}" - let lhsCoes ← countCoes lhs - if lhsCoes = 0 then - throwError "norm_cast: badly shaped lemma, lhs must contain at least one coe{indentExpr lhs}" - let lhsHeadCoes ← countHeadCoes lhs - let rhsHeadCoes ← countHeadCoes rhs - let rhsInternalCoes ← countInternalCoes rhs - if lhsHeadCoes = 0 then - return Label.elim - else if lhsHeadCoes = 1 then do - unless rhsHeadCoes = 0 do - throwError "norm_cast: badly shaped lemma, rhs can't start with coe{indentExpr rhs}" - if rhsInternalCoes = 0 then - return Label.squash - else - return Label.move - else if rhsHeadCoes < lhsHeadCoes then do - return Label.squash - else do - throwError "\ - norm_cast: badly shaped shaped squash lemma, \ - rhs must have fewer head coes than lhs{indentExpr ty}" - -/-- The `push_cast` simp attribute. -/ -initialize pushCastExt : SimpExtension ← - registerSimpAttr `push_cast "\ - The `push_cast` simp attribute uses `norm_cast` lemmas \ - to move casts toward the leaf nodes of the expression." - -/-- The `norm_cast` attribute stores three simp sets. -/ -structure NormCastExtension where - /-- A simp set which lifts coercion arrows to the top level. -/ - up : SimpExtension - /-- A simp set which pushes coercion arrows to the leaves. -/ - down : SimpExtension - /-- A simp set which simplifies transitive coercions. -/ - squash : SimpExtension - deriving Inhabited - -/-- The `norm_cast` extension data. -/ -initialize normCastExt : NormCastExtension ← pure { - up := ← mkSimpExt (decl_name% ++ `up) - down := ← mkSimpExt (decl_name% ++ `down) - squash := ← mkSimpExt (decl_name% ++ `squash) -} - -/-- `addElim decl` adds `decl` as an `elim` lemma to the cache. -/ -def addElim (decl : Name) - (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := - addSimpTheorem normCastExt.up decl (post := true) (inv := false) kind prio - -/-- `addMove decl` adds `decl` as a `move` lemma to the cache. -/ -def addMove (decl : Name) - (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := do - addSimpTheorem pushCastExt decl (post := true) (inv := false) kind prio - addSimpTheorem normCastExt.up decl (post := true) (inv := true) kind prio - addSimpTheorem normCastExt.down decl (post := true) (inv := false) kind prio - -/-- `addSquash decl` adds `decl` as a `squash` lemma to the cache. -/ -def addSquash (decl : Name) - (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := do - addSimpTheorem pushCastExt decl (post := true) (inv := false) kind prio - addSimpTheorem normCastExt.squash decl (post := true) (inv := false) kind prio - addSimpTheorem normCastExt.down decl (post := true) (inv := false) kind prio - -/-- `addInfer decl` infers the label of `decl` and adds it to the cache. - -* elim lemma: LHS has 0 head coes and ≥ 1 internal coe -* move lemma: LHS has 1 head coe and 0 internal coes, RHS has 0 head coes and ≥ 1 internal coes -* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes --/ -def addInfer (decl : Name) - (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := do - let ty := (← getConstInfo decl).type - match ← classifyType ty with - | Label.elim => addElim decl kind prio - | Label.squash => addSquash decl kind prio - | Label.move => addMove decl kind prio - -namespace Attr -/-- The possible `norm_cast` kinds: `elim`, `move`, or `squash`. -/ -syntax normCastLabel := &"elim" <|> &"move" <|> &"squash" - - -/-- -The `norm_cast` attribute should be given to lemmas that describe the -behaviour of a coercion in regard to an operator, a relation, or a particular -function. - -It only concerns equality or iff lemmas involving `↑`, `⇑` and `↥`, describing the behavior of -the coercion functions. -It does not apply to the explicit functions that define the coercions. - -Examples: -```lean -@[norm_cast] theorem coe_nat_inj' {m n : ℕ} : (↑m : ℤ) = ↑n ↔ m = n - -@[norm_cast] theorem coe_int_denom (n : ℤ) : (n : ℚ).denom = 1 - -@[norm_cast] theorem cast_id : ∀ n : ℚ, ↑n = n - -@[norm_cast] theorem coe_nat_add (m n : ℕ) : (↑(m + n) : ℤ) = ↑m + ↑n - -@[norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℤ) : α) = n - -@[norm_cast] theorem cast_one : ((1 : ℚ) : α) = 1 -``` - -Lemmas tagged with `@[norm_cast]` are classified into three categories: `move`, `elim`, and -`squash`. They are classified roughly as follows: - -* elim lemma: LHS has 0 head coes and ≥ 1 internal coe -* move lemma: LHS has 1 head coe and 0 internal coes, RHS has 0 head coes and ≥ 1 internal coes -* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes - -`norm_cast` uses `move` and `elim` lemmas to factor coercions toward the root of an expression -and to cancel them from both sides of an equation or relation. It uses `squash` lemmas to clean -up the result. - -Occasionally you may want to override the automatic classification. -You can do this by giving an optional `elim`, `move`, or `squash` parameter to the attribute. - -```lean -@[simp, norm_cast elim] lemma nat_cast_re (n : ℕ) : (n : ℂ).re = n := by - rw [← of_real_nat_cast, of_real_re] -``` - -Don't do this unless you understand what you are doing. - -A full description of the tactic, and the use of each lemma category, can be found at -. --/ -syntax (name := norm_cast) "norm_cast" (ppSpace normCastLabel)? (ppSpace num)? : attr -end Attr - -initialize registerBuiltinAttribute { - name := `norm_cast - descr := "attribute for norm_cast" - add := fun decl stx kind => MetaM.run' do - let `(attr| norm_cast $[$label:normCastLabel]? $[$prio]?) := stx | unreachable! - let prio := (prio.bind (·.1.isNatLit?)).getD (eval_prio default) - match label.bind (·.1.isStrLit?) with - | "elim" => addElim decl kind prio - | "move" => addMove decl kind prio - | "squash" => addSquash decl kind prio - | none => addInfer decl kind prio - | _ => unreachable! -} diff --git a/Std/Tactic/NormCast/Lemmas.lean b/Std/Tactic/NormCast/Lemmas.lean deleted file mode 100644 index 03bf033abf..0000000000 --- a/Std/Tactic/NormCast/Lemmas.lean +++ /dev/null @@ -1,18 +0,0 @@ -/- -Copyright (c) 2022 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner --/ - -import Std.Tactic.NormCast.Ext -import Lean.Elab.ElabRules - -open Lean Meta -/-- `add_elim foo` registers `foo` as an elim-lemma in `norm_cast`. -/ -local elab "add_elim " id:ident : command => - Elab.Command.liftCoreM do MetaM.run' do - Std.Tactic.NormCast.addElim (← resolveGlobalConstNoOverload id) - -add_elim ne_eq - -attribute [coe] Fin.val Array.ofSubarray diff --git a/Std/Tactic/Relation/Symm.lean b/Std/Tactic/Relation/Symm.lean deleted file mode 100644 index 2369a4efd6..0000000000 --- a/Std/Tactic/Relation/Symm.lean +++ /dev/null @@ -1,119 +0,0 @@ -/- -Copyright (c) 2022 Siddhartha Gadgil. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Siddhartha Gadgil, Mario Carneiro, Scott Morrison --/ -import Lean.Meta.Reduce -import Lean.Elab.Tactic.Location -import Std.Lean.Meta.Basic - -/-! -# `symm` tactic - -This implements the `symm` tactic, which can apply symmetry theorems to either the goal or a -hypothesis. --/ - -set_option autoImplicit true - -open Lean Meta - -namespace Std.Tactic - -/-- Discrimation tree settings for the `symm` extension. -/ -def symmExt.config : WhnfCoreConfig := {} - -/-- Environment extensions for symm lemmas -/ -initialize symmExt : - SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ← - registerSimpleScopedEnvExtension { - addEntry := fun dt (n, ks) => dt.insertCore ks n - initial := {} - } - -initialize registerBuiltinAttribute { - name := `symm - descr := "symmetric relation" - add := fun decl _ kind => MetaM.run' do - let declTy := (← getConstInfo decl).type - let (xs, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy - let fail := throwError - "@[symm] attribute only applies to lemmas proving x ∼ y → y ∼ x, got {declTy}" - let some _ := xs.back? | fail - let targetTy ← reduce targetTy - let .app (.app rel _) _ := targetTy | fail - let key ← withReducible <| DiscrTree.mkPath rel symmExt.config - symmExt.add (decl, key) kind -} - -end Std.Tactic - -open Std.Tactic - -namespace Lean.Expr - -/-- Return the symmetry lemmas that match the target type. -/ -def getSymmLems (tgt : Expr) : MetaM (Array Name) := do - let .app (.app rel _) _ := tgt - | throwError "symmetry lemmas only apply to binary relations, not{indentExpr tgt}" - (symmExt.getState (← getEnv)).getMatch rel symmExt.config - -/-- Given a term `e : a ~ b`, construct a term in `b ~ a` using `@[symm]` lemmas. -/ -def applySymm (e : Expr) : MetaM Expr := do - let tgt <- instantiateMVars (← inferType e) - let lems ← getSymmLems tgt - let s ← saveState - let act lem := do - restoreState s - let lem ← mkConstWithFreshMVarLevels lem - let (args, _, body) ← withReducible <| forallMetaTelescopeReducing (← inferType lem) - let .true ← isDefEq args.back e | failure - mkExpectedTypeHint (mkAppN lem args) (← instantiateMVars body) - lems.toList.firstM act - <|> throwError m!"no applicable symmetry lemma found for {indentExpr tgt}" - -end Lean.Expr - - -namespace Lean.MVarId - -/-- -Apply a symmetry lemma (i.e. marked with `@[symm]`) to a metavariable. - -The type of `g` should be of the form `a ~ b`, and is used to index the symm lemmas. --/ -def applySymm (g : MVarId) : MetaM MVarId := do - let tgt <- g.getTypeCleanup - let lems ← Expr.getSymmLems tgt - let act lem : MetaM MVarId := do - let lem ← mkConstWithFreshMVarLevels lem - let (args, _, body) ← withReducible <| forallMetaTelescopeReducing (← inferType lem) - let .true ← isDefEq (← g.getType) body | failure - g.assign (mkAppN lem args) - let g' := args.back.mvarId! - g'.setTag (← g.getTag) - pure g' - lems.toList.firstM act - <|> throwError m!"no applicable symmetry lemma found for {indentExpr tgt}" - -/-- Use a symmetry lemma (i.e. marked with `@[symm]`) to replace a hypothesis in a goal. -/ -def applySymmAt (h : FVarId) (g : MVarId) : MetaM MVarId := do - let h' ← (Expr.fvar h).applySymm - pure (← g.replace h h').mvarId - -end Lean.MVarId - -namespace Std.Tactic - -open Lean.Elab.Tactic - -/-- -* `symm` applies to a goal whose target has the form `t ~ u` where `~` is a symmetric relation, - that is, a relation which has a symmetry lemma tagged with the attribute [symm]. - It replaces the target with `u ~ t`. -* `symm at h` will rewrite a hypothesis `h : t ~ u` to `h : u ~ t`. --/ -elab "symm" loc:((Parser.Tactic.location)?) : tactic => - let atHyp h := liftMetaTactic1 fun g => g.applySymmAt h - let atTarget := liftMetaTactic1 fun g => g.applySymm - withLocation (expandOptLocation loc) atHyp atTarget fun _ => throwError "symm made no progress" diff --git a/Std/Tactic/SimpTrace.lean b/Std/Tactic/SimpTrace.lean deleted file mode 100644 index 30f1edbea1..0000000000 --- a/Std/Tactic/SimpTrace.lean +++ /dev/null @@ -1,123 +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 --/ -import Lean.Elab.ElabRules -import Lean.Elab.Tactic.Simp -import Lean.Meta.Tactic.TryThis -import Std.Lean.Parser - -/-! -# `simp?` tactic - -The `simp?` tactic is a simple wrapper around the simp with trace behavior implemented in core. --/ -namespace Std.Tactic -open Lean Elab Parser Tactic Meta Simp Meta.Tactic - -/-- The common arguments of `simp?` and `simp?!`. -/ -syntax simpTraceArgsRest := (config)? (discharger)? (&" only")? (simpArgs)? (ppSpace location)? - -/-- -`simp?` takes the same arguments as `simp`, but reports an equivalent call to `simp only` -that would be sufficient to close the goal. This is useful for reducing the size of the simp -set in a local invocation to speed up processing. -``` -example (x : Nat) : (if True then x + 2 else 3) = x + 2 := by - simp? -- prints "Try this: simp only [ite_true]" -``` - -This command can also be used in `simp_all` and `dsimp`. --/ -syntax (name := simpTrace) "simp?" "!"? simpTraceArgsRest : tactic - -@[inherit_doc simpTrace] -macro tk:"simp?!" rest:simpTraceArgsRest : tactic => `(tactic| simp?%$tk ! $rest) - -open TSyntax.Compat in -/-- Constructs the syntax for a simp call, for use with `simp?`. -/ -def mkSimpCallStx (stx : Syntax) (usedSimps : UsedSimps) : MetaM (TSyntax `tactic) := do - let stx := stx.unsetTrailing - mkSimpOnly stx usedSimps - -elab_rules : tactic - | `(tactic| - simp?%$tk $[!%$bang]? $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) => do - let stx ← if bang.isSome then - `(tactic| simp!%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) - else - `(tactic| simp%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) - let { ctx, simprocs, dischargeWrapper } ← - withMainContext <| mkSimpContext stx (eraseLocal := false) - let usedSimps ← dischargeWrapper.with fun discharge? => - simpLocation ctx (simprocs := simprocs) discharge? <| - (loc.map expandLocation).getD (.targets #[] true) - let stx ← mkSimpCallStx stx usedSimps - TryThis.addSuggestion tk stx (origSpan? := ← getRef) - -/-- The common arguments of `simp_all?` and `simp_all?!`. -/ -syntax simpAllTraceArgsRest := (config)? (discharger)? (&" only")? (dsimpArgs)? - -@[inherit_doc simpTrace] -syntax (name := simpAllTrace) "simp_all?" "!"? simpAllTraceArgsRest : tactic - -@[inherit_doc simpTrace] -macro tk:"simp_all?!" rest:simpAllTraceArgsRest : tactic => `(tactic| simp_all?%$tk ! $rest) - -elab_rules : tactic - | `(tactic| simp_all?%$tk $[!%$bang]? $(config)? $(discharger)? $[only%$o]? $[[$args,*]]?) => do - let stx ← if bang.isSome then - `(tactic| simp_all!%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]?) - else - `(tactic| simp_all%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]?) - let { ctx, .. } ← mkSimpContext stx (eraseLocal := true) - (kind := .simpAll) (ignoreStarArg := true) - let (result?, usedSimps) ← simpAll (← getMainGoal) ctx - match result? with - | none => replaceMainGoal [] - | some mvarId => replaceMainGoal [mvarId] - let stx ← mkSimpCallStx stx usedSimps - TryThis.addSuggestion tk stx (origSpan? := ← getRef) - -/-- The common arguments of `dsimp?` and `dsimp?!`. -/ -syntax dsimpTraceArgsRest := (config)? (&" only")? (dsimpArgs)? (ppSpace location)? - --- TODO: move to core -/-- Implementation of `dsimp`. -/ -def dsimpLocation' (ctx : Simp.Context) (loc : Location) : TacticM Simp.UsedSimps := do - match loc with - | Location.targets hyps simplifyTarget => - withMainContext do - let fvarIds ← getFVarIds hyps - go fvarIds simplifyTarget - | Location.wildcard => - withMainContext do - go (← (← getMainGoal).getNondepPropHyps) (simplifyTarget := true) -where - /-- Implementation of `dsimp`. -/ - go (fvarIdsToSimp : Array FVarId) (simplifyTarget : Bool) : TacticM Simp.UsedSimps := do - let mvarId ← getMainGoal - let (result?, usedSimps) ← - dsimpGoal mvarId ctx (simplifyTarget := simplifyTarget) (fvarIdsToSimp := fvarIdsToSimp) - match result? with - | none => replaceMainGoal [] - | some mvarId => replaceMainGoal [mvarId] - pure usedSimps - -@[inherit_doc simpTrace] -syntax (name := dsimpTrace) "dsimp?" "!"? dsimpTraceArgsRest : tactic - -@[inherit_doc simpTrace] -macro tk:"dsimp?!" rest:dsimpTraceArgsRest : tactic => `(tactic| dsimp?%$tk ! $rest) - -elab_rules : tactic - | `(tactic| dsimp?%$tk $[!%$bang]? $(config)? $[only%$o]? $[[$args,*]]? $(loc)?) => do - let stx ← if bang.isSome then - `(tactic| dsimp!%$tk $(config)? $[only%$o]? $[[$args,*]]? $(loc)?) - else - `(tactic| dsimp%$tk $(config)? $[only%$o]? $[[$args,*]]? $(loc)?) - let { ctx, .. } ← withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp) - let usedSimps ← dsimpLocation' ctx <| (loc.map expandLocation).getD (.targets #[] true) - let stx ← mkSimpCallStx stx usedSimps - TryThis.addSuggestion tk stx (origSpan? := ← getRef) diff --git a/Std/Tactic/Simpa.lean b/Std/Tactic/Simpa.lean deleted file mode 100644 index b333ef73d5..0000000000 --- a/Std/Tactic/Simpa.lean +++ /dev/null @@ -1,117 +0,0 @@ -/- -Copyright (c) 2018 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Arthur Paulino, Gabriel Ebner, Mario Carneiro --/ -import Lean.Meta.Tactic.Assumption -import Lean.Meta.Tactic.TryThis -import Lean.Elab.Tactic.Simp -import Lean.Linter.Util -import Std.Lean.Parser -import Std.Tactic.OpenPrivate - -/-- -Enables the 'unnecessary `simpa`' linter. This will report if a use of -`simpa` could be proven using `simp` or `simp at h` instead. --/ -register_option linter.unnecessarySimpa : Bool := { - defValue := true - descr := "enable the 'unnecessary simpa' linter" -} - -namespace Std.Tactic.Simpa - -open Lean Parser.Tactic Elab Meta Term Tactic Simp Linter - -/-- The arguments to the `simpa` family tactics. -/ -syntax simpaArgsRest := (config)? (discharger)? &" only "? (simpArgs)? (" using " term)? - -/-- -This is a "finishing" tactic modification of `simp`. It has two forms. - -* `simpa [rules, ⋯] using e` will simplify the goal and the type of - `e` using `rules`, then try to close the goal using `e`. - - Simplifying the type of `e` makes it more likely to match the goal - (which has also been simplified). This construction also tends to be - more robust under changes to the simp lemma set. - -* `simpa [rules, ⋯]` will simplify the goal and the type of a - hypothesis `this` if present in the context, then try to close the goal using - the `assumption` tactic. - -#TODO: implement `?` --/ -syntax (name := simpa) "simpa" "?"? "!"? simpaArgsRest : tactic -@[inherit_doc simpa] macro "simpa!" rest:simpaArgsRest : tactic => - `(tactic| simpa ! $rest:simpaArgsRest) -@[inherit_doc simpa] macro "simpa?" rest:simpaArgsRest : tactic => - `(tactic| simpa ? $rest:simpaArgsRest) -@[inherit_doc simpa] macro "simpa?!" rest:simpaArgsRest : tactic => - `(tactic| simpa ?! $rest:simpaArgsRest) - -open private useImplicitLambda from Lean.Elab.Term - - -/-- Gets the value of the `linter.unnecessarySimpa` option. -/ -def getLinterUnnecessarySimpa (o : Options) : Bool := - getLinterValue linter.unnecessarySimpa o - -deriving instance Repr for UseImplicitLambdaResult - -elab_rules : tactic -| `(tactic| simpa%$tk $[?%$squeeze]? $[!%$unfold]? $(cfg)? $(disch)? $[only%$only]? - $[[$args,*]]? $[using $usingArg]?) => Elab.Tactic.focus do - let stx ← `(tactic| simp $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]?) - let { ctx, simprocs, dischargeWrapper } ← - withMainContext <| mkSimpContext stx (eraseLocal := false) - let ctx := if unfold.isSome then { ctx with config.autoUnfold := true } else ctx - -- TODO: have `simpa` fail if it doesn't use `simp`. - let ctx := { ctx with config := { ctx.config with failIfUnchanged := false } } - dischargeWrapper.with fun discharge? => do - let (some (_, g), usedSimps) ← simpGoal (← getMainGoal) ctx (simprocs := simprocs) - (simplifyTarget := true) (discharge? := discharge?) - | if getLinterUnnecessarySimpa (← getOptions) then - logLint linter.unnecessarySimpa (← getRef) "try 'simp' instead of 'simpa'" - g.withContext do - let usedSimps ← if let some stx := usingArg then - setGoals [g] - g.withContext do - let e ← Tactic.elabTerm stx none (mayPostpone := true) - let (h, g) ← if let .fvar h ← instantiateMVars e then - pure (h, g) - else - (← g.assert `h (← inferType e) e).intro1 - let (result?, usedSimps) ← simpGoal g ctx (simprocs := simprocs) (fvarIdsToSimp := #[h]) - (simplifyTarget := false) (usedSimps := usedSimps) (discharge? := discharge?) - match result? with - | some (xs, g) => - let h := match xs with | #[h] | #[] => h | _ => unreachable! - let name ← mkFreshBinderNameForTactic `h - let g ← g.rename h name - g.assign <|← g.withContext do - Tactic.elabTermEnsuringType (mkIdent name) (← g.getType) - | none => - if getLinterUnnecessarySimpa (← getOptions) then - if (← getLCtx).getRoundtrippingUserName? h |>.isSome then - logLint linter.unnecessarySimpa (← getRef) - m!"try 'simp at {Expr.fvar h}' instead of 'simpa using {Expr.fvar h}'" - pure usedSimps - else if let some ldecl := (← getLCtx).findFromUserName? `this then - if let (some (_, g), usedSimps) ← simpGoal g ctx (simprocs := simprocs) - (fvarIdsToSimp := #[ldecl.fvarId]) (simplifyTarget := false) (usedSimps := usedSimps) - (discharge? := discharge?) then - g.assumption; pure usedSimps - else - pure usedSimps - else - g.assumption; pure usedSimps - if tactic.simp.trace.get (← getOptions) || squeeze.isSome then - let stx ← match ← mkSimpOnly stx usedSimps with - | `(tactic| simp $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]?) => - if unfold.isSome then - `(tactic| simpa! $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]? $[using $usingArg]?) - else - `(tactic| simpa $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]? $[using $usingArg]?) - | _ => unreachable! - TryThis.addSuggestion tk stx (origSpan? := ← getRef) diff --git a/Std/Tactic/SolveByElim.lean b/Std/Tactic/SolveByElim.lean deleted file mode 100644 index f97fd74492..0000000000 --- a/Std/Tactic/SolveByElim.lean +++ /dev/null @@ -1,564 +0,0 @@ -/- -Copyright (c) 2021 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison, David Renshaw --/ -import Lean.Elab.Tactic.Config -import Lean.Meta.Tactic.Repeat -import Std.Data.Sum.Basic -import Std.Tactic.LabelAttr -import Std.Tactic.Relation.Symm -import Std.Tactic.SolveByElim.Backtrack - -/-! -# `solve_by_elim`, `apply_rules`, and `apply_assumption`. - -`solve_by_elim` takes a collection of facts from the local context or -supplied as arguments by the user, and performs a backtracking -depth-first search by attempting to `apply` these facts to the goal. - -It is a highly configurable tactic, with options to control the -backtracking, to solve multiple goals simultaneously (with backtracking -between goals), or to supply a discharging tactic for unprovable goals. - -`apply_rules` and `apply_assumption` are much simpler tactics which do -not perform backtracking, but are currently implemented in terms of -`solve_by_elim` with backtracking disabled, in order to be able to share -the front-end customisation and parsing of user options. It would be -reasonable to further separate these in future. --/ - -open Lean Meta Elab Tactic -open Std.Tactic - -namespace Lean.MVarId - -/-- For every hypothesis `h : a ~ b` where a `@[symm]` lemma is available, -add a hypothesis `h_symm : b ~ a`. -/ -def symmSaturate (g : MVarId) : MetaM MVarId := g.withContext do - let mut g' := g - let hyps ← getLocalHyps - let types ← hyps.mapM inferType - for h in hyps do try - let symm ← h.applySymm - let symmType ← inferType symm - if ¬ (← types.anyM (isDefEq symmType)) then - (_, g') ← g'.note ((← h.fvarId!.getUserName).appendAfter "_symm") symm - catch _ => g' ← pure g' - return g' - -end Lean.MVarId - -namespace Std.Tactic - -open Lean.Elab.Tactic - -/-- For every hypothesis `h : a ~ b` where a `@[symm]` lemma is available, -add a hypothesis `h_symm : b ~ a`. -/ -elab "symm_saturate" : tactic => liftMetaTactic1 fun g => g.symmSaturate - -initialize registerTraceClass `Meta.Tactic.solveByElim - -namespace SolveByElim - -/-- -`applyTactics lemmas goal` will return an iterator that applies the -lemmas to the goal `goal` and returns ones that succeed. - -Providing this to the `backtracking` tactic, -we can perform backtracking search based on applying a list of lemmas. - -``applyTactics (trace := `name)`` will construct trace nodes for ``name` indicating which -calls to `apply` succeeded or failed. --/ -def applyTactics (cfg : ApplyConfig := {}) (transparency : TransparencyMode := .default) - (lemmas : List Expr) (g : MVarId) : MetaM (Lean.Meta.Iterator (List Lean.MVarId)) := do - pure <| - (← Meta.Iterator.ofList lemmas).filterMapM (fun e => observing? do - withTraceNode `Meta.Tactic.solveByElim (return m!"{Except.emoji ·} trying to apply: {e}") do - let goals ← withTransparency transparency (g.apply e cfg) - -- When we call `apply` interactively, `Lean.Elab.Tactic.evalApplyLikeTactic` - -- deals with closing new typeclass goals by calling - -- `Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing`. - -- It seems we can't reuse that machinery down here in `MetaM`, - -- so we just settle for trying to close each subgoal using `inferInstance`. - goals.filterM fun g => try g.inferInstance; pure false catch _ => pure true) - - -/-- -`applyFirst lemmas goal` applies the first of the `lemmas` -which can be successfully applied to `goal`, and fails if none apply. - -We use this in `apply_rules` and `apply_assumption` where backtracking is not needed. --/ -def applyFirst (cfg : ApplyConfig := {}) (transparency : TransparencyMode := .default) - (lemmas : List Expr) (g : MVarId) : MetaM (List MVarId) := do - (←applyTactics cfg transparency lemmas g).head - -/-- The default `maxDepth` for `apply_rules` is higher. -/ -structure ApplyRulesConfig extends BacktrackConfig, ApplyConfig where - /-- Transparency mode for calls to `apply`. -/ - transparency : TransparencyMode := .default - /-- Also use symmetric versions (via `@[symm]`) of local hypotheses. -/ - symm : Bool := true - /-- Try proving the goal via `exfalso` if `solve_by_elim` otherwise fails. - This is only used when operating on a single goal. -/ - exfalso : Bool := true - maxDepth := 50 - -/-- -Configuration structure to control the behaviour of `solve_by_elim`: -* transparency mode for calls to `apply` -* whether to use `symm` on hypotheses and `exfalso` on the goal as needed, -* see also `BacktrackConfig` for hooks allowing flow control. --/ -structure Config extends ApplyRulesConfig where - /-- Enable backtracking search. -/ - backtracking : Bool := true - maxDepth := 6 - /-- Trying calling `intro` if no lemmas apply. -/ - intro : Bool := true - /-- Try calling `constructor` if no lemmas apply. -/ - constructor : Bool := true - -instance : Coe Config BacktrackConfig := ⟨(·.toApplyRulesConfig.toBacktrackConfig)⟩ - -/-- -Allow elaboration of `Config` arguments to tactics. --/ -declare_config_elab elabConfig Config - -/-- -Allow elaboration of `ApplyRulesConfig` arguments to tactics. --/ -declare_config_elab elabApplyRulesConfig ApplyRulesConfig - -/-! -These functions could be lifted up to `BacktrackConfig`, -but we'd still need to keep copies here. --/ -namespace Config - -/-- Create or modify a `Config` which allows a class of goals to be returned as subgoals. -/ -def accept (cfg : Config := {}) (test : MVarId → MetaM Bool) : Config := - { cfg with - discharge := fun g => do - if (← test g) then - pure none - else - cfg.discharge g } - -/-- -Create or modify a `Config` which runs a tactic on the main goal. -If that tactic fails, fall back to the `proc` behaviour of `cfg`. --/ -def mainGoalProc (cfg : Config := {}) (proc : MVarId → MetaM (List MVarId)) : Config := - { cfg with - proc := fun orig goals => match goals with - | [] => cfg.proc orig [] - | g :: gs => try - return (← proc g) ++ gs - catch _ => cfg.proc orig goals } - -/-- Create or modify a `Config` which calls `intro` on each goal before applying lemmas. -/ --- Because `SolveByElim` works on each goal in sequence, even though --- `mainGoalProc` only applies this operation on the main goal, --- it is applied to every goal before lemmas are applied. -def intros (cfg : Config := {}) : Config := - cfg.mainGoalProc fun g => do pure [(← g.intro1P).2] - -/-- Attempt typeclass inference on each goal, before applying lemmas. -/ --- Because `SolveByElim` works on each goal in sequence, even though --- `mainGoalProc` only applies this operation on the main goal, --- it is applied to every goal before lemmas are applied. -def synthInstance (cfg : Config := {}) : Config := - cfg.mainGoalProc fun g => do g.synthInstance; pure [] - -/-- Add a discharging tactic, falling back to the original discharging tactic if it fails. -Return `none` to return the goal as a new subgoal, or `some goals` to replace it. -/ -def withDischarge (cfg : Config := {}) (discharge : MVarId → MetaM (Option (List MVarId))) : - Config := - { cfg with - discharge := fun g => try discharge g - catch _ => cfg.discharge g } - -/-- Create or modify a `Config` which calls `intro` on any goal for which no lemma applies. -/ -def introsAfter (cfg : Config := {}) : Config := - cfg.withDischarge fun g => do pure [(← g.intro1P).2] - -/-- Call `constructor` when no lemmas apply. -/ -def constructorAfter (cfg : Config := {}) : Config := - cfg.withDischarge fun g => g.constructor {newGoals := .all} - -/-- Create or modify a `Config` which -calls `synthInstance` on any goal for which no lemma applies. -/ -def synthInstanceAfter (cfg : Config := {}) : Config := - cfg.withDischarge fun g => do g.synthInstance; pure (some []) - -/-- -Create or modify a `Config` which rejects branches for which `test`, -applied to the instantiations of the original goals, fails or returns `false`. --/ -def testPartialSolutions (cfg : Config := {}) (test : List Expr → MetaM Bool) : Config := - { cfg with - proc := fun orig goals => do - let .true ← test (← orig.mapM fun m => m.withContext do instantiateMVars (.mvar m)) | failure - cfg.proc orig goals } - -/-- -Create or modify a `Config` which rejects complete solutions for which `test`, -applied to the instantiations of the original goals, fails or returns `false`. --/ -def testSolutions (cfg : Config := {}) (test : List Expr → MetaM Bool) : Config := - cfg.testPartialSolutions fun sols => do - if sols.any Expr.hasMVar then - pure true - else - test sols - -/-- -Create or modify a `Config` which only accept solutions -for which every expression in `use` appears as a subexpression. --/ -def requireUsingAll (cfg : Config := {}) (use : List Expr) : Config := - cfg.testSolutions fun sols => do - pure <| use.all fun e => sols.any fun s => e.occurs s - -/-- -Process the `intro` and `constructor` options by implementing the `discharger` tactic. --/ -def processOptions (cfg : Config) : Config := - let cfg := if cfg.intro then introsAfter { cfg with intro := false } else cfg - let cfg := if cfg.constructor then constructorAfter { cfg with constructor := false } else cfg - cfg - -end Config - -/-- -Elaborate a list of lemmas and local context. -See `mkAssumptionSet` for an explanation of why this is needed. --/ -def elabContextLemmas (g : MVarId) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr)) : - MetaM (List Expr) := do - g.withContext (Elab.Term.TermElabM.run' do pure ((← ctx) ++ (← lemmas.mapM id))) - -/-- Returns the list of tactics corresponding to applying the available lemmas to the goal. -/ -def applyLemmas (cfg : Config) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr)) - (g : MVarId) - : MetaM (Meta.Iterator (List MVarId)) := do - let es ← elabContextLemmas g lemmas ctx - applyTactics cfg.toApplyConfig cfg.transparency es g - -/-- Applies the first possible lemma to the goal. -/ -def applyFirstLemma (cfg : Config) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr)) - (g : MVarId) : MetaM (List MVarId) := do -let es ← elabContextLemmas g lemmas ctx -applyFirst cfg.toApplyConfig cfg.transparency es g - -/-- -Solve a collection of goals by repeatedly applying lemmas, backtracking as necessary. - -Arguments: -* `cfg : Config` additional configuration options - (options for `apply`, maximum depth, and custom flow control) -* `lemmas : List (TermElabM Expr)` lemmas to apply. - These are thunks in `TermElabM` to avoid stuck metavariables. -* `ctx : TermElabM (List Expr)` monadic function returning the local hypotheses to use. -* `goals : List MVarId` the initial list of goals for `solveByElim` - -Returns a list of suspended goals, if it succeeded on all other subgoals. -By default `cfg.suspend` is `false,` `cfg.discharge` fails, and `cfg.failAtMaxDepth` is `true`, -and so the returned list is always empty. -Custom wrappers (e.g. `apply_assumption` and `apply_rules`) may modify this behaviour. --/ -def solveByElim (cfg : Config) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr)) - (goals : List MVarId) : MetaM (List MVarId) := do - let cfg := cfg.processOptions - -- We handle `cfg.symm` by saturating hypotheses of all goals using `symm`. - -- This has better performance that the mathlib3 approach. - let preprocessedGoals ← if cfg.symm then - goals.mapM fun g => g.symmSaturate - else - pure goals - try - run cfg preprocessedGoals - catch e => do - -- Implementation note: as with `cfg.symm`, this is different from the mathlib3 approach, - -- for (not as severe) performance reasons. - match preprocessedGoals, cfg.exfalso with - | [g], true => - withTraceNode `Meta.Tactic.solveByElim - (fun _ => return m!"⏮️ starting over using `exfalso`") do - run cfg [← g.exfalso] - | _, _ => throw e -where - /-- Run either backtracking search, or repeated application, on the list of goals. -/ - run (cfg : Config) : List MVarId → MetaM (List MVarId) := - if cfg.backtracking then - backtrack cfg `Meta.Tactic.solveByElim (applyLemmas cfg lemmas ctx) - else - Lean.Meta.repeat1' (maxIters := cfg.maxDepth) (applyFirstLemma cfg lemmas ctx) - -/-- -A `MetaM` analogue of the `apply_rules` user tactic. - -We pass the lemmas as `TermElabM Expr` rather than just `Expr`, -so they can be generated fresh for each application, to avoid stuck metavariables. - -By default it uses all local hypotheses, but you can disable this with `only := true`. -If you need to remove particular local hypotheses, call `solveByElim` directly. --/ -def _root_.Lean.MVarId.applyRules (cfg : Config) (lemmas : List (TermElabM Expr)) - (only : Bool := false) (g : MVarId) : MetaM (List MVarId) := do - let ctx : TermElabM (List Expr) := if only then pure [] else do pure (← getLocalHyps).toList - solveByElim { cfg with backtracking := false } lemmas ctx [g] - -open Lean.Parser.Tactic -open Std.Tactic.LabelAttr (labelled) - -/-- -`mkAssumptionSet` builds a collection of lemmas for use in -the backtracking search in `solve_by_elim`. - -* By default, it includes all local hypotheses, along with `rfl`, `trivial`, `congrFun` - and `congrArg`. -* The flag `noDefaults` removes these. -* The flag `star` includes all local hypotheses, but not `rfl`, `trivial`, `congrFun`, - or `congrArg`. (It doesn't make sense to use `star` without `noDefaults`.) -* The argument `add` is the list of terms inside the square brackets that did not have `-` - and can be used to add expressions or local hypotheses -* The argument `remove` is the list of terms inside the square brackets that had a `-`, - and can be used to remove local hypotheses. - (It doesn't make sense to remove expressions which are not local hypotheses, - to remove local hypotheses unless `!noDefaults || star`, - and it does not make sense to use `star` unless you remove at least one local hypothesis.) - -`mkAssumptionSet` returns not a `List expr`, but a `List (TermElabM Expr) × TermElabM (List Expr)`. -There are two separate problems that need to be solved. - -### Stuck metavariables - -Lemmas with implicit arguments would be filled in with metavariables if we created the -`Expr` objects immediately, so instead we return thunks that generate the expressions -on demand. This is the first component, with type `List (TermElabM expr)`. - -As an example, we have `def rfl : ∀ {α : Sort u} {a : α}, a = a`, which on elaboration will become -`@rfl ?m_1 ?m_2`. - -Because `solve_by_elim` works by repeated application of lemmas against subgoals, -the first time such a lemma is successfully applied, -those metavariables will be unified, and thereafter have fixed values. -This would make it impossible to apply the lemma -a second time with different values of the metavariables. - -See https://github.com/leanprover-community/mathlib/issues/2269 - -### Relevant local hypotheses - -`solve_by_elim*` works with multiple goals, -and we need to use separate sets of local hypotheses for each goal. -The second component of the returned value provides these local hypotheses. -(Essentially using `local_context`, along with some filtering to remove hypotheses -that have been explicitly removed via `only` or `[-h]`.) - --/ --- These `TermElabM`s must be run inside a suitable `g.withContext`, --- usually using `elabContextLemmas`. -def mkAssumptionSet (noDefaults star : Bool) (add remove : List Term) (use : Array Ident) : - MetaM (List (TermElabM Expr) × TermElabM (List Expr)) := do - if star && !noDefaults then - throwError "It doesn't make sense to use `*` without `only`." - - let defaults : List (TermElabM Expr) := - [← `(rfl), ← `(trivial), ← `(congrFun), ← `(congrArg)].map elab' - let labelledLemmas := (← use.mapM (labelled ·.raw.getId)).flatten.toList - |>.map (liftM <| mkConstWithFreshMVarLevels ·) - let lemmas := if noDefaults then - add.map elab' ++ labelledLemmas - else - add.map elab' ++ labelledLemmas ++ defaults - - if !remove.isEmpty && noDefaults && !star then - throwError "It doesn't make sense to remove local hypotheses when using `only` without `*`." - let locals : TermElabM (List Expr) := if noDefaults && !star then do - pure [] - else do - pure <| (← getLocalHyps).toList.removeAll (← remove.mapM elab') - - return (lemmas, locals) - where - /-- Run `elabTerm`. -/ - elab' (t : Term) : TermElabM Expr := Elab.Term.elabTerm t.raw none - -/-- Syntax for omitting a local hypothesis in `solve_by_elim`. -/ -syntax erase := "-" term:max -/-- Syntax for including all local hypotheses in `solve_by_elim`. -/ -syntax star := "*" -/-- Syntax for adding or removing a term, or `*`, in `solve_by_elim`. -/ -syntax arg := star <|> erase <|> term -/-- Syntax for adding and removing terms in `solve_by_elim`. -/ -syntax args := " [" SolveByElim.arg,* "]" -/-- Syntax for using all lemmas labelled with an attribute in `solve_by_elim`. -/ -syntax using_ := " using " ident,* - -open Syntax - -/-- -Parse the lemma argument of a call to `solve_by_elim`. -The first component should be true if `*` appears at least once. -The second component should contain each term `t`in the arguments. -The third component should contain `t` for each `-t` in the arguments. --/ -def parseArgs (s : Option (TSyntax ``args)) : - Bool × List Term × List Term := - let args : Array (TSyntax ``arg) := match s with - | some s => match s with - | `(args| [$args,*]) => args.getElems - | _ => #[] - | none => #[] - let args : Array (Option (Term ⊕ Term)) := args.map fun t => match t with - | `(arg| $_:star) => none - | `(arg| - $t:term) => some (Sum.inr t) - | `(arg| $t:term) => some (Sum.inl t) - | _ => panic! "Unreachable parse of solve_by_elim arguments." - let args := args.toList - (args.contains none, - args.filterMap fun o => o.bind Sum.getLeft?, - args.filterMap fun o => o.bind Sum.getRight?) - -/-- Parse the `using ...` argument for `solve_by_elim`. -/ -def parseUsing (s : Option (TSyntax ``using_)) : Array Ident := - match s with - | some s => match s with - | `(using_ | using $ids,*) => ids.getElems - | _ => #[] - | none => #[] - -/-- -`solve_by_elim` calls `apply` on the main goal to find an assumption whose head matches -and then repeatedly calls `apply` on the generated subgoals until no subgoals remain, -performing at most `maxDepth` (defaults to 6) recursive steps. - -`solve_by_elim` discharges the current goal or fails. - -`solve_by_elim` performs backtracking if subgoals can not be solved. - -By default, the assumptions passed to `apply` are the local context, `rfl`, `trivial`, -`congrFun` and `congrArg`. - -The assumptions can be modified with similar syntax as for `simp`: -* `solve_by_elim [h₁, h₂, ..., hᵣ]` also applies the given expressions. -* `solve_by_elim only [h₁, h₂, ..., hᵣ]` does not include the local context, - `rfl`, `trivial`, `congrFun`, or `congrArg` unless they are explicitly included. -* `solve_by_elim [-h₁, ... -hₙ]` removes the given local hypotheses. -* `solve_by_elim using [a₁, ...]` uses all lemmas which have been labelled - with the attributes `aᵢ` (these attributes must be created using `register_label_attr`). - -`solve_by_elim*` tries to solve all goals together, using backtracking if a solution for one goal -makes other goals impossible. -(Adding or removing local hypotheses may not be well-behaved when starting with multiple goals.) - -Optional arguments passed via a configuration argument as `solve_by_elim (config := { ... })` -- `maxDepth`: number of attempts at discharging generated subgoals -- `symm`: adds all hypotheses derived by `symm` (defaults to `true`). -- `exfalso`: allow calling `exfalso` and trying again if `solve_by_elim` fails - (defaults to `true`). -- `transparency`: change the transparency mode when calling `apply`. Defaults to `.default`, - but it is often useful to change to `.reducible`, - so semireducible definitions will not be unfolded when trying to apply a lemma. - -See also the doc-comment for `Std.Tactic.BacktrackConfig` for the options -`proc`, `suspend`, and `discharge` which allow further customization of `solve_by_elim`. -Both `apply_assumption` and `apply_rules` are implemented via these hooks. --/ -syntax (name := solveByElimSyntax) - "solve_by_elim" "*"? (config)? (&" only")? (args)? (using_)? : tactic - -/-- Wrapper for `solveByElim` that processes a list of `Term`s -that specify the lemmas to use. -/ -def solveByElim.processSyntax (cfg : Config := {}) (only star : Bool) (add remove : List Term) - (use : Array Ident) (goals : List MVarId) : MetaM (List MVarId) := do - if !remove.isEmpty && goals.length > 1 then - throwError "Removing local hypotheses is not supported when operating on multiple goals." - let ⟨lemmas, ctx⟩ ← mkAssumptionSet only star add remove use - solveByElim cfg lemmas ctx goals - -elab_rules : tactic | - `(tactic| solve_by_elim $[*%$s]? $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do - let (star, add, remove) := parseArgs t - let use := parseUsing use - let goals ← if s.isSome then - getGoals - else - pure [← getMainGoal] - let cfg ← elabConfig (mkOptionalNode cfg) - let [] ← solveByElim.processSyntax cfg o.isSome star add remove use goals | - throwError "solve_by_elim unexpectedly returned subgoals" - pure () - -/-- -`apply_assumption` looks for an assumption of the form `... → ∀ _, ... → head` -where `head` matches the current goal. - -You can specify additional rules to apply using `apply_assumption [...]`. -By default `apply_assumption` will also try `rfl`, `trivial`, `congrFun`, and `congrArg`. -If you don't want these, or don't want to use all hypotheses, use `apply_assumption only [...]`. -You can use `apply_assumption [-h]` to omit a local hypothesis. -You can use `apply_assumption using [a₁, ...]` to use all lemmas which have been labelled -with the attributes `aᵢ` (these attributes must be created using `register_label_attr`). - -`apply_assumption` will use consequences of local hypotheses obtained via `symm`. - -If `apply_assumption` fails, it will call `exfalso` and try again. -Thus if there is an assumption of the form `P → ¬ Q`, the new tactic state -will have two goals, `P` and `Q`. - -You can pass a further configuration via the syntax `apply_rules (config := {...}) lemmas`. -The options supported are the same as for `solve_by_elim` (and include all the options for `apply`). --/ -syntax (name := applyAssumptionSyntax) - "apply_assumption" (config)? (&" only")? (args)? (using_)? : tactic - -elab_rules : tactic | - `(tactic| apply_assumption $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do - let (star, add, remove) := parseArgs t - let use := parseUsing use - let cfg ← elabConfig (mkOptionalNode cfg) - let cfg := { cfg with - backtracking := false - maxDepth := 1 } - replaceMainGoal (← solveByElim.processSyntax cfg o.isSome star add remove use [← getMainGoal]) - -/-- -`apply_rules [l₁, l₂, ...]` tries to solve the main goal by iteratively -applying the list of lemmas `[l₁, l₂, ...]` or by applying a local hypothesis. -If `apply` generates new goals, `apply_rules` iteratively tries to solve those goals. -You can use `apply_rules [-h]` to omit a local hypothesis. - -`apply_rules` will also use `rfl`, `trivial`, `congrFun` and `congrArg`. -These can be disabled, as can local hypotheses, by using `apply_rules only [...]`. - -You can use `apply_rules using [a₁, ...]` to use all lemmas which have been labelled -with the attributes `aᵢ` (these attributes must be created using `register_label_attr`). - -You can pass a further configuration via the syntax `apply_rules (config := {...})`. -The options supported are the same as for `solve_by_elim` (and include all the options for `apply`). - -`apply_rules` will try calling `symm` on hypotheses and `exfalso` on the goal as needed. -This can be disabled with `apply_rules (config := {symm := false, exfalso := false})`. - -You can bound the iteration depth using the syntax `apply_rules (config := {maxDepth := n})`. - -Unlike `solve_by_elim`, `apply_rules` does not perform backtracking, and greedily applies -a lemma from the list until it gets stuck. --/ -syntax (name := applyRulesSyntax) "apply_rules" (config)? (&" only")? (args)? (using_)? : tactic - --- See also `Lean.MVarId.applyRules` for a `MetaM` level analogue of this tactic. -elab_rules : tactic | - `(tactic| apply_rules $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do - let (star, add, remove) := parseArgs t - let use := parseUsing use - let cfg ← elabApplyRulesConfig (mkOptionalNode cfg) - let cfg := { cfg with backtracking := false } - liftMetaTactic fun g => solveByElim.processSyntax cfg o.isSome star add remove use [g] diff --git a/Std/Tactic/SolveByElim/Backtrack.lean b/Std/Tactic/SolveByElim/Backtrack.lean deleted file mode 100644 index 93b03ed4e8..0000000000 --- a/Std/Tactic/SolveByElim/Backtrack.lean +++ /dev/null @@ -1,205 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Data.List.Basic -import Std.Lean.Except -import Std.Lean.Meta.Basic -import Std.Lean.Meta.Iterator - -/-! -# `backtrack` - -A meta-tactic for running backtracking search, given a non-deterministic tactic -`alternatives : MVarId → Nondet MetaM (List MVarId)`. - -`backtrack alternatives goals` will recursively try to solve all goals in `goals`, -and the subgoals generated, backtracking as necessary. - -In its default behaviour, it will either solve all goals, or fail. -A customisable `suspend` hook in `BacktrackConfig` allows suspend a goal (or subgoal), -so that it will be returned instead of processed further. -Other hooks `proc` and `discharge` (described in `BacktrackConfig`) allow running other -tactics before `alternatives`, or if all search branches from a given goal fail. - -Currently only `solveByElim` is implemented in terms of `backtrack`. --/ - -namespace Std.Tactic - -open Lean Meta - -/-- -Configuration structure to control the behaviour of `backtrack`: -* control the maximum depth and behaviour (fail or return subgoals) at the maximum depth, -* and hooks allowing - * modifying intermediate goals before running the external tactic, - * 'suspending' goals, returning them in the result, and - * discharging subgoals if the external tactic fails. --/ -structure BacktrackConfig where - /-- Maximum recursion depth. -/ - maxDepth : Nat := 6 - /-- An arbitrary procedure which can be used to modify the list of goals - before each attempt to generate alternatives. - Called as `proc goals curr`, where `goals` are the original goals for `backtracking`, - and `curr` are the current goals. - Returning `some l` will replace the current goals with `l` and recurse - (consuming one step of maximum depth). - Returning `none` will proceed to generating alternative without changing goals. - Failure will cause backtracking. - (defaults to `none`) -/ - proc : List MVarId → List MVarId → MetaM (Option (List MVarId)) := fun _ _ => pure none - /-- If `suspend g`, then we do not consider alternatives for `g`, - but return `g` as a new subgoal. (defaults to `false`) -/ - suspend : MVarId → MetaM Bool := fun _ => pure false - /-- `discharge g` is called on goals for which there were no alternatives. - If `none` we return `g` as a new subgoal. - If `some l`, we replace `g` by `l` in the list of active goals, and recurse. - If failure, we backtrack. (defaults to failure) -/ - discharge : MVarId → MetaM (Option (List MVarId)) := fun _ => failure - /-- - If we solve any "independent" goals, don't fail. - See `Lean.MVarId.independent?` for the definition of independence. - -/ - commitIndependentGoals : Bool := false - -namespace Backtrack - -/-- -Pretty print a list of goals. --/ -private def ppMVarId (g : MVarId) : MetaM Format := ppExpr =<< g.getType - -/-- -Pretty print a list of goals. --/ -private def ppMVarIds (gs : List MVarId) : MetaM (List Format) := gs.mapM ppMVarId - -/-- Run a monadic function on every element of a list, -returning the list of elements on which the function fails, and the list of successful results. -/ -def tryAllM [Monad m] [Alternative m] (L : List α) (f : α → m β) : m (List α × List β) := do - let R ← L.mapM (fun a => (Sum.inr <$> f a) <|> (pure (Sum.inl a))) - return (R.filterMap (fun s => match s with | .inl a => a | _ => none), - R.filterMap (fun s => match s with | .inr b => b | _ => none)) - -variable (cfg : BacktrackConfig) -variable (trace : Name := .anonymous) -variable (next : MVarId → (List MVarId -> MetaM (Option (List MVarId))) -> MetaM (List MVarId)) - -/-- -* `n : Nat` steps remaining. -* `curr : List MVarId` the current list of unsolved goals. -* `acc : List MVarId` a list of "suspended" goals, which will be returned as subgoals. --/ - -- `acc` is intentionally a `List` rather than an `Array` so we can share across branches. -private def run (goals : List MVarId) (n : Nat) (curr acc : List MVarId) : MetaM (List MVarId) := do - match n with - | 0 => do - -- We're out of fuel. - throwError "backtrack exceeded the recursion limit" - | n + 1 => do - -- First, run `cfg.proc`, to see if it wants to modify the goals. - let procResult? ← try - cfg.proc goals curr - catch e => - withTraceNode trace - (return m!"{Except.emoji ·} BacktrackConfig.proc failed: {e.toMessageData}") do - throw e - match procResult? with - | some curr' => run goals n curr' acc - | none => - match curr with - -- If there are no active goals, return the accumulated goals. - | [] => withTraceNode trace (return m!"{Except.emoji ·} success!") do - return acc.reverse - | g :: gs => - -- Discard any goals which have already been assigned. - if ← g.isAssigned then - withTraceNode trace (return m!"{Except.emoji ·} discarding already assigned goal {g}") do - run goals (n+1) gs acc - else - withTraceNode trace - -- Note: the `addMessageContextFull` ensures we show the goal using the mvar context before - -- the `do` block below runs, potentially unifying mvars in the goal. - (return m!"{Except.emoji ·} working on: {← addMessageContextFull g}") - do - -- Check if we should suspend the search here: - if (← cfg.suspend g) then - withTraceNode trace - (fun _ => return m!"⏸️ suspending search and returning as subgoal") do - run goals (n+1) gs (g :: acc) - else - try - -- We attempt to find an alternative, - -- for which all resulting sub-goals can be discharged using `run n`. - next g (fun r => observing? do run goals n (r ++ gs) acc) - catch _ => - -- No lemmas could be applied: - match (← cfg.discharge g) with - | none => (withTraceNode trace - (fun _ => return m!"⏭️ deemed acceptable, returning as subgoal") do - run goals (n+1) gs (g :: acc)) - | some l => (withTraceNode trace - (fun _ => return m!"⏬ discharger generated new subgoals") do - run goals n (l ++ gs) acc) - -/-- -A wrapper around `run`, which works on "independent" goals separately first, -to reduce backtracking. --/ -private partial def processIndependentGoals (orig : List MVarId) (goals remaining : List MVarId) : - MetaM (List MVarId) := do - -- Partition the remaining goals into "independent" goals - -- (which should be solvable without affecting the solvability of other goals) - -- and all the others. - let (igs, ogs) ← remaining.partitionM (MVarId.isIndependentOf goals) - if igs.isEmpty then - -- If there are no independent goals, we solve all the goals together via backtracking search. - return (← run cfg trace next orig cfg.maxDepth remaining []) - else - withTraceNode trace - (fun _ => return m!"independent goals {← ppMVarIds igs}," - ++ m!" working on them before {← ppMVarIds ogs}") do - -- Invoke `run` on each of the independent goals separately, - -- gathering the subgoals on which `run` fails, - -- and the new subgoals generated from goals on which it is successful. - let (failed, newSubgoals') ← tryAllM igs fun g => - run cfg trace next orig cfg.maxDepth [g] [] - let newSubgoals := newSubgoals'.join - withTraceNode trace - (fun _ => return m!"failed: {← ppMVarIds failed}, new: {← ppMVarIds newSubgoals}") do - -- Update the list of goals with respect to which we need to check independence. - let goals' := (← goals.filterM (fun g => do pure !(← g.isAssigned))) ++ newSubgoals - -- If `commitIndependentGoals` is `true`, we will return the new goals - -- regardless of whether we can make further progress on the other goals. - if cfg.commitIndependentGoals && !newSubgoals.isEmpty then - return newSubgoals ++ failed ++ (← (processIndependentGoals orig goals' ogs <|> pure ogs)) - else if !failed.isEmpty then - -- If `commitIndependentGoals` is `false`, and we failed on any of the independent goals, - -- then overall failure is inevitable so we can stop here. - failure - else - -- Finally, having solved this batch of independent goals, - -- recurse (potentially now finding new independent goals). - return newSubgoals ++ (← processIndependentGoals orig goals' ogs) - -end Backtrack - - -/-- -Attempts to solve the `goals`, by recursively calling `next` on each -subgoal that appears with a callback to reenter backtracking search. - -Further flow control options are available via the `Config` argument. - -Returns a list of subgoals which were "suspended" via the `suspend` or -`discharge` hooks in `Config`. In the default configuration, `backtrack` -will either return an empty list or fail. --/ -def backtrack (cfg : BacktrackConfig := {}) (trace : Name := .anonymous) - (next : MVarId → MetaM (Meta.Iterator (List MVarId))) - (goals : List MVarId) : MetaM (List MVarId) := do - let resolve g f := do (←next g).firstM f - Backtrack.processIndependentGoals cfg trace resolve goals goals goals diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 49b8853680..820618d84a 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -3,9 +3,7 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Lean.Elab.Tactic.Simp -import Lean.Meta.Tactic.TryThis -import Std.Tactic.SimpTrace +import Lean.Elab.Tactic.SimpTrace /-! # `squeeze_scope` tactic diff --git a/Std/Test/Internal/DummyLabelAttr.lean b/Std/Test/Internal/DummyLabelAttr.lean index 2104976c00..9b746b6bd7 100644 --- a/Std/Test/Internal/DummyLabelAttr.lean +++ b/Std/Test/Internal/DummyLabelAttr.lean @@ -3,7 +3,7 @@ Copyright (c) 2023 Lean FRO, LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Std.Tactic.LabelAttr +import Lean.LabelAttribute /-- A dummy label attribute, which can be used for testing. -/ -- This can't live in `Std.Tactic.LabelAttr` diff --git a/Std/Util/CheckTactic.lean b/Std/Util/CheckTactic.lean index 76cfedf473..4e71f4c431 100644 --- a/Std/Util/CheckTactic.lean +++ b/Std/Util/CheckTactic.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joe Hendrix -/ import Lean.Elab.Tactic.ElabTerm +import Lean.Elab.Term /- This file is the home for commands to tactics behave as expected. @@ -19,8 +20,7 @@ IT namespace Std.Tactic -open Lean -open Elab.Tactic +open Lean Elab Tactic open Meta /-- @@ -32,6 +32,15 @@ It is used by the #check_tactic command. private inductive CheckGoalType {α : Sort u} : (val : α) → Prop where | intro : (val : α) → CheckGoalType val +private def matchCheckGoalType (stx : Syntax) (goalType : Expr) : MetaM (Expr × Expr × Level) := do + let u ← mkFreshLevelMVar + let type ← mkFreshExprMVar (some (.sort u)) + let val ← mkFreshExprMVar (some type) + let extType := mkAppN (.const ``CheckGoalType [u]) #[type, val] + if !(← isDefEq goalType extType) then + throwErrorAt stx "Goal{indentExpr goalType}\nis expected to match {indentExpr extType}" + pure (val, type, u) + /-- `check_tactic_goal t` verifies that the goal has is equal to `CheckGoalType t` with reducible transparency. It closes the goal if so @@ -41,7 +50,6 @@ It is used by #check_tactic. -/ local syntax (name := check_tactic_goal) "check_tactic_goal " term : tactic - /-- Implementation of `check_tactic_goal` -/ @@ -49,12 +57,7 @@ Implementation of `check_tactic_goal` match stx with | `(tactic| check_tactic_goal $exp) => closeMainGoalUsing (checkUnassigned := false) fun goalType => do - let u ← mkFreshLevelMVar - let type ← mkFreshExprMVar (.some (.sort u)) - let val ← mkFreshExprMVar (.some type) - let extType := mkAppN (.const ``CheckGoalType [u]) #[type, val] - if !(← isDefEq goalType extType) then - throwErrorAt stx "Goal{indentExpr goalType}\nis expected to match {indentExpr extType}" + let (val, type, u) ← matchCheckGoalType stx goalType let expTerm ← elabTermEnsuringType exp type if !(← Meta.withReducible <| isDefEq val expTerm) then throwErrorAt stx @@ -62,6 +65,40 @@ Implementation of `check_tactic_goal` return mkAppN (.const ``CheckGoalType.intro [u]) #[type, val] | _ => throwErrorAt stx "check_goal syntax error" +/-- +`check_tactic_goal t` verifies that the goal has is equal to +`CheckGoalType t` with reducible transparency. It closes the goal if so +and otherwise reports an error. + +It is used by #check_tactic. +-/ +local syntax (name := check_tactic_fails) "check_tactic_fails " tactic : tactic + +@[tactic check_tactic_fails] private def evalCheckTacticFails : Tactic := fun stx => do + let `(tactic| check_tactic_fails $tactic) := stx + | throwUnsupportedSyntax + closeMainGoalUsing (checkUnassigned := false) fun goalType => do + let (val, type, u) ← matchCheckGoalType stx goalType + Term.withoutErrToSorry <| withoutRecover do + match (← try (some <$> evalTactic tactic) catch _ => pure none) with + | none => + return mkAppN (.const ``CheckGoalType.intro [u]) #[type, val] + | some () => + let gls ← getGoals + let ppGoal (g : MVarId) := do + let (val, _type, _u) ← matchCheckGoalType stx (← g.getType) + pure m!"{indentExpr val}" + let msg ← + match gls with + | [] => pure m!"{tactic} expected to fail on {val}, but closed goal." + | [g] => + pure <| m!"{tactic} expected to fail on {val}, but returned: {←ppGoal g}" + | gls => + let app m g := do pure <| m ++ (←ppGoal g) + let init := m!"{tactic} expected to fail on {val}, but returned goals:" + gls.foldlM (init := init) app + throwErrorAt stx msg + /-- `#check_tactic t ~> r by commands` runs the tactic sequence `commands` on a goal with t in the type and sees if the resulting expression has @@ -71,7 +108,17 @@ macro "#check_tactic " t:term "~>" result:term "by" tac:tactic : command => `(command|example : CheckGoalType $t := by $tac; check_tactic_goal $result) /-- -`#check_simp t ~> r` checks `try simp` reduces `t` to `r`. +`#check_simp t ~> r` checks `simp` reduces `t` to `r`. -/ macro "#check_simp " t:term "~>" exp:term : command => - `(command|#check_tactic $t ~> $exp by try simp) + `(command|#check_tactic $t ~> $exp by simp) + +example (x : Nat) : CheckGoalType ((x + z) = x) := by + fail_if_success simp [] + exact (CheckGoalType.intro ((x + z) = x)) + +/-- +`#check_simp t !~>` checks `simp` fails to reduce `t`. +-/ +macro "#check_simp " t:term "!~>" : command => + `(command|example : CheckGoalType $t := by check_tactic_fails simp) diff --git a/lean-toolchain b/lean-toolchain index 1fbcac3216..63d320d43a 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-19 +leanprover/lean4:nightly-2024-02-22 diff --git a/test/array.lean b/test/array.lean index 487ac93581..b441addb70 100644 --- a/test/array.lean +++ b/test/array.lean @@ -5,15 +5,20 @@ section variable {α : Type _} variable [Inhabited α] variable (a : Array α) -variable (i : Nat) +variable (i j : Nat) variable (v d : α) variable (g : i < (a.set! i v).size) +variable (j_lt : j < (a.set! i v).size) #check_simp (a.set! i v).get ⟨i, g⟩ ~> v #check_simp (a.set! i v).get! i ~> if i < a.size then v else default #check_simp (a.set! i v).getD i d ~> if i < a.size then v else d #check_simp (a.set! i v)[i] ~> v +-- Checks with different index values. +#check_simp (a.set! i v)[j]'j_lt ~> (a.setD i v)[j]'_ +#check_simp (a.setD i v)[j]'j_lt !~> + -- This doesn't work currently. -- It will be address in the comprehensive overhaul of array lemmas. -- #check_simp (a.set! i v)[i]? ~> .some v diff --git a/test/ext.lean b/test/ext.lean index e0799efb90..3e00798a7c 100644 --- a/test/ext.lean +++ b/test/ext.lean @@ -47,7 +47,6 @@ example (f g : Nat → Nat) (h : f = g) : f = g := by exact h ▸ rfl -- allow more specific ext theorems -declare_ext_theorems_for Fin @[ext high] theorem Fin.zero_ext (a b : Fin 0) : True → a = b := by cases a.isLt example (a b : Fin 0) : a = b := by ext; exact True.intro diff --git a/test/isIndependentOf.lean b/test/isIndependentOf.lean index 59e9363ad7..7d0bff1c89 100644 --- a/test/isIndependentOf.lean +++ b/test/isIndependentOf.lean @@ -1,6 +1,7 @@ import Std.Lean.Meta.Basic import Std.Tactic.PermuteGoals import Std.Tactic.GuardMsgs +import Lean.Meta.Tactic.IndependentOf open Lean Meta Elab.Tactic diff --git a/test/norm_cast.lean b/test/norm_cast.lean index 149e568554..ea57642f1b 100644 --- a/test/norm_cast.lean +++ b/test/norm_cast.lean @@ -1,4 +1,3 @@ -import Std.Tactic.NormCast import Std.Data.Rat.Lemmas /-! diff --git a/test/register_label_attr.lean b/test/register_label_attr.lean index 2322284938..9b0e66c846 100644 --- a/test/register_label_attr.lean +++ b/test/register_label_attr.lean @@ -1,9 +1,10 @@ import Std.Test.Internal.DummyLabelAttr import Std.Tactic.GuardMsgs +import Lean.LabelAttribute set_option linter.missingDocs false -open Std.Tactic.LabelAttr +open Lean def f := 0 diff --git a/test/simpa.lean b/test/simpa.lean index 1c015b88dc..fe1b4e702d 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Arthur Paulino. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Gabriel Ebner -/ -import Std.Tactic.Simpa import Std.Tactic.ShowTerm import Std.Tactic.GuardMsgs diff --git a/test/solve_by_elim.lean b/test/solve_by_elim.lean index 545218077c..fbe6abba90 100644 --- a/test/solve_by_elim.lean +++ b/test/solve_by_elim.lean @@ -3,9 +3,11 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Std.Tactic.SolveByElim import Std.Tactic.PermuteGoals import Std.Test.Internal.DummyLabelAttr +import Lean.Meta.Tactic.Constructor +import Lean.Elab.SyntheticMVars +import Lean.Elab.Tactic.SolveByElim -- FIXME we need to make SolveByElimConfig builtin set_option autoImplicit true diff --git a/test/symm.lean b/test/symm.lean index 653630d209..33f2146617 100644 --- a/test/symm.lean +++ b/test/symm.lean @@ -1,4 +1,4 @@ -import Std.Tactic.Relation.Symm +import Init.Tactics set_option autoImplicit true set_option linter.missingDocs false From a9af8e15989e174c7193b0aa1bb8542e79f4151e Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 27 Feb 2024 12:11:36 +1100 Subject: [PATCH 096/213] , --- Std/Data/Int/DivMod.lean | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 052c242e01..a63849d980 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -49,7 +49,9 @@ theorem fdiv_eq_ediv : ∀ (a : Int) {b : Int}, 0 ≤ b → fdiv a b = a / b theorem div_eq_ediv : ∀ {a b : Int}, 0 ≤ a → 0 ≤ b → a.div b = a / b | 0, _, _, _ | _, 0, _, _ => by simp | succ _, succ _, _, _ => rfl - | _, _, _, _ => sorry -- FIXME regression on nightly-2024-02-26, shouldn't be needed + -- FIXME regression on nightly-2024-02-26, shouldn't be needed + -- Fixed in https://github.com/leanprover/lean4/pull/3504 + | _, _, _, _ => sorry theorem fdiv_eq_div {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = div a b := div_eq_ediv Ha Hb ▸ fdiv_eq_ediv _ Hb From 4b1c0cef5fb75a8de08cc7a5a87e58df2fb00aad Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 27 Feb 2024 19:15:39 +1100 Subject: [PATCH 097/213] remove sorries --- Std/Data/Int/DivMod.lean | 4 ---- Std/Data/Int/Order.lean | 1 - lean-toolchain | 2 +- 3 files changed, 1 insertion(+), 6 deletions(-) diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index a63849d980..383a6c2088 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -49,9 +49,6 @@ theorem fdiv_eq_ediv : ∀ (a : Int) {b : Int}, 0 ≤ b → fdiv a b = a / b theorem div_eq_ediv : ∀ {a b : Int}, 0 ≤ a → 0 ≤ b → a.div b = a / b | 0, _, _, _ | _, 0, _, _ => by simp | succ _, succ _, _, _ => rfl - -- FIXME regression on nightly-2024-02-26, shouldn't be needed - -- Fixed in https://github.com/leanprover/lean4/pull/3504 - | _, _, _, _ => sorry theorem fdiv_eq_div {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = div a b := div_eq_ediv Ha Hb ▸ fdiv_eq_ediv _ Hb @@ -289,7 +286,6 @@ theorem emod_two_eq (x : Int) : x % 2 = 0 ∨ x % 2 = 1 := by match x % 2, h₁, h₂ with | 0, _, _ => simp | 1, _, _ => simp - | _, _, _ => sorry -- FIXME regression on nightly-2024-02-26, shouldn't be needed theorem mod_add_div' (m k : Int) : mod m k + m.div k * k = m := by rw [Int.mul_comm]; apply mod_add_div diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 92c142c529..443ec4e28a 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -449,7 +449,6 @@ theorem sign_eq_neg_one_of_neg {a : Int} (h : a < 0) : sign a = -1 := theorem eq_zero_of_sign_eq_zero : ∀ {a : Int}, sign a = 0 → a = 0 | 0, _ => rfl - | _, _ => sorry -- regression on nightly-2024-02-26, this branch shouldn't be needed. theorem pos_of_sign_eq_one : ∀ {a : Int}, sign a = 1 → 0 < a | (_ + 1 : Nat), _ => ofNat_lt.2 (Nat.succ_pos _) diff --git a/lean-toolchain b/lean-toolchain index 6ff4890153..09c577cc33 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-26 +leanprover/lean4:nightly-2024-02-27 From c416f40e94c0a7c3757f99b6532e406911803311 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 28 Feb 2024 09:57:47 +1100 Subject: [PATCH 098/213] chore: adaptations for nightly-2024-02-27 --- Std.lean | 4 - Std/CodeAction/Attr.lean | 118 +---- Std/CodeAction/Basic.lean | 41 -- Std/CodeAction/Misc.lean | 3 +- Std/Data/BitVec/Lemmas.lean | 2 +- Std/Data/Fin/Lemmas.lean | 4 + Std/Data/MLList/Heartbeats.lean | 3 +- Std/Lean/CoreM.lean | 50 -- Std/Lean/Expr.lean | 19 - Std/Lean/Meta/Basic.lean | 17 - Std/Lean/Meta/LazyDiscrTree.lean | 881 ------------------------------- Std/Tactic/GuardMsgs.lean | 194 ------- Std/Tactic/LibrarySearch.lean | 533 ------------------- lean-toolchain | 2 +- test/MLList.lean | 1 - test/absurd.lean | 1 - test/add_suggestion.lean | 1 - test/alias.lean | 1 - test/bitvec.lean | 4 +- test/bitvec_simproc.lean | 70 +-- test/case.lean | 1 - test/coe.lean | 2 +- test/conv_equals.lean | 1 - test/ext.lean | 1 - test/guard_msgs.lean | 1 - test/instances.lean | 1 - test/isIndependentOf.lean | 1 - test/json.lean | 1 - test/kmp_matcher.lean | 1 - test/left_right.lean | 1 - test/library_search/basic.lean | 92 ++-- test/lintTC.lean | 2 +- test/lint_unreachableTactic.lean | 1 - test/lintsimp.lean | 5 +- test/lintunused.lean | 1 - test/nondet.lean | 1 - test/print_prefix.lean | 1 - test/register_label_attr.lean | 1 - test/repeat.lean | 1 - test/run_cmd.lean | 2 +- test/show_term.lean | 1 - test/simp_trace.lean | 1 - test/simpa.lean | 1 - test/tryThis.lean | 1 - test/where.lean | 1 - 45 files changed, 99 insertions(+), 1973 deletions(-) delete mode 100644 Std/Lean/CoreM.lean delete mode 100644 Std/Lean/Meta/LazyDiscrTree.lean delete mode 100644 Std/Tactic/GuardMsgs.lean delete mode 100644 Std/Tactic/LibrarySearch.lean diff --git a/Std.lean b/Std.lean index c43ddd2ea4..f4906385c5 100644 --- a/Std.lean +++ b/Std.lean @@ -37,7 +37,6 @@ import Std.Data.String import Std.Data.Sum import Std.Data.UInt import Std.Lean.AttributeExtra -import Std.Lean.CoreM import Std.Lean.Delaborator import Std.Lean.Except import Std.Lean.Expr @@ -53,7 +52,6 @@ import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.Expr import Std.Lean.Meta.Inaccessible import Std.Lean.Meta.InstantiateMVars -import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Meta.SavedState import Std.Lean.Meta.Simp import Std.Lean.Meta.UnusedNames @@ -81,10 +79,8 @@ import Std.Tactic.Classical import Std.Tactic.Congr import Std.Tactic.Exact import Std.Tactic.FalseOrByContra -import Std.Tactic.GuardMsgs import Std.Tactic.Init import Std.Tactic.Instances -import Std.Tactic.LibrarySearch import Std.Tactic.Lint import Std.Tactic.Lint.Basic import Std.Tactic.Lint.Frontend diff --git a/Std/CodeAction/Attr.lean b/Std/CodeAction/Attr.lean index 42c6742404..f748450e7d 100644 --- a/Std/CodeAction/Attr.lean +++ b/Std/CodeAction/Attr.lean @@ -8,53 +8,16 @@ import Lean.Server.CodeActions /-! # Initial setup for code action attributes -* Attribute `@[hole_code_action]` collects code actions which will be called - on each occurrence of a hole (`_`, `?_` or `sorry`). +* `@[hole_code_action]` and `@[command_code_action]` now live in the Lean repository, + and are builtin. * Attribute `@[tactic_code_action]` collects code actions which will be called on each occurrence of a tactic. - -* Attribute `@[command_code_action]` collects code actions which will be called - on each occurrence of a command. -/ namespace Std.CodeAction open Lean Elab Server Lsp RequestM Snapshots -/-- A hole code action extension. -/ -abbrev HoleCodeAction := - CodeActionParams → Snapshot → - (ctx : ContextInfo) → (hole : TermInfo) → RequestM (Array LazyCodeAction) - -/-- Read a hole code action from a declaration of the right type. -/ -def mkHoleCodeAction (n : Name) : ImportM HoleCodeAction := do - let { env, opts, .. } ← read - IO.ofExcept <| unsafe env.evalConstCheck HoleCodeAction opts ``HoleCodeAction n - -/-- An extension which collects all the hole code actions. -/ -initialize holeCodeActionExt : - PersistentEnvExtension Name (Name × HoleCodeAction) (Array Name × Array HoleCodeAction) ← - registerPersistentEnvExtension { - mkInitial := pure (#[], #[]) - addImportedFn := fun as => return (#[], ← as.foldlM (init := #[]) fun m as => - as.foldlM (init := m) fun m a => return m.push (← mkHoleCodeAction a)) - addEntryFn := fun (s₁, s₂) (n₁, n₂) => (s₁.push n₁, s₂.push n₂) - exportEntriesFn := (·.1) - } - -initialize - registerBuiltinAttribute { - name := `hole_code_action - descr := "Declare a new hole code action, to appear in the code actions on ?_ and _" - applicationTime := .afterCompilation - add := fun decl stx kind => do - Attribute.Builtin.ensureNoArgs stx - unless kind == AttributeKind.global do - throwError "invalid attribute 'hole_code_action', must be global" - if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions - modifyEnv (holeCodeActionExt.addEntry · (decl, ← mkHoleCodeAction decl)) - } - /-- A tactic code action extension. -/ abbrev TacticCodeAction := CodeActionParams → Snapshot → @@ -166,80 +129,3 @@ initialize modifyEnv (tacticCodeActionExt.addEntry · (⟨decl, args⟩, ← mkTacticCodeAction decl)) | _ => pure () } - -/-- A command code action extension. -/ -abbrev CommandCodeAction := - CodeActionParams → Snapshot → (ctx : ContextInfo) → (node : InfoTree) → - RequestM (Array LazyCodeAction) - -/-- Read a command code action from a declaration of the right type. -/ -def mkCommandCodeAction (n : Name) : ImportM CommandCodeAction := do - let { env, opts, .. } ← read - IO.ofExcept <| unsafe env.evalConstCheck CommandCodeAction opts ``CommandCodeAction n - -/-- An entry in the command code actions extension, containing the attribute arguments. -/ -structure CommandCodeActionEntry where - /-- The declaration to tag -/ - declName : Name - /-- The command kinds that this extension supports. - If empty it is called on all command kinds. -/ - cmdKinds : Array Name - deriving Inhabited - -/-- The state of the command code actions extension. -/ -structure CommandCodeActions where - /-- The list of command code actions to apply on any command. -/ - onAnyCmd : Array CommandCodeAction := {} - /-- The list of command code actions to apply when a particular command kind is highlighted. -/ - onCmd : NameMap (Array CommandCodeAction) := {} - deriving Inhabited - -/-- Insert a command code action entry into the `CommandCodeActions` structure. -/ -def CommandCodeActions.insert (self : CommandCodeActions) - (tacticKinds : Array Name) (action : CommandCodeAction) : CommandCodeActions := - if tacticKinds.isEmpty then - { self with onAnyCmd := self.onAnyCmd.push action } - else - { self with onCmd := tacticKinds.foldl (init := self.onCmd) fun m a => - m.insert a ((m.findD a #[]).push action) } - -/-- An extension which collects all the command code actions. -/ -initialize cmdCodeActionExt : - PersistentEnvExtension CommandCodeActionEntry (CommandCodeActionEntry × CommandCodeAction) - (Array CommandCodeActionEntry × CommandCodeActions) ← - registerPersistentEnvExtension { - mkInitial := pure (#[], {}) - addImportedFn := fun as => return (#[], ← as.foldlM (init := {}) fun m as => - as.foldlM (init := m) fun m ⟨name, kinds⟩ => - return m.insert kinds (← mkCommandCodeAction name)) - addEntryFn := fun (s₁, s₂) (e, n₂) => (s₁.push e, s₂.insert e.cmdKinds n₂) - exportEntriesFn := (·.1) - } - -/-- -This attribute marks a code action, which is used to suggest new tactics or replace existing ones. - -* `@[command_code_action kind]`: This is a code action which applies to applications of the command - `kind` (a command syntax kind), which can replace the command or insert things before or after it. - -* `@[command_code_action kind₁ kind₂]`: shorthand for - `@[command_code_action kind₁, command_code_action kind₂]`. - -* `@[command_code_action]`: This is a command code action that applies to all commands. - Use sparingly. --/ -syntax (name := command_code_action) "command_code_action" (ppSpace ident)* : attr - -initialize - registerBuiltinAttribute { - name := `command_code_action - descr := "Declare a new command code action, to appear in the code actions on commands" - applicationTime := .afterCompilation - add := fun decl stx kind => do - unless kind == AttributeKind.global do - throwError "invalid attribute 'command_code_action', must be global" - let `(attr| command_code_action $args*) := stx | return - let args ← args.mapM resolveGlobalConstNoOverloadWithInfo - if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions - modifyEnv (cmdCodeActionExt.addEntry · (⟨decl, args⟩, ← mkCommandCodeAction decl)) - } diff --git a/Std/CodeAction/Basic.lean b/Std/CodeAction/Basic.lean index d15e086f86..d09ed3f2c6 100644 --- a/Std/CodeAction/Basic.lean +++ b/Std/CodeAction/Basic.lean @@ -21,24 +21,6 @@ namespace Std.CodeAction open Lean Elab Term Server RequestM -/-- -A code action which calls all `@[hole_code_action]` code actions on each hole -(`?_`, `_`, or `sorry`). --/ -@[code_action_provider] def holeCodeActionProvider : CodeActionProvider := fun params snap => do - let doc ← readDoc - let startPos := doc.meta.text.lspPosToUtf8Pos params.range.start - let endPos := doc.meta.text.lspPosToUtf8Pos params.range.end - have holes := snap.infoTree.foldInfo (init := #[]) fun ctx info result => Id.run do - let .ofTermInfo info := info | result - unless [``elabHole, ``elabSyntheticHole, ``elabSorry].contains info.elaborator do - return result - let (some head, some tail) := (info.stx.getPos? true, info.stx.getTailPos? true) | result - unless head ≤ endPos && startPos ≤ tail do return result - result.push (ctx, info) - let #[(ctx, info)] := holes | return #[] - (holeCodeActionExt.getState snap.env).2.concatMapM (· params snap ctx info) - /-- The return value of `findTactic?`. This is the syntax for which code actions will be triggered. @@ -205,26 +187,3 @@ partial def findInfoTree? (kind : SyntaxNodeKind) (tgtRange : String.Range) try out := out ++ (← act params snap ctx i stk goals) catch _ => pure () | _ => unreachable! pure out - -/-- -A code action which calls all `@[command_code_action]` code actions on each command. --/ -@[code_action_provider] def cmdCodeActionProvider : CodeActionProvider := fun params snap => do - let doc ← readDoc - let startPos := doc.meta.text.lspPosToUtf8Pos params.range.start - let endPos := doc.meta.text.lspPosToUtf8Pos params.range.end - have cmds := snap.infoTree.foldInfoTree (init := #[]) fun ctx node result => Id.run do - let .node (.ofCommandInfo info) _ := node | result - let (some head, some tail) := (info.stx.getPos? true, info.stx.getTailPos? true) | result - unless head ≤ endPos && startPos ≤ tail do return result - result.push (ctx, node) - let actions := (cmdCodeActionExt.getState snap.env).2 - let mut out := #[] - for (ctx, node) in cmds do - let .node (.ofCommandInfo info) _ := node | unreachable! - if let some arr := actions.onCmd.find? info.stx.getKind then - for act in arr do - try out := out ++ (← act params snap ctx node) catch _ => pure () - for act in actions.onAnyCmd do - try out := out ++ (← act params snap ctx node) catch _ => pure () - pure out diff --git a/Std/CodeAction/Misc.lean b/Std/CodeAction/Misc.lean index 18f38ec793..e6d50ef051 100644 --- a/Std/CodeAction/Misc.lean +++ b/Std/CodeAction/Misc.lean @@ -9,6 +9,7 @@ import Std.Lean.Name import Std.Lean.Position import Std.CodeAction.Attr import Lean.Meta.Tactic.TryThis +import Lean.Server.CodeActions.Provider /-! # Miscellaneous code actions @@ -17,7 +18,7 @@ This declares some basic tactic code actions, using the `@[tactic_code_action]` -/ namespace Std.CodeAction -open Lean Meta Elab Server RequestM +open Lean Meta Elab Server RequestM CodeAction /-- Return the syntax stack leading to `target` from `root`, if one exists. -/ def findStack? (root target : Syntax) : Option Syntax.Stack := do diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index 65983b4fb0..437ab0358e 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -8,7 +8,7 @@ import Std.Data.Fin.Lemmas import Std.Data.Nat.Lemmas import Std.Util.ProofWanted -namespace Std.BitVec +namespace BitVec /-- Replaced 2024-02-07. -/ @[deprecated] alias zero_is_unique := eq_nil diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 015d8b66f9..b48858d97e 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -8,3 +8,7 @@ import Std.Data.Fin.Basic namespace Fin attribute [norm_cast] val_last + +/-! ### clamp -/ + +@[simp] theorem coe_clamp (n m : Nat) : (clamp n m : Nat) = min n m := rfl diff --git a/Std/Data/MLList/Heartbeats.lean b/Std/Data/MLList/Heartbeats.lean index a079f0db7c..02e9ebc2a9 100644 --- a/Std/Data/MLList/Heartbeats.lean +++ b/Std/Data/MLList/Heartbeats.lean @@ -4,12 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.MLList.Basic -import Std.Lean.CoreM +import Lean.Util.Heartbeats /-! # Truncate a `MLList` when running out of available heartbeats. -/ +open Lean open Lean.Core (CoreM) /-- Take an initial segment of a monadic lazy list, diff --git a/Std/Lean/CoreM.lean b/Std/Lean/CoreM.lean deleted file mode 100644 index 563debce6d..0000000000 --- a/Std/Lean/CoreM.lean +++ /dev/null @@ -1,50 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Lean.CoreM - -/-! -# Additional functions using `CoreM` state. --/ - -open Lean - -/-- -Count the number of heartbeats used during a monadic function. - -Remember that user facing heartbeats (e.g. as used in `set_option maxHeartbeats`) -differ from the internally tracked heartbeats by a factor of 1000, -so you need to divide the results here by 1000 before comparing with user facing numbers. --/ --- See also `Lean.withSeconds` -def Lean.withHeartbeats [Monad m] [MonadLiftT BaseIO m] (x : m α) : m (α × Nat) := do - let start ← IO.getNumHeartbeats - let r ← x - let finish ← IO.getNumHeartbeats - return (r, finish - start) - -/-- Return the current `maxHeartbeats`. -/ -def getMaxHeartbeats : CoreM Nat := do pure <| (← read).maxHeartbeats - -/-- Return the current `initHeartbeats`. -/ -def getInitHeartbeats : CoreM Nat := do pure <| (← read).initHeartbeats - -/-- Return the remaining heartbeats available in this computation. -/ -def getRemainingHeartbeats : CoreM Nat := do - pure <| (← getMaxHeartbeats) - ((← IO.getNumHeartbeats) - (← getInitHeartbeats)) - -/-- -Return the percentage of the max heartbeats allowed -that have been consumed so far in this computation. --/ -def heartbeatsPercent : CoreM Nat := do - pure <| ((← IO.getNumHeartbeats) - (← getInitHeartbeats)) * 100 / (← getMaxHeartbeats) - -/-- Log a message if it looks like we ran out of time. -/ -def reportOutOfHeartbeats (tac : Name) (stx : Syntax) (threshold : Nat := 90) : CoreM Unit := do - if (← heartbeatsPercent) ≥ threshold then - logInfoAt stx s!"\ - `{tac}` stopped because it was running out of time.\n\ - You may get better results using `set_option maxHeartbeats 0`." diff --git a/Std/Lean/Expr.lean b/Std/Lean/Expr.lean index 2367af3892..20338d3424 100644 --- a/Std/Lean/Expr.lean +++ b/Std/Lean/Expr.lean @@ -40,12 +40,6 @@ def lambdaArity : Expr → Nat | lam _ _ b _ => 1 + lambdaArity b | _ => 0 -/-- Like `getAppFn` but ignores metadata. -/ -def getAppFn' : Expr → Expr - | mdata _ b => getAppFn' b - | app f _ => getAppFn' f - | e => e - /-- Like `getAppNumArgs` but ignores metadata. -/ def getAppNumArgs' (e : Expr) : Nat := go e 0 @@ -104,24 +98,11 @@ def getRevArgD' : Expr → Nat → Expr → Expr | app f _ , i+1, v => getRevArgD' f i v | _ , _ , v => v -/-- Like `getRevArg!` but ignores metadata. -/ -@[inline] -def getRevArg!' : Expr → Nat → Expr - | mdata _ b, n => getRevArg!' b n - | app _ a , 0 => a - | app f _ , i+1 => getRevArg!' f i - | _ , _ => panic! "invalid index" - /-- Like `getArgD` but ignores metadata. -/ @[inline] def getArgD' (e : Expr) (i : Nat) (v₀ : Expr) (n := e.getAppNumArgs') : Expr := getRevArgD' e (n - i - 1) v₀ -/-- Like `getArg!` but ignores metadata. -/ -@[inline] -def getArg!' (e : Expr) (i : Nat) (n := e.getAppNumArgs') : Expr := - getRevArg!' e (n - i - 1) - /-- Like `isAppOf` but ignores metadata. -/ def isAppOf' (e : Expr) (n : Name) : Bool := match e.getAppFn' with diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index cb9a4bc166..3e72809893 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -162,20 +162,3 @@ where match ← tac goal with | none => acc.modify fun s => s.push goal | some goals => goals.forM (go acc) - -/-- -Given a monadic function `F` that takes a type and a term of that type and produces a new term, -lifts this to the monadic function that opens a `∀` telescope, applies `F` to the body, -and then builds the lambda telescope term for the new term. --/ -def mapForallTelescope' (F : Expr → Expr → MetaM Expr) (forallTerm : Expr) : MetaM Expr := do - forallTelescope (← Meta.inferType forallTerm) fun xs ty => do - Meta.mkLambdaFVars xs (← F ty (mkAppN forallTerm xs)) - -/-- -Given a monadic function `F` that takes a term and produces a new term, -lifts this to the monadic function that opens a `∀` telescope, applies `F` to the body, -and then builds the lambda telescope term for the new term. --/ -def mapForallTelescope (F : Expr → MetaM Expr) (forallTerm : Expr) : MetaM Expr := do - mapForallTelescope' (fun _ e => F e) forallTerm diff --git a/Std/Lean/Meta/LazyDiscrTree.lean b/Std/Lean/Meta/LazyDiscrTree.lean deleted file mode 100644 index 75818cd497..0000000000 --- a/Std/Lean/Meta/LazyDiscrTree.lean +++ /dev/null @@ -1,881 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix, Scott Morrison --/ - -import Lean.Meta.DiscrTree -import Std.Lean.Name - -/-! -# Lazy Discrimination Tree - -This file defines a new type of discrimination tree optimized for -rapidly population of imported modules for use in tactics. It uses a -lazy initialization strategy. - -The discrimination tree can be created through -`createImportedEnvironment`. This creates a discrimination tree from all -imported modules in an environment using a callback that provides the -entries as `InitEntry` values. - -The function `getMatch` can be used to get the values that match the -expression as well as an updated lazy discrimination tree that has -elaborated additional parts of the tree. --/ -namespace Lean.Meta.LazyDiscrTree - --- This namespace contains definitions copied from Lean.Meta.DiscrTree. -namespace MatchClone - -/-- -Discrimination tree key. --/ -private inductive Key where - /-- Constant -/ - | const : Name → Nat → Key - | fvar : FVarId → Nat → Key - | lit : Literal → Key - | star : Key - | other : Key - | arrow : Key - | proj : Name → Nat → Nat → Key - deriving Inhabited, BEq, Repr - -namespace Key - -/-- Hash function -/ -protected def hash : Key → UInt64 - | .const n a => mixHash 5237 $ mixHash n.hash (hash a) - | .fvar n a => mixHash 3541 $ mixHash (hash n) (hash a) - | .lit v => mixHash 1879 $ hash v - | .star => 7883 - | .other => 2411 - | .arrow => 17 - | .proj s i a => mixHash (hash a) $ mixHash (hash s) (hash i) - -instance : Hashable Key := ⟨Key.hash⟩ - -end Key - -private def tmpMVarId : MVarId := { name := `_discr_tree_tmp } -private def tmpStar := mkMVar tmpMVarId - -/-- - Return true iff the argument should be treated as a "wildcard" by the discrimination tree. - - - We ignore proofs because of proof irrelevance. It doesn't make sense to try to - index their structure. - - - We ignore instance implicit arguments (e.g., `[Add α]`) because they are "morally" canonical. - Moreover, we may have many definitionally equal terms floating around. - Example: `Ring.hasAdd Int Int.isRing` and `Int.hasAdd`. - - - We considered ignoring implicit arguments (e.g., `{α : Type}`) since users don't "see" them, - and may not even understand why some simplification rule is not firing. - However, in type class resolution, we have instance such as `Decidable (@Eq Nat x y)`, - where `Nat` is an implicit argument. Thus, we would add the path - ``` - Decidable -> Eq -> * -> * -> * -> [Nat.decEq] - ``` - to the discrimination tree IF we ignored the implicit `Nat` argument. - This would be BAD since **ALL** decidable equality instances would be in the same path. - So, we index implicit arguments if they are types. - This setting seems sensible for simplification theorems such as: - ``` - forall (x y : Unit), (@Eq Unit x y) = true - ``` - If we ignore the implicit argument `Unit`, the `DiscrTree` will say it is a candidate - simplification theorem for any equality in our goal. - - Remark: if users have problems with the solution above, we may provide a `noIndexing` annotation, - and `ignoreArg` would return true for any term of the form `noIndexing t`. --/ -private def ignoreArg (a : Expr) (i : Nat) (infos : Array ParamInfo) : MetaM Bool := do - if h : i < infos.size then - let info := infos.get ⟨i, h⟩ - if info.isInstImplicit then - return true - else if info.isImplicit || info.isStrictImplicit then - return not (← isType a) - else - isProof a - else - isProof a - -private partial def pushArgsAux (infos : Array ParamInfo) : Nat → Expr → Array Expr → - MetaM (Array Expr) - | i, .app f a, todo => do - if (← ignoreArg a i infos) then - pushArgsAux infos (i-1) f (todo.push tmpStar) - else - pushArgsAux infos (i-1) f (todo.push a) - | _, _, todo => return todo - -/-- - Return true if `e` is one of the following - - A nat literal (numeral) - - `Nat.zero` - - `Nat.succ x` where `isNumeral x` - - `OfNat.ofNat _ x _` where `isNumeral x` -/ -private partial def isNumeral (e : Expr) : Bool := - if e.isNatLit then true - else - let f := e.getAppFn - if !f.isConst then false - else - let fName := f.constName! - if fName == ``Nat.succ && e.getAppNumArgs == 1 then isNumeral e.appArg! - else if fName == ``OfNat.ofNat && e.getAppNumArgs == 3 then isNumeral (e.getArg! 1) - else if fName == ``Nat.zero && e.getAppNumArgs == 0 then true - else false - -private partial def toNatLit? (e : Expr) : Option Literal := - if isNumeral e then - if let some n := loop e then - some (.natVal n) - else - none - else - none -where - loop (e : Expr) : OptionT Id Nat := do - let f := e.getAppFn - match f with - | .lit (.natVal n) => return n - | .const fName .. => - if fName == ``Nat.succ && e.getAppNumArgs == 1 then - let r ← loop e.appArg! - return r+1 - else if fName == ``OfNat.ofNat && e.getAppNumArgs == 3 then - loop (e.getArg! 1) - else if fName == ``Nat.zero && e.getAppNumArgs == 0 then - return 0 - else - failure - | _ => failure - -private def isNatType (e : Expr) : MetaM Bool := - return (← whnf e).isConstOf ``Nat - -/-- - Return true if `e` is one of the following - - `Nat.add _ k` where `isNumeral k` - - `Add.add Nat _ _ k` where `isNumeral k` - - `HAdd.hAdd _ Nat _ _ k` where `isNumeral k` - - `Nat.succ _` - This function assumes `e.isAppOf fName` --/ -private def isOffset (fName : Name) (e : Expr) : MetaM Bool := do - if fName == ``Nat.add && e.getAppNumArgs == 2 then - return isNumeral e.appArg! - else if fName == ``Add.add && e.getAppNumArgs == 4 then - if (← isNatType (e.getArg! 0)) then return isNumeral e.appArg! else return false - else if fName == ``HAdd.hAdd && e.getAppNumArgs == 6 then - if (← isNatType (e.getArg! 1)) then return isNumeral e.appArg! else return false - else - return fName == ``Nat.succ && e.getAppNumArgs == 1 - -/-- - TODO: add hook for users adding their own functions for controlling `shouldAddAsStar` - Different `DiscrTree` users may populate this set using, for example, attributes. - - Remark: we currently tag "offset" terms as star to avoid having to add special - support for offset terms. - Example, suppose the discrimination tree contains the entry - `Nat.succ ?m |-> v`, and we are trying to retrieve the matches for - `Expr.lit (Literal.natVal 1) _`. - In this scenario, we want to retrieve `Nat.succ ?m |-> v` --/ -private def shouldAddAsStar (fName : Name) (e : Expr) : MetaM Bool := do - isOffset fName e - -/-- - Try to eliminate loose bound variables by performing beta-reduction. - We use this method when processing terms in discrimination trees. - These trees distinguish dependent arrows from nondependent ones. - Recall that dependent arrows are indexed as `.other`, but nondependent arrows as `.arrow ..`. - Motivation: we want to "discriminate" implications and simple arrows in our index. - - Now suppose we add the term `Foo (Nat → Nat)` to our index. The nested arrow appears as - `.arrow ..`. Then, suppose we want to check whether the index contains - `(x : Nat) → (fun _ => Nat) x`, but it will fail to retrieve `Foo (Nat → Nat)` because - it assumes the nested arrow is a dependent one and uses `.other`. - - We use this method to address this issue by beta-reducing terms containing loose bound variables. - See issue #2232. - - Remark: we expect the performance impact will be minimal. --/ -private def elimLooseBVarsByBeta (e : Expr) : CoreM Expr := - Core.transform e - (pre := fun e => do - if !e.hasLooseBVars then - return .done e - else if e.isHeadBetaTarget then - return .visit e.headBeta - else - return .continue) - -private def getKeyArgs (e : Expr) (isMatch root : Bool) (config : WhnfCoreConfig) : - MetaM (Key × Array Expr) := do - let e ← DiscrTree.reduceDT e root config - unless root do - -- See pushArgs - if let some v := toNatLit? e then - return (.lit v, #[]) - match e.getAppFn with - | .lit v => return (.lit v, #[]) - | .const c _ => - if (← getConfig).isDefEqStuckEx && e.hasExprMVar then - if (← isReducible c) then - /- `e` is a term `c ...` s.t. `c` is reducible and `e` has metavariables, but it was not - unfolded. This can happen if the metavariables in `e` are "blocking" smart unfolding. - If `isDefEqStuckEx` is enabled, then we must throw the `isDefEqStuck` exception to - postpone TC resolution. - Here is an example. Suppose we have - ``` - inductive Ty where - | bool | fn (a ty : Ty) - - - @[reducible] def Ty.interp : Ty → Type - | bool => Bool - | fn a b => a.interp → b.interp - ``` - and we are trying to synthesize `BEq (Ty.interp ?m)` - -/ - Meta.throwIsDefEqStuck - else if let some matcherInfo := isMatcherAppCore? (← getEnv) e then - -- A matcher application is stuck if one of the discriminants has a metavariable - let args := e.getAppArgs - let start := matcherInfo.getFirstDiscrPos - for arg in args[ start : start + matcherInfo.numDiscrs ] do - if arg.hasExprMVar then - Meta.throwIsDefEqStuck - else if (← isRec c) then - /- Similar to the previous case, but for `match` and recursor applications. It may be stuck - (i.e., did not reduce) because of metavariables. -/ - Meta.throwIsDefEqStuck - let nargs := e.getAppNumArgs - return (.const c nargs, e.getAppRevArgs) - | .fvar fvarId => - let nargs := e.getAppNumArgs - return (.fvar fvarId nargs, e.getAppRevArgs) - | .mvar mvarId => - if isMatch then - return (.other, #[]) - else do - let ctx ← read - if ctx.config.isDefEqStuckEx then - /- - When the configuration flag `isDefEqStuckEx` is set to true, - we want `isDefEq` to throw an exception whenever it tries to assign - a read-only metavariable. - This feature is useful for type class resolution where - we may want to notify the caller that the TC problem may be solvable - later after it assigns `?m`. - The method `DiscrTree.getUnify e` returns candidates `c` that may "unify" with `e`. - That is, `isDefEq c e` may return true. Now, consider `DiscrTree.getUnify d (Add ?m)` - where `?m` is a read-only metavariable, and the discrimination tree contains the keys - `HadAdd Nat` and `Add Int`. If `isDefEqStuckEx` is set to true, we must treat `?m` as - a regular metavariable here, otherwise we return the empty set of candidates. - This is incorrect because it is equivalent to saying that there is no solution even if - the caller assigns `?m` and try again. -/ - return (.star, #[]) - else if (← mvarId.isReadOnlyOrSyntheticOpaque) then - return (.other, #[]) - else - return (.star, #[]) - | .proj s i a .. => - let nargs := e.getAppNumArgs - return (.proj s i nargs, #[a] ++ e.getAppRevArgs) - | .forallE _ d b _ => - -- See comment at elimLooseBVarsByBeta - let b ← if b.hasLooseBVars then elimLooseBVarsByBeta b else pure b - if b.hasLooseBVars then - return (.other, #[]) - else - return (.arrow, #[d, b]) - | .bvar _ | .letE _ _ _ _ _ | .lam _ _ _ _ | .mdata _ _ | .app _ _ | .sort _ => - return (.other, #[]) - -/- -Given an expression we are looking for patterns that match, return the key and sub-expressions. --/ -private abbrev getMatchKeyArgs (e : Expr) (root : Bool) (config : WhnfCoreConfig) : - MetaM (Key × Array Expr) := - getKeyArgs e (isMatch := true) (root := root) (config := config) - -end MatchClone - -export MatchClone (Key Key.const) - -/-- -An unprocessed entry in the lazy discrimination tree. --/ -private abbrev LazyEntry α := Array Expr × ((LocalContext × LocalInstances) × α) - -/-- -Index identifying trie in a discrimination tree. --/ -@[reducible] -private def TrieIndex := Nat - -/-- -Discrimination tree trie. See `LazyDiscrTree`. --/ -private structure Trie (α : Type) where - node :: - /-- Values for matches ending at this trie. -/ - values : Array α - /-- Index of trie matching star. -/ - star : TrieIndex - /-- Following matches based on key of trie. -/ - children : HashMap Key TrieIndex - /-- Lazy entries at this trie that are not processed. -/ - pending : Array (LazyEntry α) - deriving Inhabited - -instance : EmptyCollection (Trie α) := ⟨.node #[] 0 {} #[]⟩ - -/-- Push lazy entry to trie. -/ -private def Trie.pushPending : Trie α → LazyEntry α → Trie α -| .node vs star cs p, e => .node vs star cs (p.push e) - -end LazyDiscrTree - -/-- -`LazyDiscrTree` is a variant of the discriminator tree datatype -`DiscrTree` in Lean core that is designed to be efficiently -initializable with a large number of patterns. This is useful -in contexts such as searching an entire Lean environment for -expressions that match a pattern. - -Lazy discriminator trees achieve good performance by minimizing -the amount of work that is done up front to build the discriminator -tree. When first adding patterns to the tree, only the root -discriminator key is computed and processing the remaining -terms is deferred until demanded by a match. --/ -structure LazyDiscrTree (α : Type) where - /-- Configuration for normalization. -/ - config : Lean.Meta.WhnfCoreConfig := {} - /-- Backing array of trie entries. Should be owned by this trie. -/ - tries : Array (LazyDiscrTree.Trie α) := #[default] - /-- Map from discriminator trie roots to the index. -/ - roots : Lean.HashMap LazyDiscrTree.Key LazyDiscrTree.TrieIndex := {} - -namespace LazyDiscrTree - -open Lean Elab Meta - -instance : Inhabited (LazyDiscrTree α) where - default := {} - -open Lean.Meta.DiscrTree (mkNoindexAnnotation hasNoindexAnnotation reduceDT) - -/-- -Specialization of Lean.Meta.DiscrTree.pushArgs --/ -private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) (config : WhnfCoreConfig) : - MetaM (Key × Array Expr) := do - if hasNoindexAnnotation e then - return (.star, todo) - else - let e ← reduceDT e root config - let fn := e.getAppFn - let push (k : Key) (nargs : Nat) (todo : Array Expr) : MetaM (Key × Array Expr) := do - let info ← getFunInfoNArgs fn nargs - let todo ← MatchClone.pushArgsAux info.paramInfo (nargs-1) e todo - return (k, todo) - match fn with - | .lit v => - return (.lit v, todo) - | .const c _ => - unless root do - if let some v := MatchClone.toNatLit? e then - return (.lit v, todo) - if (← MatchClone.shouldAddAsStar c e) then - return (.star, todo) - let nargs := e.getAppNumArgs - push (.const c nargs) nargs todo - | .proj s i a => - /- - If `s` is a class, then `a` is an instance. Thus, we annotate `a` with `no_index` since we do - not index instances. This should only happen if users mark a class projection function as - `[reducible]`. - - TODO: add better support for projections that are functions - -/ - let a := if isClass (← getEnv) s then mkNoindexAnnotation a else a - let nargs := e.getAppNumArgs - push (.proj s i nargs) nargs (todo.push a) - | .fvar _fvarId => --- let bi ← fvarId.getBinderInfo --- if bi.isInstImplicit then --- return (.other, todo) --- else - return (.star, todo) - | .mvar mvarId => - if mvarId == MatchClone.tmpMVarId then - -- We use `tmp to mark implicit arguments and proofs - return (.star, todo) - else - failure - | .forallE _ d b _ => - -- See comment at elimLooseBVarsByBeta - let b ← if b.hasLooseBVars then MatchClone.elimLooseBVarsByBeta b else pure b - if b.hasLooseBVars then - return (.other, todo) - else - return (.arrow, (todo.push d).push b) - | _ => - return (.other, todo) - -/-- Initial capacity for key and todo vector. -/ -private def initCapacity := 8 - -/-- -Get the root key and rest of terms of an expression using the specified config. --/ -private def rootKey (cfg: WhnfCoreConfig) (e : Expr) : MetaM (Key × Array Expr) := - pushArgs true (Array.mkEmpty initCapacity) e cfg - -private partial def mkPathAux (root : Bool) (todo : Array Expr) (keys : Array Key) - (config : WhnfCoreConfig) : MetaM (Array Key) := do - if todo.isEmpty then - return keys - else - let e := todo.back - let todo := todo.pop - let (k, todo) ← pushArgs root todo e config - mkPathAux false todo (keys.push k) config - -/-- -Create a path from an expression. - -This differs from Lean.Meta.DiscrTree.mkPath in that the expression -should uses free variables rather than meta-variables for holes. --/ -private def mkPath (e : Expr) (config : WhnfCoreConfig) : MetaM (Array Key) := do - let todo : Array Expr := .mkEmpty initCapacity - let keys : Array Key := .mkEmpty initCapacity - mkPathAux (root := true) (todo.push e) keys config - -/- Monad for finding matches while resolving deferred patterns. -/ -@[reducible] -private def MatchM α := ReaderT WhnfCoreConfig (StateRefT (Array (Trie α)) MetaM) - -private def runMatch (d : LazyDiscrTree α) (m : MatchM α β) : MetaM (β × LazyDiscrTree α) := do - let { config := c, tries := a, roots := r } := d - let (result, a) ← withReducible $ (m.run c).run a - pure (result, { config := c, tries := a, roots := r}) - -private def setTrie (i : TrieIndex) (v : Trie α) : MatchM α Unit := - modify (·.set! i v) - -/-- Create a new trie with the given lazy entry. -/ -private def newTrie [Monad m] [MonadState (Array (Trie α)) m] (e : LazyEntry α) : m TrieIndex := do - modifyGet fun a => let sz := a.size; (sz, a.push (.node #[] 0 {} #[e])) - -/-- Add a lazy entry to an existing trie. -/ -private def addLazyEntryToTrie (i:TrieIndex) (e : LazyEntry α) : MatchM α Unit := - modify (·.modify i (·.pushPending e)) - -/-- -This evaluates all lazy entries in a trie and updates `values`, `starIdx`, and `children` -accordingly. --/ -private partial def evalLazyEntries (config : WhnfCoreConfig) - (values : Array α) (starIdx : TrieIndex) (children : HashMap Key TrieIndex) - (entries : Array (LazyEntry α)) : - MatchM α (Array α × TrieIndex × HashMap Key TrieIndex) := do - let rec iter values starIdx children (i : Nat) : MatchM α _ := do - if p : i < entries.size then - let (todo, lctx, v) := entries[i] - if todo.isEmpty then - let values := values.push v - iter values starIdx children (i+1) - else - let e := todo.back - let todo := todo.pop - let (k, todo) ← withLCtx lctx.1 lctx.2 $ pushArgs false todo e config - if k == .star then - if starIdx = 0 then - let starIdx ← newTrie (todo, lctx, v) - iter values starIdx children (i+1) - else - addLazyEntryToTrie starIdx (todo, lctx, v) - iter values starIdx children (i+1) - else - match children.find? k with - | none => - let children := children.insert k (← newTrie (todo, lctx, v)) - iter values starIdx children (i+1) - | some idx => - addLazyEntryToTrie idx (todo, lctx, v) - iter values starIdx children (i+1) - else - pure (values, starIdx, children) - iter values starIdx children 0 - -private def evalNode (c : TrieIndex) : - MatchM α (Array α × TrieIndex × HashMap Key TrieIndex) := do - let .node vs star cs pending := (←get).get! c - if pending.size = 0 then - pure (vs, star, cs) - else - let config ← read - setTrie c default - let (vs, star, cs) ← evalLazyEntries config vs star cs pending - setTrie c <| .node vs star cs #[] - pure (vs, star, cs) - -/-- -Return the information about the trie at the given idnex. - -Used for internal debugging purposes. --/ -private def getTrie (d : LazyDiscrTree α) (idx : TrieIndex) : - MetaM ((Array α × TrieIndex × HashMap Key TrieIndex) × LazyDiscrTree α) := - runMatch d (evalNode idx) - -/-- -A match result repres --/ -private structure MatchResult (α : Type) where - elts : Array (Array (Array α)) := #[] - -private def MatchResult.push (r : MatchResult α) (score : Nat) (e : Array α) : MatchResult α := - if e.isEmpty then - r - else if score < r.elts.size then - { elts := r.elts.modify score (·.push e) } - else - let rec loop (a : Array (Array (Array α))) := - if a.size < score then - loop (a.push #[]) - else - { elts := a.push #[e] } - termination_by score - a.size - loop r.elts - -private partial def MatchResult.toArray (mr : MatchResult α) : Array α := - loop (Array.mkEmpty n) mr.elts - where n := mr.elts.foldl (fun i a => a.foldl (fun n a => n + a.size) i) 0 - loop (r : Array α) (a : Array (Array (Array α))) := - if a.isEmpty then - r - else - loop (a.back.foldl (init := r) (fun r a => r ++ a)) a.pop - -private partial def getMatchLoop (todo : Array Expr) (score : Nat) (c : TrieIndex) - (result : MatchResult α) : MatchM α (MatchResult α) := do - let (vs, star, cs) ← evalNode c - if todo.isEmpty then - return result.push score vs - else if star == 0 && cs.isEmpty then - return result - else - let e := todo.back - let todo := todo.pop - /- We must always visit `Key.star` edges since they are wildcards. - Thus, `todo` is not used linearly when there is `Key.star` edge - and there is an edge for `k` and `k != Key.star`. -/ - let visitStar (result : MatchResult α) : MatchM α (MatchResult α) := - if star != 0 then - getMatchLoop todo score star result - else - return result - let visitNonStar (k : Key) (args : Array Expr) (result : MatchResult α) := - match cs.find? k with - | none => return result - | some c => getMatchLoop (todo ++ args) (score + 1) c result - let result ← visitStar result - let (k, args) ← MatchClone.getMatchKeyArgs e (root := false) (←read) - match k with - | .star => return result - /- - Note: dep-arrow vs arrow - Recall that dependent arrows are `(Key.other, #[])`, and non-dependent arrows are - `(Key.arrow, #[a, b])`. - A non-dependent arrow may be an instance of a dependent arrow (stored at `DiscrTree`). - Thus, we also visit the `Key.other` child. - -/ - | .arrow => visitNonStar .other #[] (← visitNonStar k args result) - | _ => visitNonStar k args result - -private def getStarResult (root : Lean.HashMap Key TrieIndex) : MatchM α (MatchResult α) := - match root.find? .star with - | none => - pure <| {} - | some idx => do - let (vs, _) ← evalNode idx - pure <| ({} : MatchResult α).push 0 vs - -private def getMatchRoot (r : Lean.HashMap Key TrieIndex) (k : Key) (args : Array Expr) - (result : MatchResult α) : MatchM α (MatchResult α) := - match r.find? k with - | none => pure result - | some c => getMatchLoop args 1 c result - -/-- - Find values that match `e` in `root`. --/ -private def getMatchCore (root : Lean.HashMap Key TrieIndex) (e : Expr) : - MatchM α (MatchResult α) := do - let result ← getStarResult root - let (k, args) ← MatchClone.getMatchKeyArgs e (root := true) (←read) - match k with - | .star => return result - /- See note about "dep-arrow vs arrow" at `getMatchLoop` -/ - | .arrow => - getMatchRoot root k args (←getMatchRoot root .other #[] result) - | _ => - getMatchRoot root k args result - -/-- - Find values that match `e` in `d`. - - The results are ordered so that the longest matches in terms of number of - non-star keys are first with ties going to earlier operators first. --/ -def getMatch (d : LazyDiscrTree α) (e : Expr) : MetaM (Array α × LazyDiscrTree α) := - withReducible <| runMatch d <| (·.toArray) <$> getMatchCore d.roots e - -/-- -Structure for quickly initializing a lazy discrimination tree with a large number -of elements using concurrent functions for generating entries. --/ -private structure PreDiscrTree (α : Type) where - /-- Maps keys to index in tries array. -/ - roots : HashMap Key Nat := {} - /-- Lazy entries for root of trie. -/ - tries : Array (Array (LazyEntry α)) := #[] - deriving Inhabited - -namespace PreDiscrTree - -private def modifyAt (d : PreDiscrTree α) (k : Key) - (f : Array (LazyEntry α) → Array (LazyEntry α)) : PreDiscrTree α := - let { roots, tries } := d - match roots.find? k with - | .none => - let roots := roots.insert k tries.size - { roots, tries := tries.push (f #[]) } - | .some i => - { roots, tries := tries.modify i f } - -/-- Add an entry to the pre-discrimination tree.-/ -private def push (d : PreDiscrTree α) (k : Key) (e : LazyEntry α) : PreDiscrTree α := - d.modifyAt k (·.push e) - -/-- Convert a pre-discrimination tree to a lazy discrimination tree. -/ -private def toLazy (d : PreDiscrTree α) (config : WhnfCoreConfig := {}) : LazyDiscrTree α := - let { roots, tries } := d - { config, roots, tries := tries.map (.node {} 0 {}) } - -/-- Merge two discrimination trees. -/ -protected def append (x y : PreDiscrTree α) : PreDiscrTree α := - let (x, y, f) := - if x.roots.size ≥ y.roots.size then - (x, y, fun y x => x ++ y) - else - (y, x, fun x y => x ++ y) - let { roots := yk, tries := ya } := y - yk.fold (init := x) fun d k yi => d.modifyAt k (f ya[yi]!) - -instance : Append (PreDiscrTree α) where - append := PreDiscrTree.append - -end PreDiscrTree - -/-- Initial entry in lazy discrimination tree -/ -@[reducible] -structure InitEntry (α : Type) where - /-- Return root key for an entry. -/ - key : Key - /-- Returns rest of entry for later insertion. -/ - entry : LazyEntry α - -namespace InitEntry - -/-- -Constructs an initial entry from an expression and value. --/ -def fromExpr (expr : Expr) (value : α) (config : WhnfCoreConfig := {}) : MetaM (InitEntry α) := do - let lctx ← getLCtx - let linst ← getLocalInstances - let lctx := (lctx, linst) - let (key, todo) ← LazyDiscrTree.rootKey config expr - pure <| { key, entry := (todo, lctx, value) } - -/-- -Creates an entry for a subterm of an initial entry. - -This is slightly more efficient than using `fromExpr` on subterms since it avoids a redundant call -to `whnf`. --/ -def mkSubEntry (e : InitEntry α) (idx : Nat) (value : α) (config : WhnfCoreConfig := {}) : - MetaM (InitEntry α) := do - let (todo, lctx, _) := e.entry - let (key, todo) ← LazyDiscrTree.rootKey config todo[idx]! - pure <| { key, entry := (todo, lctx, value) } - -end InitEntry - -/-- Information about a failed import. -/ -private structure ImportFailure where - /-- Module with constant that import failed on. -/ - module : Name - /-- Constant that import failed on. -/ - const : Name - /-- Exception that triggers error. -/ - exception : Exception - -/-- Information generation from imported modules. -/ -private structure ImportData where - cache : IO.Ref (Lean.Meta.Cache) - errors : IO.Ref (Array ImportFailure) - -private def ImportData.new : BaseIO ImportData := do - let cache ← IO.mkRef {} - let errors ← IO.mkRef #[] - pure { cache, errors } - -/-- -An even wider class of "internal" names than reported by `Name.isInternalDetail`. --/ --- from Lean.Server.Completion -def isBlackListed (env : Environment) (declName : Name) : Bool := - declName == ``sorryAx - || declName.isInternalDetail - || declName matches .str _ "inj" - || declName matches .str _ "noConfusionType" - || isAuxRecursor env declName - || isNoConfusion env declName - || isRecCore env declName - || isMatcherCore env declName - -private def addConstImportData - (env : Environment) - (modName : Name) - (d : ImportData) - (tree : PreDiscrTree α) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (name : Name) (constInfo : ConstantInfo) : BaseIO (PreDiscrTree α) := do - if constInfo.isUnsafe then return tree - if isBlackListed env name then return tree - let mstate : Meta.State := { cache := ←d.cache.get } - d.cache.set {} - let ctx : Meta.Context := { config := { transparency := .reducible } } - let cm := (act name constInfo).run ctx mstate - let cctx : Core.Context := { - fileName := default, - fileMap := default - } - let cstate : Core.State := {env} - match ←(cm.run cctx cstate).toBaseIO with - | .ok ((a, ms), _) => - d.cache.set ms.cache - pure <| a.foldl (fun t e => t.push e.key e.entry) tree - | .error e => - let i : ImportFailure := { - module := modName, - const := name, - exception := e - } - d.errors.modify (·.push i) - pure tree - -/-- -Contains the pre discrimination tree and any errors occuring during initialization of -the library search tree. --/ -private structure InitResults (α : Type) where - tree : PreDiscrTree α := {} - errors : Array ImportFailure := #[] - -instance : Inhabited (InitResults α) where - default := {} - -namespace InitResults - -/-- Combine two initial results. -/ -protected def append (x y : InitResults α) : InitResults α := - let { tree := xv, errors := xe } := x - let { tree := yv, errors := ye } := y - { tree := xv ++ yv, errors := xe ++ ye } - -instance : Append (InitResults α) where - append := InitResults.append - -end InitResults - -private def toFlat (d : ImportData) (tree : PreDiscrTree α) : - BaseIO (InitResults α) := do - let de ← d.errors.swap #[] - pure ⟨tree, de⟩ - -private partial def loadImportedModule (env : Environment) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (d : ImportData) - (tree : PreDiscrTree α) - (mname : Name) - (mdata : ModuleData) - (i : Nat := 0) : BaseIO (PreDiscrTree α) := do - if h : i < mdata.constNames.size then - let name := mdata.constNames[i] - let constInfo := mdata.constants[i]! - let tree ← addConstImportData env mname d tree act name constInfo - loadImportedModule env act d tree mname mdata (i+1) - else - pure tree - -private def createImportedEnvironmentSeq (env : Environment) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (start stop : Nat) : BaseIO (InitResults α) := - do go (← ImportData.new) {} start stop - where go d (tree : PreDiscrTree α) (start stop : Nat) : BaseIO _ := do - if start < stop then - let mname := env.header.moduleNames[start]! - let mdata := env.header.moduleData[start]! - let tree ← loadImportedModule env act d tree mname mdata - go d tree (start+1) stop - else - toFlat d tree - termination_by stop - start - -/-- Get the results of each task and merge using combining function -/ -private def combineGet [Append α] (z : α) (tasks : Array (Task α)) : α := - tasks.foldl (fun x t => x ++ t.get) (init := z) - -/-- Create an imported environment for tree. -/ -def createImportedEnvironment (env : Environment) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (constantsPerTask : Nat := 1000) : - EIO Exception (LazyDiscrTree α) := do - let n := env.header.moduleData.size - let rec - /-- Allocate constants to tasks according to `constantsPerTask`. -/ - go tasks start cnt idx := do - if h : idx < env.header.moduleData.size then - let mdata := env.header.moduleData[idx] - let cnt := cnt + mdata.constants.size - if cnt > constantsPerTask then - let t ← createImportedEnvironmentSeq env act start (idx+1) |>.asTask - go (tasks.push t) (idx+1) 0 (idx+1) - else - go tasks start cnt (idx+1) - else - if start < n then - tasks.push <$> (createImportedEnvironmentSeq env act start n).asTask - else - pure tasks - termination_by env.header.moduleData.size - idx - let tasks ← go #[] 0 0 0 - let r := combineGet default tasks - if p : r.errors.size > 0 then - throw r.errors[0].exception - pure <| r.tree.toLazy diff --git a/Std/Tactic/GuardMsgs.lean b/Std/Tactic/GuardMsgs.lean deleted file mode 100644 index f0f3ab7568..0000000000 --- a/Std/Tactic/GuardMsgs.lean +++ /dev/null @@ -1,194 +0,0 @@ -/- -Copyright (c) 2023 Kyle Miller. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kyle Miller --/ -import Std.CodeAction.Attr -import Std.Lean.Position - -/-! `#guard_msgs` command for testing commands - -This module defines a command to test that another command produces the expected messages. -See the docstring on the `#guard_msgs` command. --/ - -open Lean Parser.Tactic Elab Command - -namespace Std.Tactic.GuardMsgs - -/-- Element that can be part of a `#guard_msgs` specification. -/ -syntax guardMsgsSpecElt := &"drop"? (&"info" <|> &"warning" <|> &"error" <|> &"all") - -/-- Specification for `#guard_msgs` command. -/ -syntax guardMsgsSpec := "(" guardMsgsSpecElt,* ")" - -/-- -`#guard_msgs` captures the messages generated by another command and checks that they -match the contents of the docstring attached to the `#guard_msgs` command. - -Basic example: -```lean -/-- -error: unknown identifier 'x' --/ -#guard_msgs in -example : α := x -``` -This checks that there is such an error and then consumes the message entirely. - -By default, the command intercepts all messages, but there is a way to specify which types -of messages to consider. For example, we can select only warnings: -```lean -/-- -warning: declaration uses 'sorry' --/ -#guard_msgs(warning) in -example : α := sorry -``` -or only errors -```lean -#guard_msgs(error) in -example : α := sorry -``` -In this last example, since the message is not intercepted there is a warning on `sorry`. -We can drop the warning completely with -```lean -#guard_msgs(error, drop warning) in -example : α := sorry -``` - -Syntax description: -``` -#guard_msgs (drop? info|warning|error|all,*)? in cmd -``` - -If there is no specification, `#guard_msgs` intercepts all messages. -Otherwise, if there is one, the specification is considered in left-to-right order, and the first -that applies chooses the outcome of the message: -- `info`, `warning`, `error`: intercept a message with the given severity level. -- `all`: intercept any message (so `#guard_msgs in cmd` and `#guard_msgs (all) in cmd` - are equivalent). -- `drop info`, `drop warning`, `drop error`: intercept a message with the given severity - level and then drop it. These messages are not checked. -- `drop all`: intercept a message and drop it. - -For example, `#guard_msgs (error, drop all) in cmd` means to check warnings and then drop -everything else. --/ -syntax (name := guardMsgsCmd) - (docComment)? "#guard_msgs" (ppSpace guardMsgsSpec)? " in" ppLine command : command - -/-- Gives a string representation of a message without source position information. -Ensures the message ends with a '\n'. -/ -private def messageToStringWithoutPos (msg : Message) : IO String := do - let mut str ← msg.data.toString - unless msg.caption == "" do - str := msg.caption ++ ":\n" ++ str - match msg.severity with - | MessageSeverity.information => str := "info: " ++ str - | MessageSeverity.warning => str := "warning: " ++ str - | MessageSeverity.error => str := "error: " ++ str - if str.isEmpty || str.back != '\n' then - str := str ++ "\n" - return str - -/-- The decision made by a specification for a message. -/ -inductive SpecResult - /-- Capture the message and check it matches the docstring. -/ - | check - /-- Drop the message and delete it. -/ - | drop - /-- Do not capture the message. -/ - | passthrough - -/-- Parses a `guardMsgsSpec`. -- No specification: check everything. -- With a specification: interpret the spec, and if nothing applies pass it through. -/ -def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) : - CommandElabM (Message → SpecResult) := do - if let some spec := spec? then - match spec with - | `(guardMsgsSpec| ($[$elts:guardMsgsSpecElt],*)) => do - let mut p : Message → SpecResult := fun _ => .passthrough - let pushP (s : MessageSeverity) (drop : Bool) (p : Message → SpecResult) - (msg : Message) : SpecResult := - if msg.severity == s then if drop then .drop else .check - else p msg - for elt in elts.reverse do - match elt with - | `(guardMsgsSpecElt| $[drop%$drop?]? info) => p := pushP .information drop?.isSome p - | `(guardMsgsSpecElt| $[drop%$drop?]? warning) => p := pushP .warning drop?.isSome p - | `(guardMsgsSpecElt| $[drop%$drop?]? error) => p := pushP .error drop?.isSome p - | `(guardMsgsSpecElt| $[drop%$drop?]? all) => - p := fun _ => if drop?.isSome then .drop else .check - | _ => throwErrorAt elt "Invalid #guard_msgs specification element" - return p - | _ => throwErrorAt spec "Invalid #guard_msgs specification" - else - return fun _ => .check - -/-- An info tree node corresponding to a failed `#guard_msgs` invocation, -used for code action support. -/ -structure GuardMsgFailure where - /-- The result of the nested command -/ - res : String - deriving TypeName - -elab_rules : command - | `(command| $[$dc?:docComment]? #guard_msgs%$tk $(spec?)? in $cmd) => do - let expected : String := (← dc?.mapM (getDocStringText ·)).getD "" |>.trim - let specFn ← parseGuardMsgsSpec spec? - let initMsgs ← modifyGet fun st => (st.messages, { st with messages := {} }) - elabCommandTopLevel cmd - let msgs := (← get).messages - let mut toCheck : MessageLog := .empty - let mut toPassthrough : MessageLog := .empty - for msg in msgs.toList do - match specFn msg with - | .check => toCheck := toCheck.add msg - | .drop => pure () - | .passthrough => toPassthrough := toPassthrough.add msg - let res := "---\n".intercalate (← toCheck.toList.mapM (messageToStringWithoutPos ·)) |>.trim - -- We do some whitespace normalization here to allow users to break long lines. - if expected.replace "\n" " " == res.replace "\n" " " then - -- Passed. Only put toPassthrough messages back on the message log - modify fun st => { st with messages := initMsgs ++ toPassthrough } - else - -- Failed. Put all the messages back on the message log and add an error - modify fun st => { st with messages := initMsgs ++ msgs } - logErrorAt tk m!"❌ Docstring on `#guard_msgs` does not match generated message:\n\n{res}" - pushInfoLeaf (.ofCustomInfo { stx := ← getRef, value := Dynamic.mk (GuardMsgFailure.mk res) }) - -open CodeAction Server RequestM in -/-- A code action which will update the doc comment on a `#guard_msgs` invocation. -/ -@[command_code_action guardMsgsCmd] -def guardMsgsCodeAction : CommandCodeAction := fun _ _ _ node => do - let .node _ ts := node | return #[] - let res := ts.findSome? fun - | .node (.ofCustomInfo { stx, value }) _ => return (stx, (← value.get? GuardMsgFailure).res) - | _ => none - let some (stx, res) := res | return #[] - let doc ← readDoc - let eager := { - title := "Update #guard_msgs with tactic output" - kind? := "quickfix" - isPreferred? := true - } - pure #[{ - eager - lazy? := some do - let some start := stx.getPos? true | return eager - let some tail := stx.setArg 0 mkNullNode |>.getPos? true | return eager - let newText := if res.isEmpty then - "" - else if res.length ≤ 100-7 && !res.contains '\n' then -- TODO: configurable line length? - s!"/-- {res} -/\n" - else - s!"/--\n{res}\n-/\n" - pure { eager with - edit? := some <|.ofTextEdit doc.versionedIdentifier { - range := doc.meta.text.utf8RangeToLspRange ⟨start, tail⟩ - newText - } - } - }] diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean deleted file mode 100644 index ff33412e0b..0000000000 --- a/Std/Tactic/LibrarySearch.lean +++ /dev/null @@ -1,533 +0,0 @@ -/- -Copyright (c) 2021-2023 Gabriel Ebner and Lean FRO. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Joe Hendrix, Scott Morrison --/ -import Lean.Meta.Tactic.TryThis -import Std.Lean.CoreM -import Std.Lean.Expr -import Std.Lean.Meta.DiscrTree -import Std.Lean.Meta.LazyDiscrTree -import Lean.Elab.Tactic.SolveByElim -import Std.Util.Pickle - -/-! -# Library search - -This file defines tactics `std_exact?` and `std_apply?`, -(formerly known as `library_search`) -and a term elaborator `std_exact?%` -that tries to find a lemma -solving the current goal -(subgoals are solved using `solveByElim`). - -``` -example : x < x + 1 := std_exact?% -example : Nat := by std_exact? -``` - -These functions will likely lose their `std_` prefix once -we are ready to replace the corresponding implementations in Mathlib. --/ - -namespace Std.Tactic.LibrarySearch - -open Lean Meta Tactic.TryThis - -initialize registerTraceClass `Tactic.stdLibrarySearch -initialize registerTraceClass `Tactic.stdLibrarySearch.lemmas - -/-- Configuration for `DiscrTree`. -/ -def discrTreeConfig : WhnfCoreConfig := {} - -/-- -A "modifier" for a declaration. -* `none` indicates the original declaration, -* `mp` indicates that (possibly after binders) the declaration is an `↔`, - and we want to consider the forward direction, -* `mpr` similarly, but for the backward direction. --/ -inductive DeclMod - | /-- the original declaration -/ none - | /-- the forward direction of an `iff` -/ mp - | /-- the backward direction of an `iff` -/ mpr -deriving DecidableEq, Inhabited, Ord - -instance : ToString DeclMod where - toString m := match m with | .none => "" | .mp => "mp" | .mpr => "mpr" - -/-- -LibrarySearch has an extension mechanism for replacing the function used -to find candidate lemmas. --/ -@[reducible] -def CandidateFinder := Expr → MetaM (Array (Name × DeclMod)) - -open LazyDiscrTree (InitEntry isBlackListed createImportedEnvironment) - -namespace DiscrTreeFinder - -open System (FilePath) - - -/-- -Once we reach Mathlib, and have `cache` available, -we may still want to load a precomputed cache for `exact?` from a `.olean` file. - -This makes no sense here in Std, where there is no caching mechanism. --/ -def cachePath : IO FilePath := do - let sp ← searchPathRef.get - if let buildPath :: _ := sp then - let path := buildPath / "LibrarySearch.extra" - if ← path.pathExists then - return path - return ".lake" / "build" / "lib" / "LibrarySearch.extra" - -/-- Add a path to a discrimination tree.-/ -private def addPath [BEq α] (config : WhnfCoreConfig) (tree : DiscrTree α) (tp : Expr) (v : α) : - MetaM (DiscrTree α) := do - let k ← DiscrTree.mkPath tp config - pure <| tree.insertCore k v - -/-- Adds a constant with given name to tree. -/ -private def updateTree (config : WhnfCoreConfig) (tree : DiscrTree (Name × DeclMod)) - (name : Name) (constInfo : ConstantInfo) : MetaM (DiscrTree (Name × DeclMod)) := do - if constInfo.isUnsafe then return tree - if isBlackListed (←getEnv) name then return tree - withReducible do - let (_, _, type) ← forallMetaTelescope constInfo.type - let tree ← addPath config tree type (name, DeclMod.none) - match type.getAppFnArgs with - | (``Iff, #[lhs, rhs]) => do - let tree ← addPath config tree rhs (name, DeclMod.mp) - let tree ← addPath config tree lhs (name, DeclMod.mpr) - return tree - | _ => - return tree - -/-- -Constructs an discriminator tree from the current environment. --/ -def buildImportCache (config : WhnfCoreConfig) : MetaM (DiscrTree (Name × DeclMod)) := do - let profilingName := "apply?: init cache" - -- Sort so lemmas with longest names come first. - let post (A : Array (Name × DeclMod)) := - A.map (fun (n, m) => (n.toString.length, n, m)) |>.qsort (fun p q => p.1 > q.1) |>.map (·.2) - profileitM Exception profilingName (← getOptions) do - (·.mapArrays post) <$> (← getEnv).constants.map₁.foldM (init := {}) (updateTree config) - -/-- -Return matches from local constants. - -N.B. The efficiency of this could likely be considerably improved by caching in environment -extension. --/ -def localMatches (config : WhnfCoreConfig) (ty : Expr) : MetaM (Array (Name × DeclMod)) := do - let locals ← (← getEnv).constants.map₂.foldlM (init := {}) (DiscrTreeFinder.updateTree config) - pure <| (← locals.getMatch ty config).reverse - -/-- -Candidate finding function that uses strict discrimination tree for resolution. --/ -def mkImportFinder (config : WhnfCoreConfig) (importTree : DiscrTree (Name × DeclMod)) - (ty : Expr) : MetaM (Array (Name × DeclMod)) := do - pure <| (← importTree.getMatch ty config).reverse - -end DiscrTreeFinder - -namespace IncDiscrTreeFinder - - -/-- -The maximum number of constants an individual task performed. - -The value below was picked because it roughly correponded to 50ms of work on the machine this was -developed on. Smaller numbers did not seem to improve performance when importing Std and larger -numbers (<10k) seemed to degrade initialization performance. --/ -private def constantsPerTask : Nat := 6500 - -private def addImport (name : Name) (constInfo : ConstantInfo) : - MetaM (Array (InitEntry (Name × DeclMod))) := - forallTelescope constInfo.type fun _ type => do - let e ← InitEntry.fromExpr type (name, DeclMod.none) - let a := #[e] - if e.key == .const ``Iff 2 then - let a := a.push (←e.mkSubEntry 0 (name, DeclMod.mp)) - let a := a.push (←e.mkSubEntry 1 (name, DeclMod.mpr)) - pure a - else - pure a - -/-- -Candidate finding function that uses strict discrimination tree for resolution. --/ -def mkImportFinder : IO CandidateFinder := do - let ref ← IO.mkRef none - pure fun ty => do - let importTree ← (←ref.get).getDM $ do - profileitM Exception "librarySearch launch" (←getOptions) $ - createImportedEnvironment (←getEnv) (constantsPerTask := constantsPerTask) addImport - let (imports, importTree) ← importTree.getMatch ty - ref.set importTree - pure imports - -end IncDiscrTreeFinder - -private unsafe def mkImportFinder : IO CandidateFinder := do - let path ← DiscrTreeFinder.cachePath - if ← path.pathExists then - let (imports, _) ← unpickle (DiscrTree (Name × DeclMod)) path - -- `DiscrTree.getMatch` returns results in batches, with more specific lemmas coming later. - -- Hence we reverse this list, so we try out more specific lemmas earlier. - pure <| DiscrTreeFinder.mkImportFinder {} imports - else do - IncDiscrTreeFinder.mkImportFinder - -/-- -The preferred candidate finding function. --/ -initialize defaultCandidateFinder : IO.Ref CandidateFinder ← unsafe do - IO.mkRef (←mkImportFinder) - -/-- -Update the candidate finder used by library search. --/ -def setDefaultCandidateFinder (cf : CandidateFinder) : IO Unit := - defaultCandidateFinder.set cf - -private def emoji (e:Except ε α) := if e.toBool then checkEmoji else crossEmoji - -/-- Create lemma from name and mod. -/ -def mkLibrarySearchLemma (lem : Name) (mod : DeclMod) : MetaM Expr := do - let lem ← mkConstWithFreshMVarLevels lem - match mod with - | .none => pure lem - | .mp => mapForallTelescope (fun e => mkAppM ``Iff.mp #[e]) lem - | .mpr => mapForallTelescope (fun e => mkAppM ``Iff.mpr #[e]) lem - -/-- -A library search candidate using symmetry includes the goal to solve, the metavar -context for that goal, and the name and orientation of a rule to try using with goal. --/ -@[reducible] -def Candidate := (MVarId × MetavarContext) × (Name × DeclMod) - -/-- -Try applying the given lemma (with symmetry modifier) to the goal, -then try to close subsequent goals using `solveByElim`. -If `solveByElim` succeeds, we return `[]` as the list of new subgoals, -otherwise the full list of subgoals. --/ -private def librarySearchLemma (cfg : ApplyConfig) (act : List MVarId → MetaM (List MVarId)) - (allowFailure : MVarId → MetaM Bool) (cand : Candidate) : MetaM (List MVarId) := do - let ((goal, mctx), (name, mod)) := cand - withTraceNode `Tactic.stdLibrarySearch (return m!"{emoji ·} trying {name} with {mod} ") do - setMCtx mctx - let lem ← mkLibrarySearchLemma name mod - let newGoals ← goal.apply lem cfg - try - act newGoals - catch _ => - if ← allowFailure goal then - pure newGoals - else - failure - -/-- -Interleave x y interleaves the elements of x and y until one is empty and then returns -final elements in other list. --/ -def interleaveWith {α β γ} (f : α → γ) (x : Array α) (g : β → γ) (y : Array β) : Array γ := - Id.run do - let mut res := Array.mkEmpty (x.size + y.size) - let n := min x.size y.size - for h : i in [0:n] do - have p : i < min x.size y.size := h.2 - have q : i < x.size := Nat.le_trans p (Nat.min_le_left ..) - have r : i < y.size := Nat.le_trans p (Nat.min_le_right ..) - res := res.push (f x[i]) - res := res.push (g y[i]) - let last := - if x.size > n then - (x.extract n x.size).map f - else - (y.extract n y.size).map g - pure $ res ++ last - -/-- -Run `searchFn` on both the goal and `symm` applied to the goal. --/ -def librarySearchSymm (searchFn : CandidateFinder) (goal : MVarId) : MetaM (Array Candidate) := do - let tgt ← goal.getType - let l1 ← searchFn tgt - let coreMCtx ← getMCtx - let coreGoalCtx := (goal, coreMCtx) - if let some symmGoal ← observing? goal.applySymm then - let newType ← instantiateMVars (← symmGoal.getType) - let l2 ← searchFn newType - let symmMCtx ← getMCtx - let symmGoalCtx := (symmGoal, symmMCtx) - setMCtx coreMCtx - pure $ interleaveWith (coreGoalCtx, ·) l1 (symmGoalCtx, ·) l2 - else - pure $ l1.map (coreGoalCtx, ·) - -/-- A type synonym for our subgoal ranking algorithm. -/ -def SubgoalRankType := Bool × Nat × Int - deriving ToString - -instance : Ord SubgoalRankType := - have : Ord (Nat × Int) := lexOrd - lexOrd - -/-- Count how many local hypotheses appear in an expression. -/ -def countLocalHypsUsed [Monad m] [MonadLCtx m] [MonadMCtx m] (e : Expr) : m Nat := do - let e' ← instantiateMVars e - return (← getLocalHyps).foldr (init := 0) fun h n => if h.occurs e' then n + 1 else n - -/-- Returns a tuple: -* are there no remaining goals? -* how many local hypotheses were used? -* how many goals remain, negated? - -Larger values (i.e. no remaining goals, more local hypotheses, fewer remaining goals) -are better. --/ -def subgoalRanking (goal : MVarId) (subgoals : List MVarId) : MetaM SubgoalRankType := do - return (subgoals.isEmpty, ← countLocalHypsUsed (.mvar goal), - subgoals.length) - -/-- -An exception Id that indicates further speculation on candidate lemmas should stop -and current results returned. --/ -private initialize abortSpeculationId : InternalExceptionId ← - registerInternalExceptionId `Std.Tactic.LibrarySearch.abortSpeculation - -/-- -Called to abort speculative execution in library search. --/ -def abortSpeculation [MonadExcept Exception m] : m α := - throw (Exception.internal abortSpeculationId {}) - -/-- Returns true if this is an abort speculation exception. -/ -def isAbortSpeculation : Exception → Bool -| .internal id _ => id == abortSpeculationId -| _ => false - -/-- -Sequentially invokes a tactic `act` on each value in candidates on the current state. - -The tactic `act` should return a list of meta-variables that still need to be resolved. -If this list is empty, then no variables remain to be solved, and `tryOnEach` returns -`none` with the environment set so each goal is resolved. - -If the action throws an internal exception with the `abortSpeculationId` id then -further computation is stopped and intermediate results returned. If any other -exception is thrown, then it is silently discarded. --/ -def tryOnEach - (act : Candidate → MetaM (List MVarId)) - (candidates : Array Candidate) : - MetaM (Option (Array (List MVarId × MetavarContext))) := do - let mut a := #[] - let s ← saveState - for c in candidates do - match ← (tryCatch (Except.ok <$> act c) (pure ∘ Except.error)) with - | .error e => - restoreState s - if isAbortSpeculation e then - break - | .ok remaining => - if remaining.isEmpty then - return none - let ctx ← getMCtx - restoreState s - a := a.push (remaining, ctx) - return (.some a) - -/-- -Return an action that returns true when the remaining heartbeats is less -than the currently remaining heartbeats * leavePercent / 100. --/ -def mkHeartbeatCheck (leavePercent : Nat) : MetaM (MetaM Bool) := do - let maxHB ← getMaxHeartbeats - let hbThreshold := (← getRemainingHeartbeats) * leavePercent / 100 - -- Return true if we should stop - pure $ - if maxHB = 0 then - pure false - else do - return (← getRemainingHeartbeats) < hbThreshold - -open SolveByElim - -/-- Shortcut for calling `solveByElim`. -/ -def solveByElim (required : List Expr) (exfalso : Bool) (goals : List MVarId) (maxDepth : Nat) := do - -- There is only a marginal decrease in performance for using the `symm` option for `solveByElim`. - -- (measured via `lake build && time lake env lean test/librarySearch.lean`). - let cfg : SolveByElimConfig := - { maxDepth, exfalso := exfalso, symm := true, commitIndependentGoals := true, - transparency := ← getTransparency, - -- `constructor` has been observed to significantly slow down `exact?` in Mathlib. - constructor := false } - let ⟨lemmas, ctx⟩ ← SolveByElim.mkAssumptionSet false false [] [] #[] - let cfg := if !required.isEmpty then cfg.requireUsingAll required else cfg - SolveByElim.solveByElim cfg lemmas ctx goals - -/-- State for resolving imports -/ -private def LibSearchState := IO.Ref (Option CandidateFinder) - -private initialize LibSearchState.default : IO.Ref (Option CandidateFinder) ← do - IO.mkRef .none - -private instance : Inhabited LibSearchState where - default := LibSearchState.default - -private initialize ext : EnvExtension LibSearchState ← - registerEnvExtension (IO.mkRef .none) - -private def librarySearchEmoji : Except ε (Option α) → String -| .error _ => bombEmoji -| .ok (some _) => crossEmoji -| .ok none => checkEmoji - -private def librarySearch' (goal : MVarId) - (tactic : List MVarId → MetaM (List MVarId)) - (allowFailure : MVarId → MetaM Bool) - (leavePercentHeartbeats : Nat) : - MetaM (Option (Array (List MVarId × MetavarContext))) := do - withTraceNode `Tactic.stdLibrarySearch (return m!"{librarySearchEmoji ·} {← goal.getType}") do - profileitM Exception "librarySearch" (← getOptions) do - let importFinder ← do - let r := ext.getState (←getEnv) - match ←r.get with - | .some f => pure f - | .none => - let f ← defaultCandidateFinder.get - r.set (.some f) - pure f - let searchFn (ty : Expr) := do - let localMap ← (← getEnv).constants.map₂.foldlM (init := {}) (DiscrTreeFinder.updateTree {}) - let locals := (← localMap.getMatch ty {}).reverse - pure <| locals ++ (← importFinder ty) - -- Create predicate that returns true when running low on heartbeats. - let shouldAbort ← mkHeartbeatCheck leavePercentHeartbeats - let candidates ← librarySearchSymm searchFn goal - let cfg : ApplyConfig := { allowSynthFailures := true } - let act := fun cand => do - if ←shouldAbort then - abortSpeculation - librarySearchLemma cfg tactic allowFailure cand - tryOnEach act candidates - -/-- -Try to solve the goal either by: -* calling `tactic true` -* or applying a library lemma then calling `tactic false` on the resulting goals. - -Typically here `tactic` is `solveByElim`, -with the `Bool` flag indicating whether it may retry with `exfalso`. - -If it successfully closes the goal, returns `none`. -Otherwise, it returns `some a`, where `a : Array (List MVarId × MetavarContext)`, -with an entry for each library lemma which was successfully applied, -containing a list of the subsidiary goals, and the metavariable context after the application. - -(Always succeeds, and the metavariable context stored in the monad is reverted, -unless the goal was completely solved.) - -(Note that if `solveByElim` solves some but not all subsidiary goals, -this is not currently tracked.) --/ -def librarySearch (goal : MVarId) - (tactic : Bool → List MVarId → MetaM (List MVarId)) - (allowFailure : MVarId → MetaM Bool := fun _ => pure true) - (leavePercentHeartbeats : Nat := 10) : - MetaM (Option (Array (List MVarId × MetavarContext))) := do - (tactic true [goal] *> pure none) <|> - librarySearch' goal (tactic false) allowFailure leavePercentHeartbeats - -open Lean.Parser.Tactic - --- TODO: implement the additional options for `library_search` from Lean 3, --- in particular including additional lemmas --- with `std_exact? [X, Y, Z]` or `std_exact? with attr`. - --- For now we only implement the basic functionality. --- The full syntax is recognized, but will produce a "Tactic has not been implemented" error. - -/-- Syntax for `std_exact?` -/ -syntax (name := std_exact?') "std_exact?" (config)? (simpArgs)? (" using " (colGt ident),+)? - ("=>" tacticSeq)? : tactic - -/-- Syntax for `std_apply?` -/ -syntax (name := std_apply?') "std_apply?" (config)? (simpArgs)? (" using " (colGt term),+)? : tactic - -open Elab.Tactic Elab Tactic -open Parser.Tactic (tacticSeq) - -/-- Implementation of the `exact?` tactic. -/ -def exact? (tk : Syntax) (required : Option (Array (TSyntax `term))) - (solver : Option (TSyntax `Lean.Parser.Tactic.tacticSeq)) (requireClose : Bool) : - TacticM Unit := do - let mvar ← getMainGoal - let (_, goal) ← (← getMainGoal).intros - goal.withContext do - let required := (← (required.getD #[]).mapM getFVarId).toList.map .fvar - let tactic ← - match solver with - | none => - pure (fun exfalso => solveByElim required (exfalso := exfalso) (maxDepth := 6)) - | some t => - let _ <- mkInitialTacticInfo t - throwError "Do not yet support custom std_exact?/std_apply? tactics." - let allowFailure := fun g => do - let g ← g.withContext (instantiateMVars (.mvar g)) - return required.all fun e => e.occurs g - match ← librarySearch goal tactic allowFailure with - -- Found goal that closed problem - | none => - addExactSuggestion tk (← instantiateMVars (mkMVar mvar)).headBeta - -- Found suggestions - | some suggestions => - if requireClose then throwError - "`std_exact?` could not close the goal. Try `std_apply?` to see partial suggestions." - reportOutOfHeartbeats `library_search tk - for (_, suggestionMCtx) in suggestions do - withMCtx suggestionMCtx do - addExactSuggestion tk (← instantiateMVars (mkMVar mvar)).headBeta (addSubgoalsMsg := true) - if suggestions.isEmpty then logError "std_apply? didn't find any relevant lemmas" - admitGoal goal - -elab_rules : tactic - | `(tactic| std_exact? $[using $[$lemmas],*]? $[=> $solver]?) => do - exact? (← getRef) lemmas solver true - -elab_rules : tactic | `(tactic| std_apply? $[using $[$required],*]?) => do - exact? (← getRef) required none false - ---/-- Deprecation warning for `library_search`. -/ ---elab tk:"library_search" : tactic => do --- logWarning ("`library_search` has been renamed to `apply?`" ++ --- " (or `exact?` if you only want solutions closing the goal)") --- exact? tk none false - -open Elab Term in -/-- Term elaborator using the `exact?` tactic. -/ -elab tk:"std_exact?%" : term <= expectedType => do - let goal ← mkFreshExprMVar expectedType - let (_, introdGoal) ← goal.mvarId!.intros - introdGoal.withContext do - let tactic := fun exfalso g => solveByElim [] (maxDepth := 6) exfalso g - if let some suggestions ← librarySearch introdGoal tactic then - reportOutOfHeartbeats `library_search tk - for suggestion in suggestions do - withMCtx suggestion.2 do - addTermSuggestion tk (← instantiateMVars goal).headBeta - if suggestions.isEmpty then logError "std_exact? didn't find any relevant lemmas" - mkSorry expectedType (synthetic := true) - else - addTermSuggestion tk (← instantiateMVars goal).headBeta - instantiateMVars goal diff --git a/lean-toolchain b/lean-toolchain index 63d320d43a..09c577cc33 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-22 +leanprover/lean4:nightly-2024-02-27 diff --git a/test/MLList.lean b/test/MLList.lean index eaf14cbc04..8473b08e8b 100644 --- a/test/MLList.lean +++ b/test/MLList.lean @@ -1,5 +1,4 @@ import Std.Data.MLList.IO -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/absurd.lean b/test/absurd.lean index dd0d4af4f8..9efe145830 100644 --- a/test/absurd.lean +++ b/test/absurd.lean @@ -1,5 +1,4 @@ import Std.Tactic.Basic -import Std.Tactic.GuardMsgs /-! Tests for `absurd` tactic -/ diff --git a/test/add_suggestion.lean b/test/add_suggestion.lean index 6604c092d9..c86c6a4c95 100644 --- a/test/add_suggestion.lean +++ b/test/add_suggestion.lean @@ -1,5 +1,4 @@ import Lean.Meta.Tactic.TryThis -import Std.Tactic.GuardMsgs set_option linter.unusedVariables false set_option linter.missingDocs false diff --git a/test/alias.lean b/test/alias.lean index 1f3e2e7dbe..0b8e125329 100644 --- a/test/alias.lean +++ b/test/alias.lean @@ -1,5 +1,4 @@ import Std.Tactic.Alias -import Std.Tactic.GuardMsgs set_option linter.unusedVariables false set_option linter.missingDocs false diff --git a/test/bitvec.lean b/test/bitvec.lean index e7a0d78617..4814fdd1a8 100644 --- a/test/bitvec.lean +++ b/test/bitvec.lean @@ -1,6 +1,6 @@ import Std.Data.BitVec -open Std.BitVec +open BitVec -- Basic arithmetic #guard 1#12 + 2#12 = 3#12 @@ -93,8 +93,6 @@ open Std.BitVec #guard extractLsb 7 4 0x1234#16 = 3 #guard extractLsb' 0 4 0x1234#16 = 0x4#4 -open Std - /-- This tests the match compiler with bitvector literals to ensure it can successfully generate a pattern for a bitvector literals. diff --git a/test/bitvec_simproc.lean b/test/bitvec_simproc.lean index b3c42ec12c..1013b41664 100644 --- a/test/bitvec_simproc.lean +++ b/test/bitvec_simproc.lean @@ -4,45 +4,45 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ import Std.Data.BitVec -open Std BitVec +open BitVec -example (h : x = (6 : Std.BitVec 3)) : x = -2 := by +example (h : x = (6 : BitVec 3)) : x = -2 := by simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (5 : Std.BitVec 3)) : x = ~~~2 := by +example (h : x = (5 : BitVec 3)) : x = ~~~2 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : Std.BitVec 32)) : x = BitVec.abs (-1#32) := by +example (h : x = (1 : BitVec 32)) : x = BitVec.abs (-1#32) := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (5 : Std.BitVec 3)) : x = 2 + 3 := by +example (h : x = (5 : BitVec 3)) : x = 2 + 3 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : Std.BitVec 3)) : x = 5 &&& 3 := by +example (h : x = (1 : BitVec 3)) : x = 5 &&& 3 := by simp; guard_target =ₛ x = 1#3; assumption -example (h : x = (7 : Std.BitVec 3)) : x = 5 ||| 3 := by +example (h : x = (7 : BitVec 3)) : x = 5 ||| 3 := by simp; guard_target =ₛ x = 7#3; assumption -example (h : x = (6 : Std.BitVec 3)) : x = 5 ^^^ 3 := by +example (h : x = (6 : BitVec 3)) : x = 5 ^^^ 3 := by simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (3 : Std.BitVec 32)) : x = 5 - 2 := by +example (h : x = (3 : BitVec 32)) : x = 5 - 2 := by simp; guard_target =ₛ x = 3#32; assumption -example (h : x = (10 : Std.BitVec 32)) : x = 5 * 2 := by +example (h : x = (10 : BitVec 32)) : x = 5 * 2 := by simp; guard_target =ₛ x = 10#32; assumption -example (h : x = (4 : Std.BitVec 32)) : x = 9 / 2 := by +example (h : x = (4 : BitVec 32)) : x = 9 / 2 := by simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = 9 % 2 := by +example (h : x = (1 : BitVec 32)) : x = 9 % 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : Std.BitVec 32)) : x = udiv 9 2 := by +example (h : x = (4 : BitVec 32)) : x = udiv 9 2 := by simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = umod 9 2 := by +example (h : x = (1 : BitVec 32)) : x = umod 9 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : Std.BitVec 32)) : x = sdiv (-9) (-2) := by +example (h : x = (4 : BitVec 32)) : x = sdiv (-9) (-2) := by simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = smod (-9) 2 := by +example (h : x = (1 : BitVec 32)) : x = smod (-9) 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = - smtUDiv 9 0 := by +example (h : x = (1 : BitVec 32)) : x = - smtUDiv 9 0 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = - srem (-9) 2 := by +example (h : x = (1 : BitVec 32)) : x = - srem (-9) 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = - smtSDiv 9 0 := by +example (h : x = (1 : BitVec 32)) : x = - smtSDiv 9 0 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = smtSDiv (-9) 0 := by +example (h : x = (1 : BitVec 32)) : x = smtSDiv (-9) 0 := by simp; guard_target =ₛ x = 1#32; assumption example (h : x = false) : x = (4#3).getLsb 0:= by simp; guard_target =ₛ x = false; assumption @@ -52,29 +52,29 @@ example (h : x = true) : x = (4#3).getMsb 0:= by simp; guard_target =ₛ x = true; assumption example (h : x = false) : x = (4#3).getMsb 2:= by simp; guard_target =ₛ x = false; assumption -example (h : x = (24 : Std.BitVec 32)) : x = 6#32 <<< 2 := by +example (h : x = (24 : BitVec 32)) : x = 6#32 <<< 2 := by simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = 6#32 >>> 2 := by +example (h : x = (1 : BitVec 32)) : x = 6#32 >>> 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (24 : Std.BitVec 32)) : x = BitVec.shiftLeft 6#32 2 := by +example (h : x = (24 : BitVec 32)) : x = BitVec.shiftLeft 6#32 2 := by simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = BitVec.ushiftRight 6#32 2 := by +example (h : x = (1 : BitVec 32)) : x = BitVec.ushiftRight 6#32 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (2 : Std.BitVec 32)) : x = - BitVec.sshiftRight (- 6#32) 2 := by +example (h : x = (2 : BitVec 32)) : x = - BitVec.sshiftRight (- 6#32) 2 := by simp; guard_target =ₛ x = 2#32; assumption -example (h : x = (5 : Std.BitVec 3)) : x = BitVec.rotateLeft (6#3) 1 := by +example (h : x = (5 : BitVec 3)) : x = BitVec.rotateLeft (6#3) 1 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (3 : Std.BitVec 3)) : x = BitVec.rotateRight (6#3) 1 := by +example (h : x = (3 : BitVec 3)) : x = BitVec.rotateRight (6#3) 1 := by simp; guard_target =ₛ x = 3#3; assumption -example (h : x = (7 : Std.BitVec 5)) : x = 1#3 ++ 3#2 := by +example (h : x = (7 : BitVec 5)) : x = 1#3 ++ 3#2 := by simp; guard_target =ₛ x = 7#5; assumption -example (h : x = (1 : Std.BitVec 3)) : x = BitVec.cast (by decide : 3=2+1) 1#3 := by +example (h : x = (1 : BitVec 3)) : x = BitVec.cast (by decide : 3=2+1) 1#3 := by simp; guard_target =ₛ x = 1#3; assumption example (h : x = 5) : x = (2#3 + 3#3).toNat := by simp; guard_target =ₛ x = 5; assumption example (h : x = -1) : x = (2#3 - 3#3).toInt := by simp; guard_target =ₛ x = -1; assumption -example (h : x = (1 : Std.BitVec 3)) : x = -BitVec.ofInt 3 (-1) := by +example (h : x = (1 : BitVec 3)) : x = -BitVec.ofInt 3 (-1) := by simp; guard_target =ₛ x = 1#3; assumption example (h : x) : x = (1#3 < 3#3) := by simp; guard_target =ₛ x; assumption @@ -100,13 +100,13 @@ example (h : x) : x = (3#3 ≥ 1#3) := by simp; guard_target =ₛ x; assumption example (h : ¬x) : x = (3#3 ≥ 4#3) := by simp; guard_target =ₛ ¬x; assumption -example (h : x = (5 : Std.BitVec 7)) : x = (5#3).zeroExtend' (by decide) := by +example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend' (by decide) := by simp; guard_target =ₛ x = 5#7; assumption -example (h : x = (80 : Std.BitVec 7)) : x = (5#3).shiftLeftZeroExtend 4 := by +example (h : x = (80 : BitVec 7)) : x = (5#3).shiftLeftZeroExtend 4 := by simp; guard_target =ₛ x = 80#7; assumption -example (h : x = (5: Std.BitVec 3)) : x = (10#5).extractLsb' 1 3 := by +example (h : x = (5: BitVec 3)) : x = (10#5).extractLsb' 1 3 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (9: Std.BitVec 6)) : x = (1#3).replicate 2 := by +example (h : x = (9: BitVec 6)) : x = (1#3).replicate 2 := by simp; guard_target =ₛ x = 9#6; assumption -example (h : x = (5 : Std.BitVec 7)) : x = (5#3).zeroExtend 7 := by +example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend 7 := by simp; guard_target =ₛ x = 5#7; assumption diff --git a/test/case.lean b/test/case.lean index 78b6fe5f43..f0bb9d9b5e 100644 --- a/test/case.lean +++ b/test/case.lean @@ -1,5 +1,4 @@ import Std.Tactic.Case -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/coe.lean b/test/coe.lean index 6a52129da0..2edede07ff 100644 --- a/test/coe.lean +++ b/test/coe.lean @@ -1,4 +1,4 @@ -import Std.Tactic.GuardMsgs +import Lean.Meta.CoeAttr set_option linter.missingDocs false diff --git a/test/conv_equals.lean b/test/conv_equals.lean index f646192acd..95ff7354f8 100644 --- a/test/conv_equals.lean +++ b/test/conv_equals.lean @@ -5,7 +5,6 @@ Authors: Joachim Breitner -/ import Std.Tactic.Basic -import Std.Tactic.GuardMsgs -- The example from the doc string, for quick comparision -- and keeping the doc up-to-date diff --git a/test/ext.lean b/test/ext.lean index 3e00798a7c..84f718d12f 100644 --- a/test/ext.lean +++ b/test/ext.lean @@ -1,5 +1,4 @@ import Std.Logic -import Std.Tactic.GuardMsgs set_option linter.missingDocs false axiom mySorry {α : Sort _} : α diff --git a/test/guard_msgs.lean b/test/guard_msgs.lean index 5a6b77e282..96d89f5aaa 100644 --- a/test/guard_msgs.lean +++ b/test/guard_msgs.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs #guard_msgs in /-- error: unknown identifier 'x' -/ diff --git a/test/instances.lean b/test/instances.lean index 220630ee12..ed1fd9698a 100644 --- a/test/instances.lean +++ b/test/instances.lean @@ -1,5 +1,4 @@ import Std.Tactic.Instances -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/isIndependentOf.lean b/test/isIndependentOf.lean index 7d0bff1c89..6ff9720bbf 100644 --- a/test/isIndependentOf.lean +++ b/test/isIndependentOf.lean @@ -1,6 +1,5 @@ import Std.Lean.Meta.Basic import Std.Tactic.PermuteGoals -import Std.Tactic.GuardMsgs import Lean.Meta.Tactic.IndependentOf open Lean Meta Elab.Tactic diff --git a/test/json.lean b/test/json.lean index 63df684c34..8755ab9126 100644 --- a/test/json.lean +++ b/test/json.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs import Lean.Data.Json.Elab /-- info: {"lookACalc": 131, diff --git a/test/kmp_matcher.lean b/test/kmp_matcher.lean index 600878c7e3..1b46841033 100644 --- a/test/kmp_matcher.lean +++ b/test/kmp_matcher.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs import Std.Data.String.Basic /-! Tests for Knuth-Morris-Pratt matching algorithm -/ diff --git a/test/left_right.lean b/test/left_right.lean index fcff731b06..cf65bee79c 100644 --- a/test/left_right.lean +++ b/test/left_right.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs /-- Construct a natural number using `left`. -/ def zero : Nat := by diff --git a/test/library_search/basic.lean b/test/library_search/basic.lean index fc7c6ff9b2..4879724e05 100644 --- a/test/library_search/basic.lean +++ b/test/library_search/basic.lean @@ -22,106 +22,106 @@ noncomputable section /-- info: Try this: exact Nat.lt.base x -/ #guard_msgs in -example (x : Nat) : x ≠ x.succ := Nat.ne_of_lt (by std_apply?) +example (x : Nat) : x ≠ x.succ := Nat.ne_of_lt (by apply?) /-- info: Try this: exact Nat.zero_lt_succ 1 -/ #guard_msgs in -example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by std_apply?) +example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by apply?) example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by exact Fin.size_pos') /-- info: Try this: exact Nat.add_comm x y -/ #guard_msgs in -example (x y : Nat) : x + y = y + x := by std_apply? +example (x y : Nat) : x + y = y + x := by apply? /-- info: Try this: exact fun a => Nat.add_le_add_right a k -/ #guard_msgs in -example (n m k : Nat) : n ≤ m → n + k ≤ m + k := by std_apply? +example (n m k : Nat) : n ≤ m → n + k ≤ m + k := by apply? /-- info: Try this: exact Nat.mul_dvd_mul_left a w -/ #guard_msgs in -example (ha : a > 0) (w : b ∣ c) : a * b ∣ a * c := by std_apply? +example (ha : a > 0) (w : b ∣ c) : a * b ∣ a * c := by apply? -- Could be any number of results (`Int.one`, `Int.zero`, etc) #guard_msgs (drop info) in -example : Int := by std_apply? +example : Int := by apply? /-- info: Try this: Nat.lt.base x -/ #guard_msgs in -example : x < x + 1 := std_exact?% +example : x < x + 1 := exact?% /-- info: Try this: exact p -/ #guard_msgs in -example (P : Prop) (p : P) : P := by std_apply? +example (P : Prop) (p : P) : P := by apply? /-- info: Try this: exact False.elim (np p) -/ #guard_msgs in -example (P : Prop) (p : P) (np : ¬P) : false := by std_apply? +example (P : Prop) (p : P) (np : ¬P) : false := by apply? /-- info: Try this: exact h x rfl -/ #guard_msgs in -example (X : Type) (P : Prop) (x : X) (h : ∀ x : X, x = x → P) : P := by std_apply? +example (X : Type) (P : Prop) (x : X) (h : ∀ x : X, x = x → P) : P := by apply? -- Could be any number of results (`fun x => x`, `id`, etc) #guard_msgs (drop info) in -example (α : Prop) : α → α := by std_apply? +example (α : Prop) : α → α := by apply? -- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example (p : Prop) : (¬¬p) → p := by std_apply? -- says: `exact not_not.mp` --- example (a b : Prop) (h : a ∧ b) : a := by std_apply? -- says: `exact h.left` --- example (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by std_apply? -- say: `exact Function.mtr` +-- example (p : Prop) : (¬¬p) → p := by apply? -- says: `exact not_not.mp` +-- example (a b : Prop) (h : a ∧ b) : a := by apply? -- says: `exact h.left` +-- example (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by apply? -- say: `exact Function.mtr` /-- info: Try this: exact Nat.add_comm a b -/ #guard_msgs in example (a b : Nat) : a + b = b + a := -by std_apply? +by apply? /-- info: Try this: exact Nat.mul_sub_left_distrib n m k -/ #guard_msgs in example (n m k : Nat) : n * (m - k) = n * m - n * k := -by std_apply? +by apply? attribute [symm] Eq.symm /-- info: Try this: exact Eq.symm (Nat.mul_sub_left_distrib n m k) -/ #guard_msgs in example (n m k : Nat) : n * m - n * k = n * (m - k) := by - std_apply? + apply? /-- info: Try this: exact eq_comm -/ #guard_msgs in -example {α : Type} (x y : α) : x = y ↔ y = x := by std_apply? +example {α : Type} (x y : α) : x = y ↔ y = x := by apply? /-- info: Try this: exact Nat.add_pos_left ha b -/ #guard_msgs in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by std_apply? +example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? /-- info: Try this: exact Nat.add_pos_left ha b -/ #guard_msgs in -- Verify that if maxHeartbeats is 0 we don't stop immediately. set_option maxHeartbeats 0 in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by std_apply? +example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? section synonym /-- info: Try this: exact Nat.add_pos_left ha b -/ #guard_msgs in -example (a b : Nat) (ha : a > 0) (_hb : 0 < b) : 0 < a + b := by std_apply? +example (a b : Nat) (ha : a > 0) (_hb : 0 < b) : 0 < a + b := by apply? /-- info: Try this: exact Nat.le_of_dvd w h -/ #guard_msgs in example (a b : Nat) (h : a ∣ b) (w : b > 0) : a ≤ b := -by std_apply? +by apply? /-- info: Try this: exact Nat.le_of_dvd w h -/ #guard_msgs in -example (a b : Nat) (h : a ∣ b) (w : b > 0) : b ≥ a := by std_apply? +example (a b : Nat) (h : a ∣ b) (w : b > 0) : b ≥ a := by apply? -- TODO: A lemma with head symbol `¬` can be used to prove `¬ p` or `⊥` /-- info: Try this: exact Nat.not_lt_zero a -/ #guard_msgs in -example (a : Nat) : ¬ (a < 0) := by std_apply? +example (a : Nat) : ¬ (a < 0) := by apply? /-- info: Try this: exact Nat.not_succ_le_zero a h -/ #guard_msgs in -example (a : Nat) (h : a < 0) : False := by std_apply? +example (a : Nat) (h : a < 0) : False := by apply? -- An inductive type hides the constructor's arguments enough -- so that `apply?` doesn't accidentally close the goal. @@ -137,60 +137,60 @@ theorem lemma_with_false_in_head (a b : Nat) (_h1 : a < b) (h2 : P a) : False := /-- info: Try this: exact lemma_with_gt_in_head a h -/ #guard_msgs in -example (a : Nat) (h : P a) : 0 > a := by std_apply? +example (a : Nat) (h : P a) : 0 > a := by apply? /-- info: Try this: exact lemma_with_gt_in_head a h -/ #guard_msgs in -example (a : Nat) (h : P a) : a < 0 := by std_apply? +example (a : Nat) (h : P a) : a < 0 := by apply? /-- info: Try this: exact lemma_with_false_in_head a b h1 h2 -/ #guard_msgs in -example (a b : Nat) (h1 : a < b) (h2 : P a) : False := by std_apply? +example (a b : Nat) (h1 : a < b) (h2 : P a) : False := by apply? -- TODO this no longer works: --- example (a b : Nat) (h1 : a < b) : ¬ (P a) := by std_apply? -- says `exact lemma_with_false_in_head a b h1` +-- example (a b : Nat) (h1 : a < b) : ¬ (P a) := by apply? -- says `exact lemma_with_false_in_head a b h1` end synonym /-- info: Try this: exact fun P => iff_not_self -/ #guard_msgs in -example : ∀ P : Prop, ¬(P ↔ ¬P) := by std_apply? +example : ∀ P : Prop, ¬(P ↔ ¬P) := by apply? -- We even find `iff` results: /-- info: Try this: exact (Nat.dvd_add_iff_left h₁).mpr h₂ -/ #guard_msgs in -example {a b c : Nat} (h₁ : a ∣ c) (h₂ : a ∣ b + c) : a ∣ b := by std_apply? +example {a b c : Nat} (h₁ : a ∣ c) (h₂ : a ∣ b + c) : a ∣ b := by apply? -- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example {α : Sort u} (h : Empty) : α := by std_apply? -- says `exact Empty.elim h` --- example (f : A → C) (g : B → C) : (A ⊕ B) → C := by std_apply? -- says `exact Sum.elim f g` --- example (n : Nat) (r : ℚ) : ℚ := by std_apply? using n, r -- exact nsmulRec n r +-- example {α : Sort u} (h : Empty) : α := by apply? -- says `exact Empty.elim h` +-- example (f : A → C) (g : B → C) : (A ⊕ B) → C := by apply? -- says `exact Sum.elim f g` +-- example (n : Nat) (r : ℚ) : ℚ := by apply? using n, r -- exact nsmulRec n r opaque f : Nat → Nat axiom F (a b : Nat) : f a ≤ f b ↔ a ≤ b /-- info: Try this: exact (F a b).mpr h -/ #guard_msgs in -example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by std_apply? +example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by apply? /-- info: Try this: exact List.join L -/ #guard_msgs in -example (L : List (List Nat)) : List Nat := by std_apply? using L +example (L : List (List Nat)) : List Nat := by apply? using L -- Could be any number of results #guard_msgs (drop info) in -example (P _Q : List Nat) (h : Nat) : List Nat := by std_apply? using h, P +example (P _Q : List Nat) (h : Nat) : List Nat := by apply? using h, P -- Could be any number of results #guard_msgs (drop info) in example (l : List α) (f : α → β ⊕ γ) : List β × List γ := by - std_apply? using f -- partitionMap f l + apply? using f -- partitionMap f l -- Could be any number of results (`Nat.mul n m`, `Nat.add n m`, etc) #guard_msgs (drop info) in -example (n m : Nat) : Nat := by std_apply? using n, m +example (n m : Nat) : Nat := by apply? using n, m #guard_msgs (drop info) in -example (P Q : List Nat) (_h : Nat) : List Nat := by std_exact? using P, Q +example (P Q : List Nat) (_h : Nat) : List Nat := by exact? using P, Q -- Check that we don't use sorryAx: -- (see https://github.com/leanprover-community/mathlib4/issues/226) @@ -200,7 +200,7 @@ theorem Bool_eq_iff {A B : Bool} : (A = B) = (A ↔ B) := /-- info: Try this: exact Bool_eq_iff -/ #guard_msgs in theorem Bool_eq_iff2 {A B : Bool} : (A = B) = (A ↔ B) := by - std_apply? -- exact Bool_eq_iff + apply? -- exact Bool_eq_iff -- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/library_search.20regression/near/354025788 -- Disabled for Std @@ -213,17 +213,17 @@ theorem Bool_eq_iff2 {A B : Bool} : (A = B) = (A ↔ B) := by -- /-- info: Try this: exact Iff.symm Nat.prime_iff -/ --#guard_msgs in --example (n : Nat) : Prime n ↔ Nat.Prime n := by --- std_exact? +-- exact? -- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/exact.3F.20recent.20regression.3F/near/387691588 -- Disabled for Std --lemma ex' (x : Nat) (_h₁ : x = 0) (h : 2 * 2 ∣ x) : 2 ∣ x := by --- std_exact? says exact dvd_of_mul_left_dvd h +-- exact? says exact dvd_of_mul_left_dvd h -- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/apply.3F.20failure/near/402534407 -- Disabled for Std --example (P Q : Prop) (h : P → Q) (h' : ¬Q) : ¬P := by --- std_exact? says exact mt h h' +-- exact? says exact mt h h' -- Removed until we come up with a way of handling nonspecific lemmas -- that does not pollute the output or cause too much slow-down. @@ -242,11 +242,11 @@ warning: declaration uses 'sorry' -/ #guard_msgs in example {x : Int} (h : x ≠ 0) : 2 * x ≠ 0 := by - std_apply? using h + apply? using h -- Check that adding `with_reducible` prevents expensive kernel reductions. -- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/.60exact.3F.60.20failure.3A.20.22maximum.20recursion.20depth.20has.20been.20reached.22/near/417649319 /-- info: Try this: exact Nat.add_comm n m -/ #guard_msgs in example (_h : List.range 10000 = List.range 10000) (n m : Nat) : n + m = m + n := by - with_reducible std_exact? + with_reducible exact? diff --git a/test/lintTC.lean b/test/lintTC.lean index 9a2afb7e29..deee02378c 100644 --- a/test/lintTC.lean +++ b/test/lintTC.lean @@ -1,5 +1,5 @@ import Std.Tactic.Lint.TypeClass -import Std.Tactic.GuardMsgs +import Lean.Elab.Command open Std.Tactic.Lint diff --git a/test/lint_unreachableTactic.lean b/test/lint_unreachableTactic.lean index 00501d85ae..86938a12f9 100644 --- a/test/lint_unreachableTactic.lean +++ b/test/lint_unreachableTactic.lean @@ -1,5 +1,4 @@ import Std.Linter.UnreachableTactic -import Std.Tactic.GuardMsgs /-- warning: this tactic is never executed [linter.unreachableTactic] -/ #guard_msgs in diff --git a/test/lintsimp.lean b/test/lintsimp.lean index 9098b613d8..41bd091192 100644 --- a/test/lintsimp.lean +++ b/test/lintsimp.lean @@ -1,5 +1,4 @@ import Std.Tactic.Lint -import Std.Tactic.GuardMsgs open Std.Tactic.Lint set_option linter.missingDocs false @@ -48,10 +47,10 @@ section def MyPred (_ : Nat → Nat) : Prop := True @[simp] theorem bad1 (f : Unit → Nat → Nat) : MyPred (f ()) ↔ True := by - rw [MyPred]; exact Iff.rfl + rw [MyPred] @[simp] theorem bad2 (f g : Nat → Nat) : MyPred (fun x => f (g x)) ↔ True := by - rw [MyPred]; exact Iff.rfl + rw [MyPred] -- Note, this is not a proper regression test because #671 depends on how the `MetaM` is -- executed, and `run_meta` sets the options appropriately. But setting the config diff --git a/test/lintunused.lean b/test/lintunused.lean index a917c0e9e6..b236ec97ea 100644 --- a/test/lintunused.lean +++ b/test/lintunused.lean @@ -1,5 +1,4 @@ import Std.Tactic.Lint -import Std.Tactic.GuardMsgs -- should be ignored as the proof contains sorry /-- warning: declaration uses 'sorry' -/ diff --git a/test/nondet.lean b/test/nondet.lean index 3bc2d94856..66f3022e08 100644 --- a/test/nondet.lean +++ b/test/nondet.lean @@ -1,5 +1,4 @@ import Std.Control.Nondet.Basic -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/print_prefix.lean b/test/print_prefix.lean index a80badc41b..9f742b382a 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -1,5 +1,4 @@ import Std.Tactic.PrintPrefix -import Std.Tactic.GuardMsgs inductive TEmpty : Type /-- diff --git a/test/register_label_attr.lean b/test/register_label_attr.lean index 9b0e66c846..c10279bd18 100644 --- a/test/register_label_attr.lean +++ b/test/register_label_attr.lean @@ -1,5 +1,4 @@ import Std.Test.Internal.DummyLabelAttr -import Std.Tactic.GuardMsgs import Lean.LabelAttribute set_option linter.missingDocs false diff --git a/test/repeat.lean b/test/repeat.lean index 009fd16841..276e283f8f 100644 --- a/test/repeat.lean +++ b/test/repeat.lean @@ -1,5 +1,4 @@ import Std.Tactic.Basic -import Std.Tactic.GuardMsgs open Lean Elab Tactic Meta diff --git a/test/run_cmd.lean b/test/run_cmd.lean index acb2e24065..a3b649e5e0 100644 --- a/test/run_cmd.lean +++ b/test/run_cmd.lean @@ -1,5 +1,5 @@ import Lean.Elab.Tactic.ElabTerm -import Std.Tactic.GuardMsgs +import Lean.Elab.Command open Lean Elab Tactic diff --git a/test/show_term.lean b/test/show_term.lean index 25b6aacb1d..922e034238 100644 --- a/test/show_term.lean +++ b/test/show_term.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Tactic.ShowTerm -import Std.Tactic.GuardMsgs /-- info: Try this: exact (n, 37) -/ #guard_msgs in example (n : Nat) : Nat × Nat := by diff --git a/test/simp_trace.lean b/test/simp_trace.lean index 2e700e2fae..b3cefc454c 100644 --- a/test/simp_trace.lean +++ b/test/simp_trace.lean @@ -1,5 +1,4 @@ import Std.Tactic.SqueezeScope -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/simpa.lean b/test/simpa.lean index fe1b4e702d..065e3b8328 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Gabriel Ebner -/ import Std.Tactic.ShowTerm -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/tryThis.lean b/test/tryThis.lean index e616193b62..c17a64c287 100644 --- a/test/tryThis.lean +++ b/test/tryThis.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 Thomas Murrills. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Murrills -/ -import Std.Tactic.GuardMsgs import Lean.Meta.Tactic.TryThis open Lean.Meta.Tactic.TryThis diff --git a/test/where.lean b/test/where.lean index 5ec9cc4300..8c005997ca 100644 --- a/test/where.lean +++ b/test/where.lean @@ -1,5 +1,4 @@ import Std.Tactic.Where -import Std.Tactic.GuardMsgs -- Return to pristine state set_option linter.missingDocs false From fb65114743a31f56458998093d4650dec11d4187 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Wed, 28 Feb 2024 09:14:52 +0000 Subject: [PATCH 099/213] chore: bump to nightly-2024-02-28 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 09c577cc33..7a8de20d64 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-27 +leanprover/lean4:nightly-2024-02-28 From 026c06b0fa871a0938217259194cb46553edb766 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 03:44:35 +1100 Subject: [PATCH 100/213] chore: adaptations for nightly-2024-02-27 (#674) --- Std.lean | 4 - Std/CodeAction/Attr.lean | 118 +---- Std/CodeAction/Basic.lean | 41 -- Std/CodeAction/Misc.lean | 3 +- Std/Data/BitVec/Lemmas.lean | 2 +- Std/Data/Fin/Lemmas.lean | 4 + Std/Data/MLList/Heartbeats.lean | 3 +- Std/Lean/CoreM.lean | 50 -- Std/Lean/Expr.lean | 19 - Std/Lean/Meta/Basic.lean | 17 - Std/Lean/Meta/LazyDiscrTree.lean | 881 ------------------------------- Std/Tactic/GuardMsgs.lean | 194 ------- Std/Tactic/LibrarySearch.lean | 533 ------------------- lean-toolchain | 2 +- test/MLList.lean | 1 - test/absurd.lean | 1 - test/add_suggestion.lean | 1 - test/alias.lean | 1 - test/bitvec.lean | 4 +- test/bitvec_simproc.lean | 70 +-- test/case.lean | 1 - test/coe.lean | 2 +- test/conv_equals.lean | 1 - test/ext.lean | 1 - test/guard_msgs.lean | 1 - test/instances.lean | 1 - test/isIndependentOf.lean | 1 - test/json.lean | 1 - test/kmp_matcher.lean | 1 - test/left_right.lean | 1 - test/library_search/basic.lean | 92 ++-- test/lintTC.lean | 2 +- test/lint_unreachableTactic.lean | 1 - test/lintsimp.lean | 5 +- test/lintunused.lean | 1 - test/nondet.lean | 1 - test/print_prefix.lean | 1 - test/register_label_attr.lean | 1 - test/repeat.lean | 1 - test/run_cmd.lean | 2 +- test/show_term.lean | 1 - test/simp_trace.lean | 1 - test/simpa.lean | 1 - test/tryThis.lean | 1 - test/where.lean | 1 - 45 files changed, 99 insertions(+), 1973 deletions(-) delete mode 100644 Std/Lean/CoreM.lean delete mode 100644 Std/Lean/Meta/LazyDiscrTree.lean delete mode 100644 Std/Tactic/GuardMsgs.lean delete mode 100644 Std/Tactic/LibrarySearch.lean diff --git a/Std.lean b/Std.lean index c43ddd2ea4..f4906385c5 100644 --- a/Std.lean +++ b/Std.lean @@ -37,7 +37,6 @@ import Std.Data.String import Std.Data.Sum import Std.Data.UInt import Std.Lean.AttributeExtra -import Std.Lean.CoreM import Std.Lean.Delaborator import Std.Lean.Except import Std.Lean.Expr @@ -53,7 +52,6 @@ import Std.Lean.Meta.DiscrTree import Std.Lean.Meta.Expr import Std.Lean.Meta.Inaccessible import Std.Lean.Meta.InstantiateMVars -import Std.Lean.Meta.LazyDiscrTree import Std.Lean.Meta.SavedState import Std.Lean.Meta.Simp import Std.Lean.Meta.UnusedNames @@ -81,10 +79,8 @@ import Std.Tactic.Classical import Std.Tactic.Congr import Std.Tactic.Exact import Std.Tactic.FalseOrByContra -import Std.Tactic.GuardMsgs import Std.Tactic.Init import Std.Tactic.Instances -import Std.Tactic.LibrarySearch import Std.Tactic.Lint import Std.Tactic.Lint.Basic import Std.Tactic.Lint.Frontend diff --git a/Std/CodeAction/Attr.lean b/Std/CodeAction/Attr.lean index 42c6742404..f748450e7d 100644 --- a/Std/CodeAction/Attr.lean +++ b/Std/CodeAction/Attr.lean @@ -8,53 +8,16 @@ import Lean.Server.CodeActions /-! # Initial setup for code action attributes -* Attribute `@[hole_code_action]` collects code actions which will be called - on each occurrence of a hole (`_`, `?_` or `sorry`). +* `@[hole_code_action]` and `@[command_code_action]` now live in the Lean repository, + and are builtin. * Attribute `@[tactic_code_action]` collects code actions which will be called on each occurrence of a tactic. - -* Attribute `@[command_code_action]` collects code actions which will be called - on each occurrence of a command. -/ namespace Std.CodeAction open Lean Elab Server Lsp RequestM Snapshots -/-- A hole code action extension. -/ -abbrev HoleCodeAction := - CodeActionParams → Snapshot → - (ctx : ContextInfo) → (hole : TermInfo) → RequestM (Array LazyCodeAction) - -/-- Read a hole code action from a declaration of the right type. -/ -def mkHoleCodeAction (n : Name) : ImportM HoleCodeAction := do - let { env, opts, .. } ← read - IO.ofExcept <| unsafe env.evalConstCheck HoleCodeAction opts ``HoleCodeAction n - -/-- An extension which collects all the hole code actions. -/ -initialize holeCodeActionExt : - PersistentEnvExtension Name (Name × HoleCodeAction) (Array Name × Array HoleCodeAction) ← - registerPersistentEnvExtension { - mkInitial := pure (#[], #[]) - addImportedFn := fun as => return (#[], ← as.foldlM (init := #[]) fun m as => - as.foldlM (init := m) fun m a => return m.push (← mkHoleCodeAction a)) - addEntryFn := fun (s₁, s₂) (n₁, n₂) => (s₁.push n₁, s₂.push n₂) - exportEntriesFn := (·.1) - } - -initialize - registerBuiltinAttribute { - name := `hole_code_action - descr := "Declare a new hole code action, to appear in the code actions on ?_ and _" - applicationTime := .afterCompilation - add := fun decl stx kind => do - Attribute.Builtin.ensureNoArgs stx - unless kind == AttributeKind.global do - throwError "invalid attribute 'hole_code_action', must be global" - if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions - modifyEnv (holeCodeActionExt.addEntry · (decl, ← mkHoleCodeAction decl)) - } - /-- A tactic code action extension. -/ abbrev TacticCodeAction := CodeActionParams → Snapshot → @@ -166,80 +129,3 @@ initialize modifyEnv (tacticCodeActionExt.addEntry · (⟨decl, args⟩, ← mkTacticCodeAction decl)) | _ => pure () } - -/-- A command code action extension. -/ -abbrev CommandCodeAction := - CodeActionParams → Snapshot → (ctx : ContextInfo) → (node : InfoTree) → - RequestM (Array LazyCodeAction) - -/-- Read a command code action from a declaration of the right type. -/ -def mkCommandCodeAction (n : Name) : ImportM CommandCodeAction := do - let { env, opts, .. } ← read - IO.ofExcept <| unsafe env.evalConstCheck CommandCodeAction opts ``CommandCodeAction n - -/-- An entry in the command code actions extension, containing the attribute arguments. -/ -structure CommandCodeActionEntry where - /-- The declaration to tag -/ - declName : Name - /-- The command kinds that this extension supports. - If empty it is called on all command kinds. -/ - cmdKinds : Array Name - deriving Inhabited - -/-- The state of the command code actions extension. -/ -structure CommandCodeActions where - /-- The list of command code actions to apply on any command. -/ - onAnyCmd : Array CommandCodeAction := {} - /-- The list of command code actions to apply when a particular command kind is highlighted. -/ - onCmd : NameMap (Array CommandCodeAction) := {} - deriving Inhabited - -/-- Insert a command code action entry into the `CommandCodeActions` structure. -/ -def CommandCodeActions.insert (self : CommandCodeActions) - (tacticKinds : Array Name) (action : CommandCodeAction) : CommandCodeActions := - if tacticKinds.isEmpty then - { self with onAnyCmd := self.onAnyCmd.push action } - else - { self with onCmd := tacticKinds.foldl (init := self.onCmd) fun m a => - m.insert a ((m.findD a #[]).push action) } - -/-- An extension which collects all the command code actions. -/ -initialize cmdCodeActionExt : - PersistentEnvExtension CommandCodeActionEntry (CommandCodeActionEntry × CommandCodeAction) - (Array CommandCodeActionEntry × CommandCodeActions) ← - registerPersistentEnvExtension { - mkInitial := pure (#[], {}) - addImportedFn := fun as => return (#[], ← as.foldlM (init := {}) fun m as => - as.foldlM (init := m) fun m ⟨name, kinds⟩ => - return m.insert kinds (← mkCommandCodeAction name)) - addEntryFn := fun (s₁, s₂) (e, n₂) => (s₁.push e, s₂.insert e.cmdKinds n₂) - exportEntriesFn := (·.1) - } - -/-- -This attribute marks a code action, which is used to suggest new tactics or replace existing ones. - -* `@[command_code_action kind]`: This is a code action which applies to applications of the command - `kind` (a command syntax kind), which can replace the command or insert things before or after it. - -* `@[command_code_action kind₁ kind₂]`: shorthand for - `@[command_code_action kind₁, command_code_action kind₂]`. - -* `@[command_code_action]`: This is a command code action that applies to all commands. - Use sparingly. --/ -syntax (name := command_code_action) "command_code_action" (ppSpace ident)* : attr - -initialize - registerBuiltinAttribute { - name := `command_code_action - descr := "Declare a new command code action, to appear in the code actions on commands" - applicationTime := .afterCompilation - add := fun decl stx kind => do - unless kind == AttributeKind.global do - throwError "invalid attribute 'command_code_action', must be global" - let `(attr| command_code_action $args*) := stx | return - let args ← args.mapM resolveGlobalConstNoOverloadWithInfo - if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions - modifyEnv (cmdCodeActionExt.addEntry · (⟨decl, args⟩, ← mkCommandCodeAction decl)) - } diff --git a/Std/CodeAction/Basic.lean b/Std/CodeAction/Basic.lean index d15e086f86..d09ed3f2c6 100644 --- a/Std/CodeAction/Basic.lean +++ b/Std/CodeAction/Basic.lean @@ -21,24 +21,6 @@ namespace Std.CodeAction open Lean Elab Term Server RequestM -/-- -A code action which calls all `@[hole_code_action]` code actions on each hole -(`?_`, `_`, or `sorry`). --/ -@[code_action_provider] def holeCodeActionProvider : CodeActionProvider := fun params snap => do - let doc ← readDoc - let startPos := doc.meta.text.lspPosToUtf8Pos params.range.start - let endPos := doc.meta.text.lspPosToUtf8Pos params.range.end - have holes := snap.infoTree.foldInfo (init := #[]) fun ctx info result => Id.run do - let .ofTermInfo info := info | result - unless [``elabHole, ``elabSyntheticHole, ``elabSorry].contains info.elaborator do - return result - let (some head, some tail) := (info.stx.getPos? true, info.stx.getTailPos? true) | result - unless head ≤ endPos && startPos ≤ tail do return result - result.push (ctx, info) - let #[(ctx, info)] := holes | return #[] - (holeCodeActionExt.getState snap.env).2.concatMapM (· params snap ctx info) - /-- The return value of `findTactic?`. This is the syntax for which code actions will be triggered. @@ -205,26 +187,3 @@ partial def findInfoTree? (kind : SyntaxNodeKind) (tgtRange : String.Range) try out := out ++ (← act params snap ctx i stk goals) catch _ => pure () | _ => unreachable! pure out - -/-- -A code action which calls all `@[command_code_action]` code actions on each command. --/ -@[code_action_provider] def cmdCodeActionProvider : CodeActionProvider := fun params snap => do - let doc ← readDoc - let startPos := doc.meta.text.lspPosToUtf8Pos params.range.start - let endPos := doc.meta.text.lspPosToUtf8Pos params.range.end - have cmds := snap.infoTree.foldInfoTree (init := #[]) fun ctx node result => Id.run do - let .node (.ofCommandInfo info) _ := node | result - let (some head, some tail) := (info.stx.getPos? true, info.stx.getTailPos? true) | result - unless head ≤ endPos && startPos ≤ tail do return result - result.push (ctx, node) - let actions := (cmdCodeActionExt.getState snap.env).2 - let mut out := #[] - for (ctx, node) in cmds do - let .node (.ofCommandInfo info) _ := node | unreachable! - if let some arr := actions.onCmd.find? info.stx.getKind then - for act in arr do - try out := out ++ (← act params snap ctx node) catch _ => pure () - for act in actions.onAnyCmd do - try out := out ++ (← act params snap ctx node) catch _ => pure () - pure out diff --git a/Std/CodeAction/Misc.lean b/Std/CodeAction/Misc.lean index 18f38ec793..e6d50ef051 100644 --- a/Std/CodeAction/Misc.lean +++ b/Std/CodeAction/Misc.lean @@ -9,6 +9,7 @@ import Std.Lean.Name import Std.Lean.Position import Std.CodeAction.Attr import Lean.Meta.Tactic.TryThis +import Lean.Server.CodeActions.Provider /-! # Miscellaneous code actions @@ -17,7 +18,7 @@ This declares some basic tactic code actions, using the `@[tactic_code_action]` -/ namespace Std.CodeAction -open Lean Meta Elab Server RequestM +open Lean Meta Elab Server RequestM CodeAction /-- Return the syntax stack leading to `target` from `root`, if one exists. -/ def findStack? (root target : Syntax) : Option Syntax.Stack := do diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index 65983b4fb0..437ab0358e 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -8,7 +8,7 @@ import Std.Data.Fin.Lemmas import Std.Data.Nat.Lemmas import Std.Util.ProofWanted -namespace Std.BitVec +namespace BitVec /-- Replaced 2024-02-07. -/ @[deprecated] alias zero_is_unique := eq_nil diff --git a/Std/Data/Fin/Lemmas.lean b/Std/Data/Fin/Lemmas.lean index 015d8b66f9..b48858d97e 100644 --- a/Std/Data/Fin/Lemmas.lean +++ b/Std/Data/Fin/Lemmas.lean @@ -8,3 +8,7 @@ import Std.Data.Fin.Basic namespace Fin attribute [norm_cast] val_last + +/-! ### clamp -/ + +@[simp] theorem coe_clamp (n m : Nat) : (clamp n m : Nat) = min n m := rfl diff --git a/Std/Data/MLList/Heartbeats.lean b/Std/Data/MLList/Heartbeats.lean index a079f0db7c..02e9ebc2a9 100644 --- a/Std/Data/MLList/Heartbeats.lean +++ b/Std/Data/MLList/Heartbeats.lean @@ -4,12 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.MLList.Basic -import Std.Lean.CoreM +import Lean.Util.Heartbeats /-! # Truncate a `MLList` when running out of available heartbeats. -/ +open Lean open Lean.Core (CoreM) /-- Take an initial segment of a monadic lazy list, diff --git a/Std/Lean/CoreM.lean b/Std/Lean/CoreM.lean deleted file mode 100644 index 563debce6d..0000000000 --- a/Std/Lean/CoreM.lean +++ /dev/null @@ -1,50 +0,0 @@ -/- -Copyright (c) 2023 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Lean.CoreM - -/-! -# Additional functions using `CoreM` state. --/ - -open Lean - -/-- -Count the number of heartbeats used during a monadic function. - -Remember that user facing heartbeats (e.g. as used in `set_option maxHeartbeats`) -differ from the internally tracked heartbeats by a factor of 1000, -so you need to divide the results here by 1000 before comparing with user facing numbers. --/ --- See also `Lean.withSeconds` -def Lean.withHeartbeats [Monad m] [MonadLiftT BaseIO m] (x : m α) : m (α × Nat) := do - let start ← IO.getNumHeartbeats - let r ← x - let finish ← IO.getNumHeartbeats - return (r, finish - start) - -/-- Return the current `maxHeartbeats`. -/ -def getMaxHeartbeats : CoreM Nat := do pure <| (← read).maxHeartbeats - -/-- Return the current `initHeartbeats`. -/ -def getInitHeartbeats : CoreM Nat := do pure <| (← read).initHeartbeats - -/-- Return the remaining heartbeats available in this computation. -/ -def getRemainingHeartbeats : CoreM Nat := do - pure <| (← getMaxHeartbeats) - ((← IO.getNumHeartbeats) - (← getInitHeartbeats)) - -/-- -Return the percentage of the max heartbeats allowed -that have been consumed so far in this computation. --/ -def heartbeatsPercent : CoreM Nat := do - pure <| ((← IO.getNumHeartbeats) - (← getInitHeartbeats)) * 100 / (← getMaxHeartbeats) - -/-- Log a message if it looks like we ran out of time. -/ -def reportOutOfHeartbeats (tac : Name) (stx : Syntax) (threshold : Nat := 90) : CoreM Unit := do - if (← heartbeatsPercent) ≥ threshold then - logInfoAt stx s!"\ - `{tac}` stopped because it was running out of time.\n\ - You may get better results using `set_option maxHeartbeats 0`." diff --git a/Std/Lean/Expr.lean b/Std/Lean/Expr.lean index 2367af3892..20338d3424 100644 --- a/Std/Lean/Expr.lean +++ b/Std/Lean/Expr.lean @@ -40,12 +40,6 @@ def lambdaArity : Expr → Nat | lam _ _ b _ => 1 + lambdaArity b | _ => 0 -/-- Like `getAppFn` but ignores metadata. -/ -def getAppFn' : Expr → Expr - | mdata _ b => getAppFn' b - | app f _ => getAppFn' f - | e => e - /-- Like `getAppNumArgs` but ignores metadata. -/ def getAppNumArgs' (e : Expr) : Nat := go e 0 @@ -104,24 +98,11 @@ def getRevArgD' : Expr → Nat → Expr → Expr | app f _ , i+1, v => getRevArgD' f i v | _ , _ , v => v -/-- Like `getRevArg!` but ignores metadata. -/ -@[inline] -def getRevArg!' : Expr → Nat → Expr - | mdata _ b, n => getRevArg!' b n - | app _ a , 0 => a - | app f _ , i+1 => getRevArg!' f i - | _ , _ => panic! "invalid index" - /-- Like `getArgD` but ignores metadata. -/ @[inline] def getArgD' (e : Expr) (i : Nat) (v₀ : Expr) (n := e.getAppNumArgs') : Expr := getRevArgD' e (n - i - 1) v₀ -/-- Like `getArg!` but ignores metadata. -/ -@[inline] -def getArg!' (e : Expr) (i : Nat) (n := e.getAppNumArgs') : Expr := - getRevArg!' e (n - i - 1) - /-- Like `isAppOf` but ignores metadata. -/ def isAppOf' (e : Expr) (n : Name) : Bool := match e.getAppFn' with diff --git a/Std/Lean/Meta/Basic.lean b/Std/Lean/Meta/Basic.lean index cb9a4bc166..3e72809893 100644 --- a/Std/Lean/Meta/Basic.lean +++ b/Std/Lean/Meta/Basic.lean @@ -162,20 +162,3 @@ where match ← tac goal with | none => acc.modify fun s => s.push goal | some goals => goals.forM (go acc) - -/-- -Given a monadic function `F` that takes a type and a term of that type and produces a new term, -lifts this to the monadic function that opens a `∀` telescope, applies `F` to the body, -and then builds the lambda telescope term for the new term. --/ -def mapForallTelescope' (F : Expr → Expr → MetaM Expr) (forallTerm : Expr) : MetaM Expr := do - forallTelescope (← Meta.inferType forallTerm) fun xs ty => do - Meta.mkLambdaFVars xs (← F ty (mkAppN forallTerm xs)) - -/-- -Given a monadic function `F` that takes a term and produces a new term, -lifts this to the monadic function that opens a `∀` telescope, applies `F` to the body, -and then builds the lambda telescope term for the new term. --/ -def mapForallTelescope (F : Expr → MetaM Expr) (forallTerm : Expr) : MetaM Expr := do - mapForallTelescope' (fun _ e => F e) forallTerm diff --git a/Std/Lean/Meta/LazyDiscrTree.lean b/Std/Lean/Meta/LazyDiscrTree.lean deleted file mode 100644 index 75818cd497..0000000000 --- a/Std/Lean/Meta/LazyDiscrTree.lean +++ /dev/null @@ -1,881 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joe Hendrix, Scott Morrison --/ - -import Lean.Meta.DiscrTree -import Std.Lean.Name - -/-! -# Lazy Discrimination Tree - -This file defines a new type of discrimination tree optimized for -rapidly population of imported modules for use in tactics. It uses a -lazy initialization strategy. - -The discrimination tree can be created through -`createImportedEnvironment`. This creates a discrimination tree from all -imported modules in an environment using a callback that provides the -entries as `InitEntry` values. - -The function `getMatch` can be used to get the values that match the -expression as well as an updated lazy discrimination tree that has -elaborated additional parts of the tree. --/ -namespace Lean.Meta.LazyDiscrTree - --- This namespace contains definitions copied from Lean.Meta.DiscrTree. -namespace MatchClone - -/-- -Discrimination tree key. --/ -private inductive Key where - /-- Constant -/ - | const : Name → Nat → Key - | fvar : FVarId → Nat → Key - | lit : Literal → Key - | star : Key - | other : Key - | arrow : Key - | proj : Name → Nat → Nat → Key - deriving Inhabited, BEq, Repr - -namespace Key - -/-- Hash function -/ -protected def hash : Key → UInt64 - | .const n a => mixHash 5237 $ mixHash n.hash (hash a) - | .fvar n a => mixHash 3541 $ mixHash (hash n) (hash a) - | .lit v => mixHash 1879 $ hash v - | .star => 7883 - | .other => 2411 - | .arrow => 17 - | .proj s i a => mixHash (hash a) $ mixHash (hash s) (hash i) - -instance : Hashable Key := ⟨Key.hash⟩ - -end Key - -private def tmpMVarId : MVarId := { name := `_discr_tree_tmp } -private def tmpStar := mkMVar tmpMVarId - -/-- - Return true iff the argument should be treated as a "wildcard" by the discrimination tree. - - - We ignore proofs because of proof irrelevance. It doesn't make sense to try to - index their structure. - - - We ignore instance implicit arguments (e.g., `[Add α]`) because they are "morally" canonical. - Moreover, we may have many definitionally equal terms floating around. - Example: `Ring.hasAdd Int Int.isRing` and `Int.hasAdd`. - - - We considered ignoring implicit arguments (e.g., `{α : Type}`) since users don't "see" them, - and may not even understand why some simplification rule is not firing. - However, in type class resolution, we have instance such as `Decidable (@Eq Nat x y)`, - where `Nat` is an implicit argument. Thus, we would add the path - ``` - Decidable -> Eq -> * -> * -> * -> [Nat.decEq] - ``` - to the discrimination tree IF we ignored the implicit `Nat` argument. - This would be BAD since **ALL** decidable equality instances would be in the same path. - So, we index implicit arguments if they are types. - This setting seems sensible for simplification theorems such as: - ``` - forall (x y : Unit), (@Eq Unit x y) = true - ``` - If we ignore the implicit argument `Unit`, the `DiscrTree` will say it is a candidate - simplification theorem for any equality in our goal. - - Remark: if users have problems with the solution above, we may provide a `noIndexing` annotation, - and `ignoreArg` would return true for any term of the form `noIndexing t`. --/ -private def ignoreArg (a : Expr) (i : Nat) (infos : Array ParamInfo) : MetaM Bool := do - if h : i < infos.size then - let info := infos.get ⟨i, h⟩ - if info.isInstImplicit then - return true - else if info.isImplicit || info.isStrictImplicit then - return not (← isType a) - else - isProof a - else - isProof a - -private partial def pushArgsAux (infos : Array ParamInfo) : Nat → Expr → Array Expr → - MetaM (Array Expr) - | i, .app f a, todo => do - if (← ignoreArg a i infos) then - pushArgsAux infos (i-1) f (todo.push tmpStar) - else - pushArgsAux infos (i-1) f (todo.push a) - | _, _, todo => return todo - -/-- - Return true if `e` is one of the following - - A nat literal (numeral) - - `Nat.zero` - - `Nat.succ x` where `isNumeral x` - - `OfNat.ofNat _ x _` where `isNumeral x` -/ -private partial def isNumeral (e : Expr) : Bool := - if e.isNatLit then true - else - let f := e.getAppFn - if !f.isConst then false - else - let fName := f.constName! - if fName == ``Nat.succ && e.getAppNumArgs == 1 then isNumeral e.appArg! - else if fName == ``OfNat.ofNat && e.getAppNumArgs == 3 then isNumeral (e.getArg! 1) - else if fName == ``Nat.zero && e.getAppNumArgs == 0 then true - else false - -private partial def toNatLit? (e : Expr) : Option Literal := - if isNumeral e then - if let some n := loop e then - some (.natVal n) - else - none - else - none -where - loop (e : Expr) : OptionT Id Nat := do - let f := e.getAppFn - match f with - | .lit (.natVal n) => return n - | .const fName .. => - if fName == ``Nat.succ && e.getAppNumArgs == 1 then - let r ← loop e.appArg! - return r+1 - else if fName == ``OfNat.ofNat && e.getAppNumArgs == 3 then - loop (e.getArg! 1) - else if fName == ``Nat.zero && e.getAppNumArgs == 0 then - return 0 - else - failure - | _ => failure - -private def isNatType (e : Expr) : MetaM Bool := - return (← whnf e).isConstOf ``Nat - -/-- - Return true if `e` is one of the following - - `Nat.add _ k` where `isNumeral k` - - `Add.add Nat _ _ k` where `isNumeral k` - - `HAdd.hAdd _ Nat _ _ k` where `isNumeral k` - - `Nat.succ _` - This function assumes `e.isAppOf fName` --/ -private def isOffset (fName : Name) (e : Expr) : MetaM Bool := do - if fName == ``Nat.add && e.getAppNumArgs == 2 then - return isNumeral e.appArg! - else if fName == ``Add.add && e.getAppNumArgs == 4 then - if (← isNatType (e.getArg! 0)) then return isNumeral e.appArg! else return false - else if fName == ``HAdd.hAdd && e.getAppNumArgs == 6 then - if (← isNatType (e.getArg! 1)) then return isNumeral e.appArg! else return false - else - return fName == ``Nat.succ && e.getAppNumArgs == 1 - -/-- - TODO: add hook for users adding their own functions for controlling `shouldAddAsStar` - Different `DiscrTree` users may populate this set using, for example, attributes. - - Remark: we currently tag "offset" terms as star to avoid having to add special - support for offset terms. - Example, suppose the discrimination tree contains the entry - `Nat.succ ?m |-> v`, and we are trying to retrieve the matches for - `Expr.lit (Literal.natVal 1) _`. - In this scenario, we want to retrieve `Nat.succ ?m |-> v` --/ -private def shouldAddAsStar (fName : Name) (e : Expr) : MetaM Bool := do - isOffset fName e - -/-- - Try to eliminate loose bound variables by performing beta-reduction. - We use this method when processing terms in discrimination trees. - These trees distinguish dependent arrows from nondependent ones. - Recall that dependent arrows are indexed as `.other`, but nondependent arrows as `.arrow ..`. - Motivation: we want to "discriminate" implications and simple arrows in our index. - - Now suppose we add the term `Foo (Nat → Nat)` to our index. The nested arrow appears as - `.arrow ..`. Then, suppose we want to check whether the index contains - `(x : Nat) → (fun _ => Nat) x`, but it will fail to retrieve `Foo (Nat → Nat)` because - it assumes the nested arrow is a dependent one and uses `.other`. - - We use this method to address this issue by beta-reducing terms containing loose bound variables. - See issue #2232. - - Remark: we expect the performance impact will be minimal. --/ -private def elimLooseBVarsByBeta (e : Expr) : CoreM Expr := - Core.transform e - (pre := fun e => do - if !e.hasLooseBVars then - return .done e - else if e.isHeadBetaTarget then - return .visit e.headBeta - else - return .continue) - -private def getKeyArgs (e : Expr) (isMatch root : Bool) (config : WhnfCoreConfig) : - MetaM (Key × Array Expr) := do - let e ← DiscrTree.reduceDT e root config - unless root do - -- See pushArgs - if let some v := toNatLit? e then - return (.lit v, #[]) - match e.getAppFn with - | .lit v => return (.lit v, #[]) - | .const c _ => - if (← getConfig).isDefEqStuckEx && e.hasExprMVar then - if (← isReducible c) then - /- `e` is a term `c ...` s.t. `c` is reducible and `e` has metavariables, but it was not - unfolded. This can happen if the metavariables in `e` are "blocking" smart unfolding. - If `isDefEqStuckEx` is enabled, then we must throw the `isDefEqStuck` exception to - postpone TC resolution. - Here is an example. Suppose we have - ``` - inductive Ty where - | bool | fn (a ty : Ty) - - - @[reducible] def Ty.interp : Ty → Type - | bool => Bool - | fn a b => a.interp → b.interp - ``` - and we are trying to synthesize `BEq (Ty.interp ?m)` - -/ - Meta.throwIsDefEqStuck - else if let some matcherInfo := isMatcherAppCore? (← getEnv) e then - -- A matcher application is stuck if one of the discriminants has a metavariable - let args := e.getAppArgs - let start := matcherInfo.getFirstDiscrPos - for arg in args[ start : start + matcherInfo.numDiscrs ] do - if arg.hasExprMVar then - Meta.throwIsDefEqStuck - else if (← isRec c) then - /- Similar to the previous case, but for `match` and recursor applications. It may be stuck - (i.e., did not reduce) because of metavariables. -/ - Meta.throwIsDefEqStuck - let nargs := e.getAppNumArgs - return (.const c nargs, e.getAppRevArgs) - | .fvar fvarId => - let nargs := e.getAppNumArgs - return (.fvar fvarId nargs, e.getAppRevArgs) - | .mvar mvarId => - if isMatch then - return (.other, #[]) - else do - let ctx ← read - if ctx.config.isDefEqStuckEx then - /- - When the configuration flag `isDefEqStuckEx` is set to true, - we want `isDefEq` to throw an exception whenever it tries to assign - a read-only metavariable. - This feature is useful for type class resolution where - we may want to notify the caller that the TC problem may be solvable - later after it assigns `?m`. - The method `DiscrTree.getUnify e` returns candidates `c` that may "unify" with `e`. - That is, `isDefEq c e` may return true. Now, consider `DiscrTree.getUnify d (Add ?m)` - where `?m` is a read-only metavariable, and the discrimination tree contains the keys - `HadAdd Nat` and `Add Int`. If `isDefEqStuckEx` is set to true, we must treat `?m` as - a regular metavariable here, otherwise we return the empty set of candidates. - This is incorrect because it is equivalent to saying that there is no solution even if - the caller assigns `?m` and try again. -/ - return (.star, #[]) - else if (← mvarId.isReadOnlyOrSyntheticOpaque) then - return (.other, #[]) - else - return (.star, #[]) - | .proj s i a .. => - let nargs := e.getAppNumArgs - return (.proj s i nargs, #[a] ++ e.getAppRevArgs) - | .forallE _ d b _ => - -- See comment at elimLooseBVarsByBeta - let b ← if b.hasLooseBVars then elimLooseBVarsByBeta b else pure b - if b.hasLooseBVars then - return (.other, #[]) - else - return (.arrow, #[d, b]) - | .bvar _ | .letE _ _ _ _ _ | .lam _ _ _ _ | .mdata _ _ | .app _ _ | .sort _ => - return (.other, #[]) - -/- -Given an expression we are looking for patterns that match, return the key and sub-expressions. --/ -private abbrev getMatchKeyArgs (e : Expr) (root : Bool) (config : WhnfCoreConfig) : - MetaM (Key × Array Expr) := - getKeyArgs e (isMatch := true) (root := root) (config := config) - -end MatchClone - -export MatchClone (Key Key.const) - -/-- -An unprocessed entry in the lazy discrimination tree. --/ -private abbrev LazyEntry α := Array Expr × ((LocalContext × LocalInstances) × α) - -/-- -Index identifying trie in a discrimination tree. --/ -@[reducible] -private def TrieIndex := Nat - -/-- -Discrimination tree trie. See `LazyDiscrTree`. --/ -private structure Trie (α : Type) where - node :: - /-- Values for matches ending at this trie. -/ - values : Array α - /-- Index of trie matching star. -/ - star : TrieIndex - /-- Following matches based on key of trie. -/ - children : HashMap Key TrieIndex - /-- Lazy entries at this trie that are not processed. -/ - pending : Array (LazyEntry α) - deriving Inhabited - -instance : EmptyCollection (Trie α) := ⟨.node #[] 0 {} #[]⟩ - -/-- Push lazy entry to trie. -/ -private def Trie.pushPending : Trie α → LazyEntry α → Trie α -| .node vs star cs p, e => .node vs star cs (p.push e) - -end LazyDiscrTree - -/-- -`LazyDiscrTree` is a variant of the discriminator tree datatype -`DiscrTree` in Lean core that is designed to be efficiently -initializable with a large number of patterns. This is useful -in contexts such as searching an entire Lean environment for -expressions that match a pattern. - -Lazy discriminator trees achieve good performance by minimizing -the amount of work that is done up front to build the discriminator -tree. When first adding patterns to the tree, only the root -discriminator key is computed and processing the remaining -terms is deferred until demanded by a match. --/ -structure LazyDiscrTree (α : Type) where - /-- Configuration for normalization. -/ - config : Lean.Meta.WhnfCoreConfig := {} - /-- Backing array of trie entries. Should be owned by this trie. -/ - tries : Array (LazyDiscrTree.Trie α) := #[default] - /-- Map from discriminator trie roots to the index. -/ - roots : Lean.HashMap LazyDiscrTree.Key LazyDiscrTree.TrieIndex := {} - -namespace LazyDiscrTree - -open Lean Elab Meta - -instance : Inhabited (LazyDiscrTree α) where - default := {} - -open Lean.Meta.DiscrTree (mkNoindexAnnotation hasNoindexAnnotation reduceDT) - -/-- -Specialization of Lean.Meta.DiscrTree.pushArgs --/ -private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) (config : WhnfCoreConfig) : - MetaM (Key × Array Expr) := do - if hasNoindexAnnotation e then - return (.star, todo) - else - let e ← reduceDT e root config - let fn := e.getAppFn - let push (k : Key) (nargs : Nat) (todo : Array Expr) : MetaM (Key × Array Expr) := do - let info ← getFunInfoNArgs fn nargs - let todo ← MatchClone.pushArgsAux info.paramInfo (nargs-1) e todo - return (k, todo) - match fn with - | .lit v => - return (.lit v, todo) - | .const c _ => - unless root do - if let some v := MatchClone.toNatLit? e then - return (.lit v, todo) - if (← MatchClone.shouldAddAsStar c e) then - return (.star, todo) - let nargs := e.getAppNumArgs - push (.const c nargs) nargs todo - | .proj s i a => - /- - If `s` is a class, then `a` is an instance. Thus, we annotate `a` with `no_index` since we do - not index instances. This should only happen if users mark a class projection function as - `[reducible]`. - - TODO: add better support for projections that are functions - -/ - let a := if isClass (← getEnv) s then mkNoindexAnnotation a else a - let nargs := e.getAppNumArgs - push (.proj s i nargs) nargs (todo.push a) - | .fvar _fvarId => --- let bi ← fvarId.getBinderInfo --- if bi.isInstImplicit then --- return (.other, todo) --- else - return (.star, todo) - | .mvar mvarId => - if mvarId == MatchClone.tmpMVarId then - -- We use `tmp to mark implicit arguments and proofs - return (.star, todo) - else - failure - | .forallE _ d b _ => - -- See comment at elimLooseBVarsByBeta - let b ← if b.hasLooseBVars then MatchClone.elimLooseBVarsByBeta b else pure b - if b.hasLooseBVars then - return (.other, todo) - else - return (.arrow, (todo.push d).push b) - | _ => - return (.other, todo) - -/-- Initial capacity for key and todo vector. -/ -private def initCapacity := 8 - -/-- -Get the root key and rest of terms of an expression using the specified config. --/ -private def rootKey (cfg: WhnfCoreConfig) (e : Expr) : MetaM (Key × Array Expr) := - pushArgs true (Array.mkEmpty initCapacity) e cfg - -private partial def mkPathAux (root : Bool) (todo : Array Expr) (keys : Array Key) - (config : WhnfCoreConfig) : MetaM (Array Key) := do - if todo.isEmpty then - return keys - else - let e := todo.back - let todo := todo.pop - let (k, todo) ← pushArgs root todo e config - mkPathAux false todo (keys.push k) config - -/-- -Create a path from an expression. - -This differs from Lean.Meta.DiscrTree.mkPath in that the expression -should uses free variables rather than meta-variables for holes. --/ -private def mkPath (e : Expr) (config : WhnfCoreConfig) : MetaM (Array Key) := do - let todo : Array Expr := .mkEmpty initCapacity - let keys : Array Key := .mkEmpty initCapacity - mkPathAux (root := true) (todo.push e) keys config - -/- Monad for finding matches while resolving deferred patterns. -/ -@[reducible] -private def MatchM α := ReaderT WhnfCoreConfig (StateRefT (Array (Trie α)) MetaM) - -private def runMatch (d : LazyDiscrTree α) (m : MatchM α β) : MetaM (β × LazyDiscrTree α) := do - let { config := c, tries := a, roots := r } := d - let (result, a) ← withReducible $ (m.run c).run a - pure (result, { config := c, tries := a, roots := r}) - -private def setTrie (i : TrieIndex) (v : Trie α) : MatchM α Unit := - modify (·.set! i v) - -/-- Create a new trie with the given lazy entry. -/ -private def newTrie [Monad m] [MonadState (Array (Trie α)) m] (e : LazyEntry α) : m TrieIndex := do - modifyGet fun a => let sz := a.size; (sz, a.push (.node #[] 0 {} #[e])) - -/-- Add a lazy entry to an existing trie. -/ -private def addLazyEntryToTrie (i:TrieIndex) (e : LazyEntry α) : MatchM α Unit := - modify (·.modify i (·.pushPending e)) - -/-- -This evaluates all lazy entries in a trie and updates `values`, `starIdx`, and `children` -accordingly. --/ -private partial def evalLazyEntries (config : WhnfCoreConfig) - (values : Array α) (starIdx : TrieIndex) (children : HashMap Key TrieIndex) - (entries : Array (LazyEntry α)) : - MatchM α (Array α × TrieIndex × HashMap Key TrieIndex) := do - let rec iter values starIdx children (i : Nat) : MatchM α _ := do - if p : i < entries.size then - let (todo, lctx, v) := entries[i] - if todo.isEmpty then - let values := values.push v - iter values starIdx children (i+1) - else - let e := todo.back - let todo := todo.pop - let (k, todo) ← withLCtx lctx.1 lctx.2 $ pushArgs false todo e config - if k == .star then - if starIdx = 0 then - let starIdx ← newTrie (todo, lctx, v) - iter values starIdx children (i+1) - else - addLazyEntryToTrie starIdx (todo, lctx, v) - iter values starIdx children (i+1) - else - match children.find? k with - | none => - let children := children.insert k (← newTrie (todo, lctx, v)) - iter values starIdx children (i+1) - | some idx => - addLazyEntryToTrie idx (todo, lctx, v) - iter values starIdx children (i+1) - else - pure (values, starIdx, children) - iter values starIdx children 0 - -private def evalNode (c : TrieIndex) : - MatchM α (Array α × TrieIndex × HashMap Key TrieIndex) := do - let .node vs star cs pending := (←get).get! c - if pending.size = 0 then - pure (vs, star, cs) - else - let config ← read - setTrie c default - let (vs, star, cs) ← evalLazyEntries config vs star cs pending - setTrie c <| .node vs star cs #[] - pure (vs, star, cs) - -/-- -Return the information about the trie at the given idnex. - -Used for internal debugging purposes. --/ -private def getTrie (d : LazyDiscrTree α) (idx : TrieIndex) : - MetaM ((Array α × TrieIndex × HashMap Key TrieIndex) × LazyDiscrTree α) := - runMatch d (evalNode idx) - -/-- -A match result repres --/ -private structure MatchResult (α : Type) where - elts : Array (Array (Array α)) := #[] - -private def MatchResult.push (r : MatchResult α) (score : Nat) (e : Array α) : MatchResult α := - if e.isEmpty then - r - else if score < r.elts.size then - { elts := r.elts.modify score (·.push e) } - else - let rec loop (a : Array (Array (Array α))) := - if a.size < score then - loop (a.push #[]) - else - { elts := a.push #[e] } - termination_by score - a.size - loop r.elts - -private partial def MatchResult.toArray (mr : MatchResult α) : Array α := - loop (Array.mkEmpty n) mr.elts - where n := mr.elts.foldl (fun i a => a.foldl (fun n a => n + a.size) i) 0 - loop (r : Array α) (a : Array (Array (Array α))) := - if a.isEmpty then - r - else - loop (a.back.foldl (init := r) (fun r a => r ++ a)) a.pop - -private partial def getMatchLoop (todo : Array Expr) (score : Nat) (c : TrieIndex) - (result : MatchResult α) : MatchM α (MatchResult α) := do - let (vs, star, cs) ← evalNode c - if todo.isEmpty then - return result.push score vs - else if star == 0 && cs.isEmpty then - return result - else - let e := todo.back - let todo := todo.pop - /- We must always visit `Key.star` edges since they are wildcards. - Thus, `todo` is not used linearly when there is `Key.star` edge - and there is an edge for `k` and `k != Key.star`. -/ - let visitStar (result : MatchResult α) : MatchM α (MatchResult α) := - if star != 0 then - getMatchLoop todo score star result - else - return result - let visitNonStar (k : Key) (args : Array Expr) (result : MatchResult α) := - match cs.find? k with - | none => return result - | some c => getMatchLoop (todo ++ args) (score + 1) c result - let result ← visitStar result - let (k, args) ← MatchClone.getMatchKeyArgs e (root := false) (←read) - match k with - | .star => return result - /- - Note: dep-arrow vs arrow - Recall that dependent arrows are `(Key.other, #[])`, and non-dependent arrows are - `(Key.arrow, #[a, b])`. - A non-dependent arrow may be an instance of a dependent arrow (stored at `DiscrTree`). - Thus, we also visit the `Key.other` child. - -/ - | .arrow => visitNonStar .other #[] (← visitNonStar k args result) - | _ => visitNonStar k args result - -private def getStarResult (root : Lean.HashMap Key TrieIndex) : MatchM α (MatchResult α) := - match root.find? .star with - | none => - pure <| {} - | some idx => do - let (vs, _) ← evalNode idx - pure <| ({} : MatchResult α).push 0 vs - -private def getMatchRoot (r : Lean.HashMap Key TrieIndex) (k : Key) (args : Array Expr) - (result : MatchResult α) : MatchM α (MatchResult α) := - match r.find? k with - | none => pure result - | some c => getMatchLoop args 1 c result - -/-- - Find values that match `e` in `root`. --/ -private def getMatchCore (root : Lean.HashMap Key TrieIndex) (e : Expr) : - MatchM α (MatchResult α) := do - let result ← getStarResult root - let (k, args) ← MatchClone.getMatchKeyArgs e (root := true) (←read) - match k with - | .star => return result - /- See note about "dep-arrow vs arrow" at `getMatchLoop` -/ - | .arrow => - getMatchRoot root k args (←getMatchRoot root .other #[] result) - | _ => - getMatchRoot root k args result - -/-- - Find values that match `e` in `d`. - - The results are ordered so that the longest matches in terms of number of - non-star keys are first with ties going to earlier operators first. --/ -def getMatch (d : LazyDiscrTree α) (e : Expr) : MetaM (Array α × LazyDiscrTree α) := - withReducible <| runMatch d <| (·.toArray) <$> getMatchCore d.roots e - -/-- -Structure for quickly initializing a lazy discrimination tree with a large number -of elements using concurrent functions for generating entries. --/ -private structure PreDiscrTree (α : Type) where - /-- Maps keys to index in tries array. -/ - roots : HashMap Key Nat := {} - /-- Lazy entries for root of trie. -/ - tries : Array (Array (LazyEntry α)) := #[] - deriving Inhabited - -namespace PreDiscrTree - -private def modifyAt (d : PreDiscrTree α) (k : Key) - (f : Array (LazyEntry α) → Array (LazyEntry α)) : PreDiscrTree α := - let { roots, tries } := d - match roots.find? k with - | .none => - let roots := roots.insert k tries.size - { roots, tries := tries.push (f #[]) } - | .some i => - { roots, tries := tries.modify i f } - -/-- Add an entry to the pre-discrimination tree.-/ -private def push (d : PreDiscrTree α) (k : Key) (e : LazyEntry α) : PreDiscrTree α := - d.modifyAt k (·.push e) - -/-- Convert a pre-discrimination tree to a lazy discrimination tree. -/ -private def toLazy (d : PreDiscrTree α) (config : WhnfCoreConfig := {}) : LazyDiscrTree α := - let { roots, tries } := d - { config, roots, tries := tries.map (.node {} 0 {}) } - -/-- Merge two discrimination trees. -/ -protected def append (x y : PreDiscrTree α) : PreDiscrTree α := - let (x, y, f) := - if x.roots.size ≥ y.roots.size then - (x, y, fun y x => x ++ y) - else - (y, x, fun x y => x ++ y) - let { roots := yk, tries := ya } := y - yk.fold (init := x) fun d k yi => d.modifyAt k (f ya[yi]!) - -instance : Append (PreDiscrTree α) where - append := PreDiscrTree.append - -end PreDiscrTree - -/-- Initial entry in lazy discrimination tree -/ -@[reducible] -structure InitEntry (α : Type) where - /-- Return root key for an entry. -/ - key : Key - /-- Returns rest of entry for later insertion. -/ - entry : LazyEntry α - -namespace InitEntry - -/-- -Constructs an initial entry from an expression and value. --/ -def fromExpr (expr : Expr) (value : α) (config : WhnfCoreConfig := {}) : MetaM (InitEntry α) := do - let lctx ← getLCtx - let linst ← getLocalInstances - let lctx := (lctx, linst) - let (key, todo) ← LazyDiscrTree.rootKey config expr - pure <| { key, entry := (todo, lctx, value) } - -/-- -Creates an entry for a subterm of an initial entry. - -This is slightly more efficient than using `fromExpr` on subterms since it avoids a redundant call -to `whnf`. --/ -def mkSubEntry (e : InitEntry α) (idx : Nat) (value : α) (config : WhnfCoreConfig := {}) : - MetaM (InitEntry α) := do - let (todo, lctx, _) := e.entry - let (key, todo) ← LazyDiscrTree.rootKey config todo[idx]! - pure <| { key, entry := (todo, lctx, value) } - -end InitEntry - -/-- Information about a failed import. -/ -private structure ImportFailure where - /-- Module with constant that import failed on. -/ - module : Name - /-- Constant that import failed on. -/ - const : Name - /-- Exception that triggers error. -/ - exception : Exception - -/-- Information generation from imported modules. -/ -private structure ImportData where - cache : IO.Ref (Lean.Meta.Cache) - errors : IO.Ref (Array ImportFailure) - -private def ImportData.new : BaseIO ImportData := do - let cache ← IO.mkRef {} - let errors ← IO.mkRef #[] - pure { cache, errors } - -/-- -An even wider class of "internal" names than reported by `Name.isInternalDetail`. --/ --- from Lean.Server.Completion -def isBlackListed (env : Environment) (declName : Name) : Bool := - declName == ``sorryAx - || declName.isInternalDetail - || declName matches .str _ "inj" - || declName matches .str _ "noConfusionType" - || isAuxRecursor env declName - || isNoConfusion env declName - || isRecCore env declName - || isMatcherCore env declName - -private def addConstImportData - (env : Environment) - (modName : Name) - (d : ImportData) - (tree : PreDiscrTree α) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (name : Name) (constInfo : ConstantInfo) : BaseIO (PreDiscrTree α) := do - if constInfo.isUnsafe then return tree - if isBlackListed env name then return tree - let mstate : Meta.State := { cache := ←d.cache.get } - d.cache.set {} - let ctx : Meta.Context := { config := { transparency := .reducible } } - let cm := (act name constInfo).run ctx mstate - let cctx : Core.Context := { - fileName := default, - fileMap := default - } - let cstate : Core.State := {env} - match ←(cm.run cctx cstate).toBaseIO with - | .ok ((a, ms), _) => - d.cache.set ms.cache - pure <| a.foldl (fun t e => t.push e.key e.entry) tree - | .error e => - let i : ImportFailure := { - module := modName, - const := name, - exception := e - } - d.errors.modify (·.push i) - pure tree - -/-- -Contains the pre discrimination tree and any errors occuring during initialization of -the library search tree. --/ -private structure InitResults (α : Type) where - tree : PreDiscrTree α := {} - errors : Array ImportFailure := #[] - -instance : Inhabited (InitResults α) where - default := {} - -namespace InitResults - -/-- Combine two initial results. -/ -protected def append (x y : InitResults α) : InitResults α := - let { tree := xv, errors := xe } := x - let { tree := yv, errors := ye } := y - { tree := xv ++ yv, errors := xe ++ ye } - -instance : Append (InitResults α) where - append := InitResults.append - -end InitResults - -private def toFlat (d : ImportData) (tree : PreDiscrTree α) : - BaseIO (InitResults α) := do - let de ← d.errors.swap #[] - pure ⟨tree, de⟩ - -private partial def loadImportedModule (env : Environment) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (d : ImportData) - (tree : PreDiscrTree α) - (mname : Name) - (mdata : ModuleData) - (i : Nat := 0) : BaseIO (PreDiscrTree α) := do - if h : i < mdata.constNames.size then - let name := mdata.constNames[i] - let constInfo := mdata.constants[i]! - let tree ← addConstImportData env mname d tree act name constInfo - loadImportedModule env act d tree mname mdata (i+1) - else - pure tree - -private def createImportedEnvironmentSeq (env : Environment) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (start stop : Nat) : BaseIO (InitResults α) := - do go (← ImportData.new) {} start stop - where go d (tree : PreDiscrTree α) (start stop : Nat) : BaseIO _ := do - if start < stop then - let mname := env.header.moduleNames[start]! - let mdata := env.header.moduleData[start]! - let tree ← loadImportedModule env act d tree mname mdata - go d tree (start+1) stop - else - toFlat d tree - termination_by stop - start - -/-- Get the results of each task and merge using combining function -/ -private def combineGet [Append α] (z : α) (tasks : Array (Task α)) : α := - tasks.foldl (fun x t => x ++ t.get) (init := z) - -/-- Create an imported environment for tree. -/ -def createImportedEnvironment (env : Environment) - (act : Name → ConstantInfo → MetaM (Array (InitEntry α))) - (constantsPerTask : Nat := 1000) : - EIO Exception (LazyDiscrTree α) := do - let n := env.header.moduleData.size - let rec - /-- Allocate constants to tasks according to `constantsPerTask`. -/ - go tasks start cnt idx := do - if h : idx < env.header.moduleData.size then - let mdata := env.header.moduleData[idx] - let cnt := cnt + mdata.constants.size - if cnt > constantsPerTask then - let t ← createImportedEnvironmentSeq env act start (idx+1) |>.asTask - go (tasks.push t) (idx+1) 0 (idx+1) - else - go tasks start cnt (idx+1) - else - if start < n then - tasks.push <$> (createImportedEnvironmentSeq env act start n).asTask - else - pure tasks - termination_by env.header.moduleData.size - idx - let tasks ← go #[] 0 0 0 - let r := combineGet default tasks - if p : r.errors.size > 0 then - throw r.errors[0].exception - pure <| r.tree.toLazy diff --git a/Std/Tactic/GuardMsgs.lean b/Std/Tactic/GuardMsgs.lean deleted file mode 100644 index f0f3ab7568..0000000000 --- a/Std/Tactic/GuardMsgs.lean +++ /dev/null @@ -1,194 +0,0 @@ -/- -Copyright (c) 2023 Kyle Miller. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kyle Miller --/ -import Std.CodeAction.Attr -import Std.Lean.Position - -/-! `#guard_msgs` command for testing commands - -This module defines a command to test that another command produces the expected messages. -See the docstring on the `#guard_msgs` command. --/ - -open Lean Parser.Tactic Elab Command - -namespace Std.Tactic.GuardMsgs - -/-- Element that can be part of a `#guard_msgs` specification. -/ -syntax guardMsgsSpecElt := &"drop"? (&"info" <|> &"warning" <|> &"error" <|> &"all") - -/-- Specification for `#guard_msgs` command. -/ -syntax guardMsgsSpec := "(" guardMsgsSpecElt,* ")" - -/-- -`#guard_msgs` captures the messages generated by another command and checks that they -match the contents of the docstring attached to the `#guard_msgs` command. - -Basic example: -```lean -/-- -error: unknown identifier 'x' --/ -#guard_msgs in -example : α := x -``` -This checks that there is such an error and then consumes the message entirely. - -By default, the command intercepts all messages, but there is a way to specify which types -of messages to consider. For example, we can select only warnings: -```lean -/-- -warning: declaration uses 'sorry' --/ -#guard_msgs(warning) in -example : α := sorry -``` -or only errors -```lean -#guard_msgs(error) in -example : α := sorry -``` -In this last example, since the message is not intercepted there is a warning on `sorry`. -We can drop the warning completely with -```lean -#guard_msgs(error, drop warning) in -example : α := sorry -``` - -Syntax description: -``` -#guard_msgs (drop? info|warning|error|all,*)? in cmd -``` - -If there is no specification, `#guard_msgs` intercepts all messages. -Otherwise, if there is one, the specification is considered in left-to-right order, and the first -that applies chooses the outcome of the message: -- `info`, `warning`, `error`: intercept a message with the given severity level. -- `all`: intercept any message (so `#guard_msgs in cmd` and `#guard_msgs (all) in cmd` - are equivalent). -- `drop info`, `drop warning`, `drop error`: intercept a message with the given severity - level and then drop it. These messages are not checked. -- `drop all`: intercept a message and drop it. - -For example, `#guard_msgs (error, drop all) in cmd` means to check warnings and then drop -everything else. --/ -syntax (name := guardMsgsCmd) - (docComment)? "#guard_msgs" (ppSpace guardMsgsSpec)? " in" ppLine command : command - -/-- Gives a string representation of a message without source position information. -Ensures the message ends with a '\n'. -/ -private def messageToStringWithoutPos (msg : Message) : IO String := do - let mut str ← msg.data.toString - unless msg.caption == "" do - str := msg.caption ++ ":\n" ++ str - match msg.severity with - | MessageSeverity.information => str := "info: " ++ str - | MessageSeverity.warning => str := "warning: " ++ str - | MessageSeverity.error => str := "error: " ++ str - if str.isEmpty || str.back != '\n' then - str := str ++ "\n" - return str - -/-- The decision made by a specification for a message. -/ -inductive SpecResult - /-- Capture the message and check it matches the docstring. -/ - | check - /-- Drop the message and delete it. -/ - | drop - /-- Do not capture the message. -/ - | passthrough - -/-- Parses a `guardMsgsSpec`. -- No specification: check everything. -- With a specification: interpret the spec, and if nothing applies pass it through. -/ -def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) : - CommandElabM (Message → SpecResult) := do - if let some spec := spec? then - match spec with - | `(guardMsgsSpec| ($[$elts:guardMsgsSpecElt],*)) => do - let mut p : Message → SpecResult := fun _ => .passthrough - let pushP (s : MessageSeverity) (drop : Bool) (p : Message → SpecResult) - (msg : Message) : SpecResult := - if msg.severity == s then if drop then .drop else .check - else p msg - for elt in elts.reverse do - match elt with - | `(guardMsgsSpecElt| $[drop%$drop?]? info) => p := pushP .information drop?.isSome p - | `(guardMsgsSpecElt| $[drop%$drop?]? warning) => p := pushP .warning drop?.isSome p - | `(guardMsgsSpecElt| $[drop%$drop?]? error) => p := pushP .error drop?.isSome p - | `(guardMsgsSpecElt| $[drop%$drop?]? all) => - p := fun _ => if drop?.isSome then .drop else .check - | _ => throwErrorAt elt "Invalid #guard_msgs specification element" - return p - | _ => throwErrorAt spec "Invalid #guard_msgs specification" - else - return fun _ => .check - -/-- An info tree node corresponding to a failed `#guard_msgs` invocation, -used for code action support. -/ -structure GuardMsgFailure where - /-- The result of the nested command -/ - res : String - deriving TypeName - -elab_rules : command - | `(command| $[$dc?:docComment]? #guard_msgs%$tk $(spec?)? in $cmd) => do - let expected : String := (← dc?.mapM (getDocStringText ·)).getD "" |>.trim - let specFn ← parseGuardMsgsSpec spec? - let initMsgs ← modifyGet fun st => (st.messages, { st with messages := {} }) - elabCommandTopLevel cmd - let msgs := (← get).messages - let mut toCheck : MessageLog := .empty - let mut toPassthrough : MessageLog := .empty - for msg in msgs.toList do - match specFn msg with - | .check => toCheck := toCheck.add msg - | .drop => pure () - | .passthrough => toPassthrough := toPassthrough.add msg - let res := "---\n".intercalate (← toCheck.toList.mapM (messageToStringWithoutPos ·)) |>.trim - -- We do some whitespace normalization here to allow users to break long lines. - if expected.replace "\n" " " == res.replace "\n" " " then - -- Passed. Only put toPassthrough messages back on the message log - modify fun st => { st with messages := initMsgs ++ toPassthrough } - else - -- Failed. Put all the messages back on the message log and add an error - modify fun st => { st with messages := initMsgs ++ msgs } - logErrorAt tk m!"❌ Docstring on `#guard_msgs` does not match generated message:\n\n{res}" - pushInfoLeaf (.ofCustomInfo { stx := ← getRef, value := Dynamic.mk (GuardMsgFailure.mk res) }) - -open CodeAction Server RequestM in -/-- A code action which will update the doc comment on a `#guard_msgs` invocation. -/ -@[command_code_action guardMsgsCmd] -def guardMsgsCodeAction : CommandCodeAction := fun _ _ _ node => do - let .node _ ts := node | return #[] - let res := ts.findSome? fun - | .node (.ofCustomInfo { stx, value }) _ => return (stx, (← value.get? GuardMsgFailure).res) - | _ => none - let some (stx, res) := res | return #[] - let doc ← readDoc - let eager := { - title := "Update #guard_msgs with tactic output" - kind? := "quickfix" - isPreferred? := true - } - pure #[{ - eager - lazy? := some do - let some start := stx.getPos? true | return eager - let some tail := stx.setArg 0 mkNullNode |>.getPos? true | return eager - let newText := if res.isEmpty then - "" - else if res.length ≤ 100-7 && !res.contains '\n' then -- TODO: configurable line length? - s!"/-- {res} -/\n" - else - s!"/--\n{res}\n-/\n" - pure { eager with - edit? := some <|.ofTextEdit doc.versionedIdentifier { - range := doc.meta.text.utf8RangeToLspRange ⟨start, tail⟩ - newText - } - } - }] diff --git a/Std/Tactic/LibrarySearch.lean b/Std/Tactic/LibrarySearch.lean deleted file mode 100644 index ff33412e0b..0000000000 --- a/Std/Tactic/LibrarySearch.lean +++ /dev/null @@ -1,533 +0,0 @@ -/- -Copyright (c) 2021-2023 Gabriel Ebner and Lean FRO. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Joe Hendrix, Scott Morrison --/ -import Lean.Meta.Tactic.TryThis -import Std.Lean.CoreM -import Std.Lean.Expr -import Std.Lean.Meta.DiscrTree -import Std.Lean.Meta.LazyDiscrTree -import Lean.Elab.Tactic.SolveByElim -import Std.Util.Pickle - -/-! -# Library search - -This file defines tactics `std_exact?` and `std_apply?`, -(formerly known as `library_search`) -and a term elaborator `std_exact?%` -that tries to find a lemma -solving the current goal -(subgoals are solved using `solveByElim`). - -``` -example : x < x + 1 := std_exact?% -example : Nat := by std_exact? -``` - -These functions will likely lose their `std_` prefix once -we are ready to replace the corresponding implementations in Mathlib. --/ - -namespace Std.Tactic.LibrarySearch - -open Lean Meta Tactic.TryThis - -initialize registerTraceClass `Tactic.stdLibrarySearch -initialize registerTraceClass `Tactic.stdLibrarySearch.lemmas - -/-- Configuration for `DiscrTree`. -/ -def discrTreeConfig : WhnfCoreConfig := {} - -/-- -A "modifier" for a declaration. -* `none` indicates the original declaration, -* `mp` indicates that (possibly after binders) the declaration is an `↔`, - and we want to consider the forward direction, -* `mpr` similarly, but for the backward direction. --/ -inductive DeclMod - | /-- the original declaration -/ none - | /-- the forward direction of an `iff` -/ mp - | /-- the backward direction of an `iff` -/ mpr -deriving DecidableEq, Inhabited, Ord - -instance : ToString DeclMod where - toString m := match m with | .none => "" | .mp => "mp" | .mpr => "mpr" - -/-- -LibrarySearch has an extension mechanism for replacing the function used -to find candidate lemmas. --/ -@[reducible] -def CandidateFinder := Expr → MetaM (Array (Name × DeclMod)) - -open LazyDiscrTree (InitEntry isBlackListed createImportedEnvironment) - -namespace DiscrTreeFinder - -open System (FilePath) - - -/-- -Once we reach Mathlib, and have `cache` available, -we may still want to load a precomputed cache for `exact?` from a `.olean` file. - -This makes no sense here in Std, where there is no caching mechanism. --/ -def cachePath : IO FilePath := do - let sp ← searchPathRef.get - if let buildPath :: _ := sp then - let path := buildPath / "LibrarySearch.extra" - if ← path.pathExists then - return path - return ".lake" / "build" / "lib" / "LibrarySearch.extra" - -/-- Add a path to a discrimination tree.-/ -private def addPath [BEq α] (config : WhnfCoreConfig) (tree : DiscrTree α) (tp : Expr) (v : α) : - MetaM (DiscrTree α) := do - let k ← DiscrTree.mkPath tp config - pure <| tree.insertCore k v - -/-- Adds a constant with given name to tree. -/ -private def updateTree (config : WhnfCoreConfig) (tree : DiscrTree (Name × DeclMod)) - (name : Name) (constInfo : ConstantInfo) : MetaM (DiscrTree (Name × DeclMod)) := do - if constInfo.isUnsafe then return tree - if isBlackListed (←getEnv) name then return tree - withReducible do - let (_, _, type) ← forallMetaTelescope constInfo.type - let tree ← addPath config tree type (name, DeclMod.none) - match type.getAppFnArgs with - | (``Iff, #[lhs, rhs]) => do - let tree ← addPath config tree rhs (name, DeclMod.mp) - let tree ← addPath config tree lhs (name, DeclMod.mpr) - return tree - | _ => - return tree - -/-- -Constructs an discriminator tree from the current environment. --/ -def buildImportCache (config : WhnfCoreConfig) : MetaM (DiscrTree (Name × DeclMod)) := do - let profilingName := "apply?: init cache" - -- Sort so lemmas with longest names come first. - let post (A : Array (Name × DeclMod)) := - A.map (fun (n, m) => (n.toString.length, n, m)) |>.qsort (fun p q => p.1 > q.1) |>.map (·.2) - profileitM Exception profilingName (← getOptions) do - (·.mapArrays post) <$> (← getEnv).constants.map₁.foldM (init := {}) (updateTree config) - -/-- -Return matches from local constants. - -N.B. The efficiency of this could likely be considerably improved by caching in environment -extension. --/ -def localMatches (config : WhnfCoreConfig) (ty : Expr) : MetaM (Array (Name × DeclMod)) := do - let locals ← (← getEnv).constants.map₂.foldlM (init := {}) (DiscrTreeFinder.updateTree config) - pure <| (← locals.getMatch ty config).reverse - -/-- -Candidate finding function that uses strict discrimination tree for resolution. --/ -def mkImportFinder (config : WhnfCoreConfig) (importTree : DiscrTree (Name × DeclMod)) - (ty : Expr) : MetaM (Array (Name × DeclMod)) := do - pure <| (← importTree.getMatch ty config).reverse - -end DiscrTreeFinder - -namespace IncDiscrTreeFinder - - -/-- -The maximum number of constants an individual task performed. - -The value below was picked because it roughly correponded to 50ms of work on the machine this was -developed on. Smaller numbers did not seem to improve performance when importing Std and larger -numbers (<10k) seemed to degrade initialization performance. --/ -private def constantsPerTask : Nat := 6500 - -private def addImport (name : Name) (constInfo : ConstantInfo) : - MetaM (Array (InitEntry (Name × DeclMod))) := - forallTelescope constInfo.type fun _ type => do - let e ← InitEntry.fromExpr type (name, DeclMod.none) - let a := #[e] - if e.key == .const ``Iff 2 then - let a := a.push (←e.mkSubEntry 0 (name, DeclMod.mp)) - let a := a.push (←e.mkSubEntry 1 (name, DeclMod.mpr)) - pure a - else - pure a - -/-- -Candidate finding function that uses strict discrimination tree for resolution. --/ -def mkImportFinder : IO CandidateFinder := do - let ref ← IO.mkRef none - pure fun ty => do - let importTree ← (←ref.get).getDM $ do - profileitM Exception "librarySearch launch" (←getOptions) $ - createImportedEnvironment (←getEnv) (constantsPerTask := constantsPerTask) addImport - let (imports, importTree) ← importTree.getMatch ty - ref.set importTree - pure imports - -end IncDiscrTreeFinder - -private unsafe def mkImportFinder : IO CandidateFinder := do - let path ← DiscrTreeFinder.cachePath - if ← path.pathExists then - let (imports, _) ← unpickle (DiscrTree (Name × DeclMod)) path - -- `DiscrTree.getMatch` returns results in batches, with more specific lemmas coming later. - -- Hence we reverse this list, so we try out more specific lemmas earlier. - pure <| DiscrTreeFinder.mkImportFinder {} imports - else do - IncDiscrTreeFinder.mkImportFinder - -/-- -The preferred candidate finding function. --/ -initialize defaultCandidateFinder : IO.Ref CandidateFinder ← unsafe do - IO.mkRef (←mkImportFinder) - -/-- -Update the candidate finder used by library search. --/ -def setDefaultCandidateFinder (cf : CandidateFinder) : IO Unit := - defaultCandidateFinder.set cf - -private def emoji (e:Except ε α) := if e.toBool then checkEmoji else crossEmoji - -/-- Create lemma from name and mod. -/ -def mkLibrarySearchLemma (lem : Name) (mod : DeclMod) : MetaM Expr := do - let lem ← mkConstWithFreshMVarLevels lem - match mod with - | .none => pure lem - | .mp => mapForallTelescope (fun e => mkAppM ``Iff.mp #[e]) lem - | .mpr => mapForallTelescope (fun e => mkAppM ``Iff.mpr #[e]) lem - -/-- -A library search candidate using symmetry includes the goal to solve, the metavar -context for that goal, and the name and orientation of a rule to try using with goal. --/ -@[reducible] -def Candidate := (MVarId × MetavarContext) × (Name × DeclMod) - -/-- -Try applying the given lemma (with symmetry modifier) to the goal, -then try to close subsequent goals using `solveByElim`. -If `solveByElim` succeeds, we return `[]` as the list of new subgoals, -otherwise the full list of subgoals. --/ -private def librarySearchLemma (cfg : ApplyConfig) (act : List MVarId → MetaM (List MVarId)) - (allowFailure : MVarId → MetaM Bool) (cand : Candidate) : MetaM (List MVarId) := do - let ((goal, mctx), (name, mod)) := cand - withTraceNode `Tactic.stdLibrarySearch (return m!"{emoji ·} trying {name} with {mod} ") do - setMCtx mctx - let lem ← mkLibrarySearchLemma name mod - let newGoals ← goal.apply lem cfg - try - act newGoals - catch _ => - if ← allowFailure goal then - pure newGoals - else - failure - -/-- -Interleave x y interleaves the elements of x and y until one is empty and then returns -final elements in other list. --/ -def interleaveWith {α β γ} (f : α → γ) (x : Array α) (g : β → γ) (y : Array β) : Array γ := - Id.run do - let mut res := Array.mkEmpty (x.size + y.size) - let n := min x.size y.size - for h : i in [0:n] do - have p : i < min x.size y.size := h.2 - have q : i < x.size := Nat.le_trans p (Nat.min_le_left ..) - have r : i < y.size := Nat.le_trans p (Nat.min_le_right ..) - res := res.push (f x[i]) - res := res.push (g y[i]) - let last := - if x.size > n then - (x.extract n x.size).map f - else - (y.extract n y.size).map g - pure $ res ++ last - -/-- -Run `searchFn` on both the goal and `symm` applied to the goal. --/ -def librarySearchSymm (searchFn : CandidateFinder) (goal : MVarId) : MetaM (Array Candidate) := do - let tgt ← goal.getType - let l1 ← searchFn tgt - let coreMCtx ← getMCtx - let coreGoalCtx := (goal, coreMCtx) - if let some symmGoal ← observing? goal.applySymm then - let newType ← instantiateMVars (← symmGoal.getType) - let l2 ← searchFn newType - let symmMCtx ← getMCtx - let symmGoalCtx := (symmGoal, symmMCtx) - setMCtx coreMCtx - pure $ interleaveWith (coreGoalCtx, ·) l1 (symmGoalCtx, ·) l2 - else - pure $ l1.map (coreGoalCtx, ·) - -/-- A type synonym for our subgoal ranking algorithm. -/ -def SubgoalRankType := Bool × Nat × Int - deriving ToString - -instance : Ord SubgoalRankType := - have : Ord (Nat × Int) := lexOrd - lexOrd - -/-- Count how many local hypotheses appear in an expression. -/ -def countLocalHypsUsed [Monad m] [MonadLCtx m] [MonadMCtx m] (e : Expr) : m Nat := do - let e' ← instantiateMVars e - return (← getLocalHyps).foldr (init := 0) fun h n => if h.occurs e' then n + 1 else n - -/-- Returns a tuple: -* are there no remaining goals? -* how many local hypotheses were used? -* how many goals remain, negated? - -Larger values (i.e. no remaining goals, more local hypotheses, fewer remaining goals) -are better. --/ -def subgoalRanking (goal : MVarId) (subgoals : List MVarId) : MetaM SubgoalRankType := do - return (subgoals.isEmpty, ← countLocalHypsUsed (.mvar goal), - subgoals.length) - -/-- -An exception Id that indicates further speculation on candidate lemmas should stop -and current results returned. --/ -private initialize abortSpeculationId : InternalExceptionId ← - registerInternalExceptionId `Std.Tactic.LibrarySearch.abortSpeculation - -/-- -Called to abort speculative execution in library search. --/ -def abortSpeculation [MonadExcept Exception m] : m α := - throw (Exception.internal abortSpeculationId {}) - -/-- Returns true if this is an abort speculation exception. -/ -def isAbortSpeculation : Exception → Bool -| .internal id _ => id == abortSpeculationId -| _ => false - -/-- -Sequentially invokes a tactic `act` on each value in candidates on the current state. - -The tactic `act` should return a list of meta-variables that still need to be resolved. -If this list is empty, then no variables remain to be solved, and `tryOnEach` returns -`none` with the environment set so each goal is resolved. - -If the action throws an internal exception with the `abortSpeculationId` id then -further computation is stopped and intermediate results returned. If any other -exception is thrown, then it is silently discarded. --/ -def tryOnEach - (act : Candidate → MetaM (List MVarId)) - (candidates : Array Candidate) : - MetaM (Option (Array (List MVarId × MetavarContext))) := do - let mut a := #[] - let s ← saveState - for c in candidates do - match ← (tryCatch (Except.ok <$> act c) (pure ∘ Except.error)) with - | .error e => - restoreState s - if isAbortSpeculation e then - break - | .ok remaining => - if remaining.isEmpty then - return none - let ctx ← getMCtx - restoreState s - a := a.push (remaining, ctx) - return (.some a) - -/-- -Return an action that returns true when the remaining heartbeats is less -than the currently remaining heartbeats * leavePercent / 100. --/ -def mkHeartbeatCheck (leavePercent : Nat) : MetaM (MetaM Bool) := do - let maxHB ← getMaxHeartbeats - let hbThreshold := (← getRemainingHeartbeats) * leavePercent / 100 - -- Return true if we should stop - pure $ - if maxHB = 0 then - pure false - else do - return (← getRemainingHeartbeats) < hbThreshold - -open SolveByElim - -/-- Shortcut for calling `solveByElim`. -/ -def solveByElim (required : List Expr) (exfalso : Bool) (goals : List MVarId) (maxDepth : Nat) := do - -- There is only a marginal decrease in performance for using the `symm` option for `solveByElim`. - -- (measured via `lake build && time lake env lean test/librarySearch.lean`). - let cfg : SolveByElimConfig := - { maxDepth, exfalso := exfalso, symm := true, commitIndependentGoals := true, - transparency := ← getTransparency, - -- `constructor` has been observed to significantly slow down `exact?` in Mathlib. - constructor := false } - let ⟨lemmas, ctx⟩ ← SolveByElim.mkAssumptionSet false false [] [] #[] - let cfg := if !required.isEmpty then cfg.requireUsingAll required else cfg - SolveByElim.solveByElim cfg lemmas ctx goals - -/-- State for resolving imports -/ -private def LibSearchState := IO.Ref (Option CandidateFinder) - -private initialize LibSearchState.default : IO.Ref (Option CandidateFinder) ← do - IO.mkRef .none - -private instance : Inhabited LibSearchState where - default := LibSearchState.default - -private initialize ext : EnvExtension LibSearchState ← - registerEnvExtension (IO.mkRef .none) - -private def librarySearchEmoji : Except ε (Option α) → String -| .error _ => bombEmoji -| .ok (some _) => crossEmoji -| .ok none => checkEmoji - -private def librarySearch' (goal : MVarId) - (tactic : List MVarId → MetaM (List MVarId)) - (allowFailure : MVarId → MetaM Bool) - (leavePercentHeartbeats : Nat) : - MetaM (Option (Array (List MVarId × MetavarContext))) := do - withTraceNode `Tactic.stdLibrarySearch (return m!"{librarySearchEmoji ·} {← goal.getType}") do - profileitM Exception "librarySearch" (← getOptions) do - let importFinder ← do - let r := ext.getState (←getEnv) - match ←r.get with - | .some f => pure f - | .none => - let f ← defaultCandidateFinder.get - r.set (.some f) - pure f - let searchFn (ty : Expr) := do - let localMap ← (← getEnv).constants.map₂.foldlM (init := {}) (DiscrTreeFinder.updateTree {}) - let locals := (← localMap.getMatch ty {}).reverse - pure <| locals ++ (← importFinder ty) - -- Create predicate that returns true when running low on heartbeats. - let shouldAbort ← mkHeartbeatCheck leavePercentHeartbeats - let candidates ← librarySearchSymm searchFn goal - let cfg : ApplyConfig := { allowSynthFailures := true } - let act := fun cand => do - if ←shouldAbort then - abortSpeculation - librarySearchLemma cfg tactic allowFailure cand - tryOnEach act candidates - -/-- -Try to solve the goal either by: -* calling `tactic true` -* or applying a library lemma then calling `tactic false` on the resulting goals. - -Typically here `tactic` is `solveByElim`, -with the `Bool` flag indicating whether it may retry with `exfalso`. - -If it successfully closes the goal, returns `none`. -Otherwise, it returns `some a`, where `a : Array (List MVarId × MetavarContext)`, -with an entry for each library lemma which was successfully applied, -containing a list of the subsidiary goals, and the metavariable context after the application. - -(Always succeeds, and the metavariable context stored in the monad is reverted, -unless the goal was completely solved.) - -(Note that if `solveByElim` solves some but not all subsidiary goals, -this is not currently tracked.) --/ -def librarySearch (goal : MVarId) - (tactic : Bool → List MVarId → MetaM (List MVarId)) - (allowFailure : MVarId → MetaM Bool := fun _ => pure true) - (leavePercentHeartbeats : Nat := 10) : - MetaM (Option (Array (List MVarId × MetavarContext))) := do - (tactic true [goal] *> pure none) <|> - librarySearch' goal (tactic false) allowFailure leavePercentHeartbeats - -open Lean.Parser.Tactic - --- TODO: implement the additional options for `library_search` from Lean 3, --- in particular including additional lemmas --- with `std_exact? [X, Y, Z]` or `std_exact? with attr`. - --- For now we only implement the basic functionality. --- The full syntax is recognized, but will produce a "Tactic has not been implemented" error. - -/-- Syntax for `std_exact?` -/ -syntax (name := std_exact?') "std_exact?" (config)? (simpArgs)? (" using " (colGt ident),+)? - ("=>" tacticSeq)? : tactic - -/-- Syntax for `std_apply?` -/ -syntax (name := std_apply?') "std_apply?" (config)? (simpArgs)? (" using " (colGt term),+)? : tactic - -open Elab.Tactic Elab Tactic -open Parser.Tactic (tacticSeq) - -/-- Implementation of the `exact?` tactic. -/ -def exact? (tk : Syntax) (required : Option (Array (TSyntax `term))) - (solver : Option (TSyntax `Lean.Parser.Tactic.tacticSeq)) (requireClose : Bool) : - TacticM Unit := do - let mvar ← getMainGoal - let (_, goal) ← (← getMainGoal).intros - goal.withContext do - let required := (← (required.getD #[]).mapM getFVarId).toList.map .fvar - let tactic ← - match solver with - | none => - pure (fun exfalso => solveByElim required (exfalso := exfalso) (maxDepth := 6)) - | some t => - let _ <- mkInitialTacticInfo t - throwError "Do not yet support custom std_exact?/std_apply? tactics." - let allowFailure := fun g => do - let g ← g.withContext (instantiateMVars (.mvar g)) - return required.all fun e => e.occurs g - match ← librarySearch goal tactic allowFailure with - -- Found goal that closed problem - | none => - addExactSuggestion tk (← instantiateMVars (mkMVar mvar)).headBeta - -- Found suggestions - | some suggestions => - if requireClose then throwError - "`std_exact?` could not close the goal. Try `std_apply?` to see partial suggestions." - reportOutOfHeartbeats `library_search tk - for (_, suggestionMCtx) in suggestions do - withMCtx suggestionMCtx do - addExactSuggestion tk (← instantiateMVars (mkMVar mvar)).headBeta (addSubgoalsMsg := true) - if suggestions.isEmpty then logError "std_apply? didn't find any relevant lemmas" - admitGoal goal - -elab_rules : tactic - | `(tactic| std_exact? $[using $[$lemmas],*]? $[=> $solver]?) => do - exact? (← getRef) lemmas solver true - -elab_rules : tactic | `(tactic| std_apply? $[using $[$required],*]?) => do - exact? (← getRef) required none false - ---/-- Deprecation warning for `library_search`. -/ ---elab tk:"library_search" : tactic => do --- logWarning ("`library_search` has been renamed to `apply?`" ++ --- " (or `exact?` if you only want solutions closing the goal)") --- exact? tk none false - -open Elab Term in -/-- Term elaborator using the `exact?` tactic. -/ -elab tk:"std_exact?%" : term <= expectedType => do - let goal ← mkFreshExprMVar expectedType - let (_, introdGoal) ← goal.mvarId!.intros - introdGoal.withContext do - let tactic := fun exfalso g => solveByElim [] (maxDepth := 6) exfalso g - if let some suggestions ← librarySearch introdGoal tactic then - reportOutOfHeartbeats `library_search tk - for suggestion in suggestions do - withMCtx suggestion.2 do - addTermSuggestion tk (← instantiateMVars goal).headBeta - if suggestions.isEmpty then logError "std_exact? didn't find any relevant lemmas" - mkSorry expectedType (synthetic := true) - else - addTermSuggestion tk (← instantiateMVars goal).headBeta - instantiateMVars goal diff --git a/lean-toolchain b/lean-toolchain index 63d320d43a..09c577cc33 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-22 +leanprover/lean4:nightly-2024-02-27 diff --git a/test/MLList.lean b/test/MLList.lean index eaf14cbc04..8473b08e8b 100644 --- a/test/MLList.lean +++ b/test/MLList.lean @@ -1,5 +1,4 @@ import Std.Data.MLList.IO -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/absurd.lean b/test/absurd.lean index dd0d4af4f8..9efe145830 100644 --- a/test/absurd.lean +++ b/test/absurd.lean @@ -1,5 +1,4 @@ import Std.Tactic.Basic -import Std.Tactic.GuardMsgs /-! Tests for `absurd` tactic -/ diff --git a/test/add_suggestion.lean b/test/add_suggestion.lean index 6604c092d9..c86c6a4c95 100644 --- a/test/add_suggestion.lean +++ b/test/add_suggestion.lean @@ -1,5 +1,4 @@ import Lean.Meta.Tactic.TryThis -import Std.Tactic.GuardMsgs set_option linter.unusedVariables false set_option linter.missingDocs false diff --git a/test/alias.lean b/test/alias.lean index 1f3e2e7dbe..0b8e125329 100644 --- a/test/alias.lean +++ b/test/alias.lean @@ -1,5 +1,4 @@ import Std.Tactic.Alias -import Std.Tactic.GuardMsgs set_option linter.unusedVariables false set_option linter.missingDocs false diff --git a/test/bitvec.lean b/test/bitvec.lean index e7a0d78617..4814fdd1a8 100644 --- a/test/bitvec.lean +++ b/test/bitvec.lean @@ -1,6 +1,6 @@ import Std.Data.BitVec -open Std.BitVec +open BitVec -- Basic arithmetic #guard 1#12 + 2#12 = 3#12 @@ -93,8 +93,6 @@ open Std.BitVec #guard extractLsb 7 4 0x1234#16 = 3 #guard extractLsb' 0 4 0x1234#16 = 0x4#4 -open Std - /-- This tests the match compiler with bitvector literals to ensure it can successfully generate a pattern for a bitvector literals. diff --git a/test/bitvec_simproc.lean b/test/bitvec_simproc.lean index b3c42ec12c..1013b41664 100644 --- a/test/bitvec_simproc.lean +++ b/test/bitvec_simproc.lean @@ -4,45 +4,45 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ import Std.Data.BitVec -open Std BitVec +open BitVec -example (h : x = (6 : Std.BitVec 3)) : x = -2 := by +example (h : x = (6 : BitVec 3)) : x = -2 := by simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (5 : Std.BitVec 3)) : x = ~~~2 := by +example (h : x = (5 : BitVec 3)) : x = ~~~2 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : Std.BitVec 32)) : x = BitVec.abs (-1#32) := by +example (h : x = (1 : BitVec 32)) : x = BitVec.abs (-1#32) := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (5 : Std.BitVec 3)) : x = 2 + 3 := by +example (h : x = (5 : BitVec 3)) : x = 2 + 3 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : Std.BitVec 3)) : x = 5 &&& 3 := by +example (h : x = (1 : BitVec 3)) : x = 5 &&& 3 := by simp; guard_target =ₛ x = 1#3; assumption -example (h : x = (7 : Std.BitVec 3)) : x = 5 ||| 3 := by +example (h : x = (7 : BitVec 3)) : x = 5 ||| 3 := by simp; guard_target =ₛ x = 7#3; assumption -example (h : x = (6 : Std.BitVec 3)) : x = 5 ^^^ 3 := by +example (h : x = (6 : BitVec 3)) : x = 5 ^^^ 3 := by simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (3 : Std.BitVec 32)) : x = 5 - 2 := by +example (h : x = (3 : BitVec 32)) : x = 5 - 2 := by simp; guard_target =ₛ x = 3#32; assumption -example (h : x = (10 : Std.BitVec 32)) : x = 5 * 2 := by +example (h : x = (10 : BitVec 32)) : x = 5 * 2 := by simp; guard_target =ₛ x = 10#32; assumption -example (h : x = (4 : Std.BitVec 32)) : x = 9 / 2 := by +example (h : x = (4 : BitVec 32)) : x = 9 / 2 := by simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = 9 % 2 := by +example (h : x = (1 : BitVec 32)) : x = 9 % 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : Std.BitVec 32)) : x = udiv 9 2 := by +example (h : x = (4 : BitVec 32)) : x = udiv 9 2 := by simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = umod 9 2 := by +example (h : x = (1 : BitVec 32)) : x = umod 9 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : Std.BitVec 32)) : x = sdiv (-9) (-2) := by +example (h : x = (4 : BitVec 32)) : x = sdiv (-9) (-2) := by simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = smod (-9) 2 := by +example (h : x = (1 : BitVec 32)) : x = smod (-9) 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = - smtUDiv 9 0 := by +example (h : x = (1 : BitVec 32)) : x = - smtUDiv 9 0 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = - srem (-9) 2 := by +example (h : x = (1 : BitVec 32)) : x = - srem (-9) 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = - smtSDiv 9 0 := by +example (h : x = (1 : BitVec 32)) : x = - smtSDiv 9 0 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = smtSDiv (-9) 0 := by +example (h : x = (1 : BitVec 32)) : x = smtSDiv (-9) 0 := by simp; guard_target =ₛ x = 1#32; assumption example (h : x = false) : x = (4#3).getLsb 0:= by simp; guard_target =ₛ x = false; assumption @@ -52,29 +52,29 @@ example (h : x = true) : x = (4#3).getMsb 0:= by simp; guard_target =ₛ x = true; assumption example (h : x = false) : x = (4#3).getMsb 2:= by simp; guard_target =ₛ x = false; assumption -example (h : x = (24 : Std.BitVec 32)) : x = 6#32 <<< 2 := by +example (h : x = (24 : BitVec 32)) : x = 6#32 <<< 2 := by simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = 6#32 >>> 2 := by +example (h : x = (1 : BitVec 32)) : x = 6#32 >>> 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (24 : Std.BitVec 32)) : x = BitVec.shiftLeft 6#32 2 := by +example (h : x = (24 : BitVec 32)) : x = BitVec.shiftLeft 6#32 2 := by simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : Std.BitVec 32)) : x = BitVec.ushiftRight 6#32 2 := by +example (h : x = (1 : BitVec 32)) : x = BitVec.ushiftRight 6#32 2 := by simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (2 : Std.BitVec 32)) : x = - BitVec.sshiftRight (- 6#32) 2 := by +example (h : x = (2 : BitVec 32)) : x = - BitVec.sshiftRight (- 6#32) 2 := by simp; guard_target =ₛ x = 2#32; assumption -example (h : x = (5 : Std.BitVec 3)) : x = BitVec.rotateLeft (6#3) 1 := by +example (h : x = (5 : BitVec 3)) : x = BitVec.rotateLeft (6#3) 1 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (3 : Std.BitVec 3)) : x = BitVec.rotateRight (6#3) 1 := by +example (h : x = (3 : BitVec 3)) : x = BitVec.rotateRight (6#3) 1 := by simp; guard_target =ₛ x = 3#3; assumption -example (h : x = (7 : Std.BitVec 5)) : x = 1#3 ++ 3#2 := by +example (h : x = (7 : BitVec 5)) : x = 1#3 ++ 3#2 := by simp; guard_target =ₛ x = 7#5; assumption -example (h : x = (1 : Std.BitVec 3)) : x = BitVec.cast (by decide : 3=2+1) 1#3 := by +example (h : x = (1 : BitVec 3)) : x = BitVec.cast (by decide : 3=2+1) 1#3 := by simp; guard_target =ₛ x = 1#3; assumption example (h : x = 5) : x = (2#3 + 3#3).toNat := by simp; guard_target =ₛ x = 5; assumption example (h : x = -1) : x = (2#3 - 3#3).toInt := by simp; guard_target =ₛ x = -1; assumption -example (h : x = (1 : Std.BitVec 3)) : x = -BitVec.ofInt 3 (-1) := by +example (h : x = (1 : BitVec 3)) : x = -BitVec.ofInt 3 (-1) := by simp; guard_target =ₛ x = 1#3; assumption example (h : x) : x = (1#3 < 3#3) := by simp; guard_target =ₛ x; assumption @@ -100,13 +100,13 @@ example (h : x) : x = (3#3 ≥ 1#3) := by simp; guard_target =ₛ x; assumption example (h : ¬x) : x = (3#3 ≥ 4#3) := by simp; guard_target =ₛ ¬x; assumption -example (h : x = (5 : Std.BitVec 7)) : x = (5#3).zeroExtend' (by decide) := by +example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend' (by decide) := by simp; guard_target =ₛ x = 5#7; assumption -example (h : x = (80 : Std.BitVec 7)) : x = (5#3).shiftLeftZeroExtend 4 := by +example (h : x = (80 : BitVec 7)) : x = (5#3).shiftLeftZeroExtend 4 := by simp; guard_target =ₛ x = 80#7; assumption -example (h : x = (5: Std.BitVec 3)) : x = (10#5).extractLsb' 1 3 := by +example (h : x = (5: BitVec 3)) : x = (10#5).extractLsb' 1 3 := by simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (9: Std.BitVec 6)) : x = (1#3).replicate 2 := by +example (h : x = (9: BitVec 6)) : x = (1#3).replicate 2 := by simp; guard_target =ₛ x = 9#6; assumption -example (h : x = (5 : Std.BitVec 7)) : x = (5#3).zeroExtend 7 := by +example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend 7 := by simp; guard_target =ₛ x = 5#7; assumption diff --git a/test/case.lean b/test/case.lean index 78b6fe5f43..f0bb9d9b5e 100644 --- a/test/case.lean +++ b/test/case.lean @@ -1,5 +1,4 @@ import Std.Tactic.Case -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/coe.lean b/test/coe.lean index 6a52129da0..2edede07ff 100644 --- a/test/coe.lean +++ b/test/coe.lean @@ -1,4 +1,4 @@ -import Std.Tactic.GuardMsgs +import Lean.Meta.CoeAttr set_option linter.missingDocs false diff --git a/test/conv_equals.lean b/test/conv_equals.lean index f646192acd..95ff7354f8 100644 --- a/test/conv_equals.lean +++ b/test/conv_equals.lean @@ -5,7 +5,6 @@ Authors: Joachim Breitner -/ import Std.Tactic.Basic -import Std.Tactic.GuardMsgs -- The example from the doc string, for quick comparision -- and keeping the doc up-to-date diff --git a/test/ext.lean b/test/ext.lean index 3e00798a7c..84f718d12f 100644 --- a/test/ext.lean +++ b/test/ext.lean @@ -1,5 +1,4 @@ import Std.Logic -import Std.Tactic.GuardMsgs set_option linter.missingDocs false axiom mySorry {α : Sort _} : α diff --git a/test/guard_msgs.lean b/test/guard_msgs.lean index 5a6b77e282..96d89f5aaa 100644 --- a/test/guard_msgs.lean +++ b/test/guard_msgs.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs #guard_msgs in /-- error: unknown identifier 'x' -/ diff --git a/test/instances.lean b/test/instances.lean index 220630ee12..ed1fd9698a 100644 --- a/test/instances.lean +++ b/test/instances.lean @@ -1,5 +1,4 @@ import Std.Tactic.Instances -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/isIndependentOf.lean b/test/isIndependentOf.lean index 7d0bff1c89..6ff9720bbf 100644 --- a/test/isIndependentOf.lean +++ b/test/isIndependentOf.lean @@ -1,6 +1,5 @@ import Std.Lean.Meta.Basic import Std.Tactic.PermuteGoals -import Std.Tactic.GuardMsgs import Lean.Meta.Tactic.IndependentOf open Lean Meta Elab.Tactic diff --git a/test/json.lean b/test/json.lean index 63df684c34..8755ab9126 100644 --- a/test/json.lean +++ b/test/json.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs import Lean.Data.Json.Elab /-- info: {"lookACalc": 131, diff --git a/test/kmp_matcher.lean b/test/kmp_matcher.lean index 600878c7e3..1b46841033 100644 --- a/test/kmp_matcher.lean +++ b/test/kmp_matcher.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs import Std.Data.String.Basic /-! Tests for Knuth-Morris-Pratt matching algorithm -/ diff --git a/test/left_right.lean b/test/left_right.lean index fcff731b06..cf65bee79c 100644 --- a/test/left_right.lean +++ b/test/left_right.lean @@ -1,4 +1,3 @@ -import Std.Tactic.GuardMsgs /-- Construct a natural number using `left`. -/ def zero : Nat := by diff --git a/test/library_search/basic.lean b/test/library_search/basic.lean index fc7c6ff9b2..4879724e05 100644 --- a/test/library_search/basic.lean +++ b/test/library_search/basic.lean @@ -22,106 +22,106 @@ noncomputable section /-- info: Try this: exact Nat.lt.base x -/ #guard_msgs in -example (x : Nat) : x ≠ x.succ := Nat.ne_of_lt (by std_apply?) +example (x : Nat) : x ≠ x.succ := Nat.ne_of_lt (by apply?) /-- info: Try this: exact Nat.zero_lt_succ 1 -/ #guard_msgs in -example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by std_apply?) +example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by apply?) example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by exact Fin.size_pos') /-- info: Try this: exact Nat.add_comm x y -/ #guard_msgs in -example (x y : Nat) : x + y = y + x := by std_apply? +example (x y : Nat) : x + y = y + x := by apply? /-- info: Try this: exact fun a => Nat.add_le_add_right a k -/ #guard_msgs in -example (n m k : Nat) : n ≤ m → n + k ≤ m + k := by std_apply? +example (n m k : Nat) : n ≤ m → n + k ≤ m + k := by apply? /-- info: Try this: exact Nat.mul_dvd_mul_left a w -/ #guard_msgs in -example (ha : a > 0) (w : b ∣ c) : a * b ∣ a * c := by std_apply? +example (ha : a > 0) (w : b ∣ c) : a * b ∣ a * c := by apply? -- Could be any number of results (`Int.one`, `Int.zero`, etc) #guard_msgs (drop info) in -example : Int := by std_apply? +example : Int := by apply? /-- info: Try this: Nat.lt.base x -/ #guard_msgs in -example : x < x + 1 := std_exact?% +example : x < x + 1 := exact?% /-- info: Try this: exact p -/ #guard_msgs in -example (P : Prop) (p : P) : P := by std_apply? +example (P : Prop) (p : P) : P := by apply? /-- info: Try this: exact False.elim (np p) -/ #guard_msgs in -example (P : Prop) (p : P) (np : ¬P) : false := by std_apply? +example (P : Prop) (p : P) (np : ¬P) : false := by apply? /-- info: Try this: exact h x rfl -/ #guard_msgs in -example (X : Type) (P : Prop) (x : X) (h : ∀ x : X, x = x → P) : P := by std_apply? +example (X : Type) (P : Prop) (x : X) (h : ∀ x : X, x = x → P) : P := by apply? -- Could be any number of results (`fun x => x`, `id`, etc) #guard_msgs (drop info) in -example (α : Prop) : α → α := by std_apply? +example (α : Prop) : α → α := by apply? -- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example (p : Prop) : (¬¬p) → p := by std_apply? -- says: `exact not_not.mp` --- example (a b : Prop) (h : a ∧ b) : a := by std_apply? -- says: `exact h.left` --- example (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by std_apply? -- say: `exact Function.mtr` +-- example (p : Prop) : (¬¬p) → p := by apply? -- says: `exact not_not.mp` +-- example (a b : Prop) (h : a ∧ b) : a := by apply? -- says: `exact h.left` +-- example (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by apply? -- say: `exact Function.mtr` /-- info: Try this: exact Nat.add_comm a b -/ #guard_msgs in example (a b : Nat) : a + b = b + a := -by std_apply? +by apply? /-- info: Try this: exact Nat.mul_sub_left_distrib n m k -/ #guard_msgs in example (n m k : Nat) : n * (m - k) = n * m - n * k := -by std_apply? +by apply? attribute [symm] Eq.symm /-- info: Try this: exact Eq.symm (Nat.mul_sub_left_distrib n m k) -/ #guard_msgs in example (n m k : Nat) : n * m - n * k = n * (m - k) := by - std_apply? + apply? /-- info: Try this: exact eq_comm -/ #guard_msgs in -example {α : Type} (x y : α) : x = y ↔ y = x := by std_apply? +example {α : Type} (x y : α) : x = y ↔ y = x := by apply? /-- info: Try this: exact Nat.add_pos_left ha b -/ #guard_msgs in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by std_apply? +example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? /-- info: Try this: exact Nat.add_pos_left ha b -/ #guard_msgs in -- Verify that if maxHeartbeats is 0 we don't stop immediately. set_option maxHeartbeats 0 in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by std_apply? +example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? section synonym /-- info: Try this: exact Nat.add_pos_left ha b -/ #guard_msgs in -example (a b : Nat) (ha : a > 0) (_hb : 0 < b) : 0 < a + b := by std_apply? +example (a b : Nat) (ha : a > 0) (_hb : 0 < b) : 0 < a + b := by apply? /-- info: Try this: exact Nat.le_of_dvd w h -/ #guard_msgs in example (a b : Nat) (h : a ∣ b) (w : b > 0) : a ≤ b := -by std_apply? +by apply? /-- info: Try this: exact Nat.le_of_dvd w h -/ #guard_msgs in -example (a b : Nat) (h : a ∣ b) (w : b > 0) : b ≥ a := by std_apply? +example (a b : Nat) (h : a ∣ b) (w : b > 0) : b ≥ a := by apply? -- TODO: A lemma with head symbol `¬` can be used to prove `¬ p` or `⊥` /-- info: Try this: exact Nat.not_lt_zero a -/ #guard_msgs in -example (a : Nat) : ¬ (a < 0) := by std_apply? +example (a : Nat) : ¬ (a < 0) := by apply? /-- info: Try this: exact Nat.not_succ_le_zero a h -/ #guard_msgs in -example (a : Nat) (h : a < 0) : False := by std_apply? +example (a : Nat) (h : a < 0) : False := by apply? -- An inductive type hides the constructor's arguments enough -- so that `apply?` doesn't accidentally close the goal. @@ -137,60 +137,60 @@ theorem lemma_with_false_in_head (a b : Nat) (_h1 : a < b) (h2 : P a) : False := /-- info: Try this: exact lemma_with_gt_in_head a h -/ #guard_msgs in -example (a : Nat) (h : P a) : 0 > a := by std_apply? +example (a : Nat) (h : P a) : 0 > a := by apply? /-- info: Try this: exact lemma_with_gt_in_head a h -/ #guard_msgs in -example (a : Nat) (h : P a) : a < 0 := by std_apply? +example (a : Nat) (h : P a) : a < 0 := by apply? /-- info: Try this: exact lemma_with_false_in_head a b h1 h2 -/ #guard_msgs in -example (a b : Nat) (h1 : a < b) (h2 : P a) : False := by std_apply? +example (a b : Nat) (h1 : a < b) (h2 : P a) : False := by apply? -- TODO this no longer works: --- example (a b : Nat) (h1 : a < b) : ¬ (P a) := by std_apply? -- says `exact lemma_with_false_in_head a b h1` +-- example (a b : Nat) (h1 : a < b) : ¬ (P a) := by apply? -- says `exact lemma_with_false_in_head a b h1` end synonym /-- info: Try this: exact fun P => iff_not_self -/ #guard_msgs in -example : ∀ P : Prop, ¬(P ↔ ¬P) := by std_apply? +example : ∀ P : Prop, ¬(P ↔ ¬P) := by apply? -- We even find `iff` results: /-- info: Try this: exact (Nat.dvd_add_iff_left h₁).mpr h₂ -/ #guard_msgs in -example {a b c : Nat} (h₁ : a ∣ c) (h₂ : a ∣ b + c) : a ∣ b := by std_apply? +example {a b c : Nat} (h₁ : a ∣ c) (h₂ : a ∣ b + c) : a ∣ b := by apply? -- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example {α : Sort u} (h : Empty) : α := by std_apply? -- says `exact Empty.elim h` --- example (f : A → C) (g : B → C) : (A ⊕ B) → C := by std_apply? -- says `exact Sum.elim f g` --- example (n : Nat) (r : ℚ) : ℚ := by std_apply? using n, r -- exact nsmulRec n r +-- example {α : Sort u} (h : Empty) : α := by apply? -- says `exact Empty.elim h` +-- example (f : A → C) (g : B → C) : (A ⊕ B) → C := by apply? -- says `exact Sum.elim f g` +-- example (n : Nat) (r : ℚ) : ℚ := by apply? using n, r -- exact nsmulRec n r opaque f : Nat → Nat axiom F (a b : Nat) : f a ≤ f b ↔ a ≤ b /-- info: Try this: exact (F a b).mpr h -/ #guard_msgs in -example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by std_apply? +example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by apply? /-- info: Try this: exact List.join L -/ #guard_msgs in -example (L : List (List Nat)) : List Nat := by std_apply? using L +example (L : List (List Nat)) : List Nat := by apply? using L -- Could be any number of results #guard_msgs (drop info) in -example (P _Q : List Nat) (h : Nat) : List Nat := by std_apply? using h, P +example (P _Q : List Nat) (h : Nat) : List Nat := by apply? using h, P -- Could be any number of results #guard_msgs (drop info) in example (l : List α) (f : α → β ⊕ γ) : List β × List γ := by - std_apply? using f -- partitionMap f l + apply? using f -- partitionMap f l -- Could be any number of results (`Nat.mul n m`, `Nat.add n m`, etc) #guard_msgs (drop info) in -example (n m : Nat) : Nat := by std_apply? using n, m +example (n m : Nat) : Nat := by apply? using n, m #guard_msgs (drop info) in -example (P Q : List Nat) (_h : Nat) : List Nat := by std_exact? using P, Q +example (P Q : List Nat) (_h : Nat) : List Nat := by exact? using P, Q -- Check that we don't use sorryAx: -- (see https://github.com/leanprover-community/mathlib4/issues/226) @@ -200,7 +200,7 @@ theorem Bool_eq_iff {A B : Bool} : (A = B) = (A ↔ B) := /-- info: Try this: exact Bool_eq_iff -/ #guard_msgs in theorem Bool_eq_iff2 {A B : Bool} : (A = B) = (A ↔ B) := by - std_apply? -- exact Bool_eq_iff + apply? -- exact Bool_eq_iff -- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/library_search.20regression/near/354025788 -- Disabled for Std @@ -213,17 +213,17 @@ theorem Bool_eq_iff2 {A B : Bool} : (A = B) = (A ↔ B) := by -- /-- info: Try this: exact Iff.symm Nat.prime_iff -/ --#guard_msgs in --example (n : Nat) : Prime n ↔ Nat.Prime n := by --- std_exact? +-- exact? -- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/exact.3F.20recent.20regression.3F/near/387691588 -- Disabled for Std --lemma ex' (x : Nat) (_h₁ : x = 0) (h : 2 * 2 ∣ x) : 2 ∣ x := by --- std_exact? says exact dvd_of_mul_left_dvd h +-- exact? says exact dvd_of_mul_left_dvd h -- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/apply.3F.20failure/near/402534407 -- Disabled for Std --example (P Q : Prop) (h : P → Q) (h' : ¬Q) : ¬P := by --- std_exact? says exact mt h h' +-- exact? says exact mt h h' -- Removed until we come up with a way of handling nonspecific lemmas -- that does not pollute the output or cause too much slow-down. @@ -242,11 +242,11 @@ warning: declaration uses 'sorry' -/ #guard_msgs in example {x : Int} (h : x ≠ 0) : 2 * x ≠ 0 := by - std_apply? using h + apply? using h -- Check that adding `with_reducible` prevents expensive kernel reductions. -- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/.60exact.3F.60.20failure.3A.20.22maximum.20recursion.20depth.20has.20been.20reached.22/near/417649319 /-- info: Try this: exact Nat.add_comm n m -/ #guard_msgs in example (_h : List.range 10000 = List.range 10000) (n m : Nat) : n + m = m + n := by - with_reducible std_exact? + with_reducible exact? diff --git a/test/lintTC.lean b/test/lintTC.lean index 9a2afb7e29..deee02378c 100644 --- a/test/lintTC.lean +++ b/test/lintTC.lean @@ -1,5 +1,5 @@ import Std.Tactic.Lint.TypeClass -import Std.Tactic.GuardMsgs +import Lean.Elab.Command open Std.Tactic.Lint diff --git a/test/lint_unreachableTactic.lean b/test/lint_unreachableTactic.lean index 00501d85ae..86938a12f9 100644 --- a/test/lint_unreachableTactic.lean +++ b/test/lint_unreachableTactic.lean @@ -1,5 +1,4 @@ import Std.Linter.UnreachableTactic -import Std.Tactic.GuardMsgs /-- warning: this tactic is never executed [linter.unreachableTactic] -/ #guard_msgs in diff --git a/test/lintsimp.lean b/test/lintsimp.lean index 9098b613d8..41bd091192 100644 --- a/test/lintsimp.lean +++ b/test/lintsimp.lean @@ -1,5 +1,4 @@ import Std.Tactic.Lint -import Std.Tactic.GuardMsgs open Std.Tactic.Lint set_option linter.missingDocs false @@ -48,10 +47,10 @@ section def MyPred (_ : Nat → Nat) : Prop := True @[simp] theorem bad1 (f : Unit → Nat → Nat) : MyPred (f ()) ↔ True := by - rw [MyPred]; exact Iff.rfl + rw [MyPred] @[simp] theorem bad2 (f g : Nat → Nat) : MyPred (fun x => f (g x)) ↔ True := by - rw [MyPred]; exact Iff.rfl + rw [MyPred] -- Note, this is not a proper regression test because #671 depends on how the `MetaM` is -- executed, and `run_meta` sets the options appropriately. But setting the config diff --git a/test/lintunused.lean b/test/lintunused.lean index a917c0e9e6..b236ec97ea 100644 --- a/test/lintunused.lean +++ b/test/lintunused.lean @@ -1,5 +1,4 @@ import Std.Tactic.Lint -import Std.Tactic.GuardMsgs -- should be ignored as the proof contains sorry /-- warning: declaration uses 'sorry' -/ diff --git a/test/nondet.lean b/test/nondet.lean index 3bc2d94856..66f3022e08 100644 --- a/test/nondet.lean +++ b/test/nondet.lean @@ -1,5 +1,4 @@ import Std.Control.Nondet.Basic -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/print_prefix.lean b/test/print_prefix.lean index a80badc41b..9f742b382a 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -1,5 +1,4 @@ import Std.Tactic.PrintPrefix -import Std.Tactic.GuardMsgs inductive TEmpty : Type /-- diff --git a/test/register_label_attr.lean b/test/register_label_attr.lean index 9b0e66c846..c10279bd18 100644 --- a/test/register_label_attr.lean +++ b/test/register_label_attr.lean @@ -1,5 +1,4 @@ import Std.Test.Internal.DummyLabelAttr -import Std.Tactic.GuardMsgs import Lean.LabelAttribute set_option linter.missingDocs false diff --git a/test/repeat.lean b/test/repeat.lean index 009fd16841..276e283f8f 100644 --- a/test/repeat.lean +++ b/test/repeat.lean @@ -1,5 +1,4 @@ import Std.Tactic.Basic -import Std.Tactic.GuardMsgs open Lean Elab Tactic Meta diff --git a/test/run_cmd.lean b/test/run_cmd.lean index acb2e24065..a3b649e5e0 100644 --- a/test/run_cmd.lean +++ b/test/run_cmd.lean @@ -1,5 +1,5 @@ import Lean.Elab.Tactic.ElabTerm -import Std.Tactic.GuardMsgs +import Lean.Elab.Command open Lean Elab Tactic diff --git a/test/show_term.lean b/test/show_term.lean index 25b6aacb1d..922e034238 100644 --- a/test/show_term.lean +++ b/test/show_term.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Tactic.ShowTerm -import Std.Tactic.GuardMsgs /-- info: Try this: exact (n, 37) -/ #guard_msgs in example (n : Nat) : Nat × Nat := by diff --git a/test/simp_trace.lean b/test/simp_trace.lean index 2e700e2fae..b3cefc454c 100644 --- a/test/simp_trace.lean +++ b/test/simp_trace.lean @@ -1,5 +1,4 @@ import Std.Tactic.SqueezeScope -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/simpa.lean b/test/simpa.lean index fe1b4e702d..065e3b8328 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Gabriel Ebner -/ import Std.Tactic.ShowTerm -import Std.Tactic.GuardMsgs set_option linter.missingDocs false diff --git a/test/tryThis.lean b/test/tryThis.lean index e616193b62..c17a64c287 100644 --- a/test/tryThis.lean +++ b/test/tryThis.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 Thomas Murrills. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Murrills -/ -import Std.Tactic.GuardMsgs import Lean.Meta.Tactic.TryThis open Lean.Meta.Tactic.TryThis diff --git a/test/where.lean b/test/where.lean index 5ec9cc4300..8c005997ca 100644 --- a/test/where.lean +++ b/test/where.lean @@ -1,5 +1,4 @@ import Std.Tactic.Where -import Std.Tactic.GuardMsgs -- Return to pristine state set_option linter.missingDocs false From 67ab85ef7ba80ca10fafc255fd3c99f1084b81f1 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 10:46:54 +1100 Subject: [PATCH 101/213] delete librarySearch test; it's in Lean --- test/library_search/basic.lean | 252 --------------------------------- 1 file changed, 252 deletions(-) delete mode 100644 test/library_search/basic.lean diff --git a/test/library_search/basic.lean b/test/library_search/basic.lean deleted file mode 100644 index 4879724e05..0000000000 --- a/test/library_search/basic.lean +++ /dev/null @@ -1,252 +0,0 @@ -import Std -set_option autoImplicit true - --- Enable this option for tracing: --- set_option trace.Tactic.stdLibrarySearch true --- And this option to trace all candidate lemmas before application. --- set_option trace.Tactic.stdLibrarySearch.lemmas true - --- Many of the tests here are quite volatile, --- and when changes are made to `solve_by_elim` or `exact?`, --- or the library itself, the printed messages change. --- Hence many of the tests here use `#guard_msgs (drop info)`, --- and do not actually verify the particular output, just that `exact?` succeeds. --- We keep the most recent output as a comment --- (not a doc-comment: so `#guard_msgs` doesn't check it) --- for reference. --- If you find further tests failing please: --- 1. update the comment using the code action on `#guard_msgs` --- 2. (optional) add `(drop info)` after `#guard_msgs` and change the doc-comment to a comment - -noncomputable section - -/-- info: Try this: exact Nat.lt.base x -/ -#guard_msgs in -example (x : Nat) : x ≠ x.succ := Nat.ne_of_lt (by apply?) - -/-- info: Try this: exact Nat.zero_lt_succ 1 -/ -#guard_msgs in -example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by apply?) - -example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by exact Fin.size_pos') - -/-- info: Try this: exact Nat.add_comm x y -/ -#guard_msgs in -example (x y : Nat) : x + y = y + x := by apply? - -/-- info: Try this: exact fun a => Nat.add_le_add_right a k -/ -#guard_msgs in -example (n m k : Nat) : n ≤ m → n + k ≤ m + k := by apply? - -/-- info: Try this: exact Nat.mul_dvd_mul_left a w -/ -#guard_msgs in -example (ha : a > 0) (w : b ∣ c) : a * b ∣ a * c := by apply? - --- Could be any number of results (`Int.one`, `Int.zero`, etc) -#guard_msgs (drop info) in -example : Int := by apply? - -/-- info: Try this: Nat.lt.base x -/ -#guard_msgs in -example : x < x + 1 := exact?% - -/-- info: Try this: exact p -/ -#guard_msgs in -example (P : Prop) (p : P) : P := by apply? -/-- info: Try this: exact False.elim (np p) -/ -#guard_msgs in -example (P : Prop) (p : P) (np : ¬P) : false := by apply? -/-- info: Try this: exact h x rfl -/ -#guard_msgs in -example (X : Type) (P : Prop) (x : X) (h : ∀ x : X, x = x → P) : P := by apply? - --- Could be any number of results (`fun x => x`, `id`, etc) -#guard_msgs (drop info) in -example (α : Prop) : α → α := by apply? - --- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example (p : Prop) : (¬¬p) → p := by apply? -- says: `exact not_not.mp` --- example (a b : Prop) (h : a ∧ b) : a := by apply? -- says: `exact h.left` --- example (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by apply? -- say: `exact Function.mtr` - -/-- info: Try this: exact Nat.add_comm a b -/ -#guard_msgs in -example (a b : Nat) : a + b = b + a := -by apply? - -/-- info: Try this: exact Nat.mul_sub_left_distrib n m k -/ -#guard_msgs in -example (n m k : Nat) : n * (m - k) = n * m - n * k := -by apply? - -attribute [symm] Eq.symm - -/-- info: Try this: exact Eq.symm (Nat.mul_sub_left_distrib n m k) -/ -#guard_msgs in -example (n m k : Nat) : n * m - n * k = n * (m - k) := by - apply? - -/-- info: Try this: exact eq_comm -/ -#guard_msgs in -example {α : Type} (x y : α) : x = y ↔ y = x := by apply? - -/-- info: Try this: exact Nat.add_pos_left ha b -/ -#guard_msgs in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? - -/-- info: Try this: exact Nat.add_pos_left ha b -/ -#guard_msgs in --- Verify that if maxHeartbeats is 0 we don't stop immediately. -set_option maxHeartbeats 0 in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? - -section synonym - -/-- info: Try this: exact Nat.add_pos_left ha b -/ -#guard_msgs in -example (a b : Nat) (ha : a > 0) (_hb : 0 < b) : 0 < a + b := by apply? - -/-- info: Try this: exact Nat.le_of_dvd w h -/ -#guard_msgs in -example (a b : Nat) (h : a ∣ b) (w : b > 0) : a ≤ b := -by apply? - -/-- info: Try this: exact Nat.le_of_dvd w h -/ -#guard_msgs in -example (a b : Nat) (h : a ∣ b) (w : b > 0) : b ≥ a := by apply? - --- TODO: A lemma with head symbol `¬` can be used to prove `¬ p` or `⊥` -/-- info: Try this: exact Nat.not_lt_zero a -/ -#guard_msgs in -example (a : Nat) : ¬ (a < 0) := by apply? -/-- info: Try this: exact Nat.not_succ_le_zero a h -/ -#guard_msgs in -example (a : Nat) (h : a < 0) : False := by apply? - --- An inductive type hides the constructor's arguments enough --- so that `apply?` doesn't accidentally close the goal. -inductive P : Nat → Prop - | gt_in_head {n : Nat} : n < 0 → P n - --- This lemma with `>` as its head symbol should also be found for goals with head symbol `<`. -theorem lemma_with_gt_in_head (a : Nat) (h : P a) : 0 > a := by cases h; assumption - --- This lemma with `false` as its head symbols should also be found for goals with head symbol `¬`. -theorem lemma_with_false_in_head (a b : Nat) (_h1 : a < b) (h2 : P a) : False := by - apply Nat.not_lt_zero; cases h2; assumption - -/-- info: Try this: exact lemma_with_gt_in_head a h -/ -#guard_msgs in -example (a : Nat) (h : P a) : 0 > a := by apply? -/-- info: Try this: exact lemma_with_gt_in_head a h -/ -#guard_msgs in -example (a : Nat) (h : P a) : a < 0 := by apply? - -/-- info: Try this: exact lemma_with_false_in_head a b h1 h2 -/ -#guard_msgs in -example (a b : Nat) (h1 : a < b) (h2 : P a) : False := by apply? - --- TODO this no longer works: --- example (a b : Nat) (h1 : a < b) : ¬ (P a) := by apply? -- says `exact lemma_with_false_in_head a b h1` - -end synonym - -/-- info: Try this: exact fun P => iff_not_self -/ -#guard_msgs in -example : ∀ P : Prop, ¬(P ↔ ¬P) := by apply? - --- We even find `iff` results: -/-- info: Try this: exact (Nat.dvd_add_iff_left h₁).mpr h₂ -/ -#guard_msgs in -example {a b c : Nat} (h₁ : a ∣ c) (h₂ : a ∣ b + c) : a ∣ b := by apply? - --- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example {α : Sort u} (h : Empty) : α := by apply? -- says `exact Empty.elim h` --- example (f : A → C) (g : B → C) : (A ⊕ B) → C := by apply? -- says `exact Sum.elim f g` --- example (n : Nat) (r : ℚ) : ℚ := by apply? using n, r -- exact nsmulRec n r - -opaque f : Nat → Nat -axiom F (a b : Nat) : f a ≤ f b ↔ a ≤ b - -/-- info: Try this: exact (F a b).mpr h -/ -#guard_msgs in -example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by apply? - -/-- info: Try this: exact List.join L -/ -#guard_msgs in -example (L : List (List Nat)) : List Nat := by apply? using L - --- Could be any number of results -#guard_msgs (drop info) in -example (P _Q : List Nat) (h : Nat) : List Nat := by apply? using h, P - --- Could be any number of results -#guard_msgs (drop info) in -example (l : List α) (f : α → β ⊕ γ) : List β × List γ := by - apply? using f -- partitionMap f l - --- Could be any number of results (`Nat.mul n m`, `Nat.add n m`, etc) -#guard_msgs (drop info) in -example (n m : Nat) : Nat := by apply? using n, m - -#guard_msgs (drop info) in -example (P Q : List Nat) (_h : Nat) : List Nat := by exact? using P, Q - --- Check that we don't use sorryAx: --- (see https://github.com/leanprover-community/mathlib4/issues/226) -theorem Bool_eq_iff {A B : Bool} : (A = B) = (A ↔ B) := - by (cases A <;> cases B <;> simp) - -/-- info: Try this: exact Bool_eq_iff -/ -#guard_msgs in -theorem Bool_eq_iff2 {A B : Bool} : (A = B) = (A ↔ B) := by - apply? -- exact Bool_eq_iff - --- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/library_search.20regression/near/354025788 --- Disabled for Std ---/-- info: Try this: exact surjective_quot_mk r -/ ---#guard_msgs in ---example {r : α → α → Prop} : Function.Surjective (Quot.mk r) := by exact? - --- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/library_search.20failing.20to.20apply.20symm --- Disabled for Std --- /-- info: Try this: exact Iff.symm Nat.prime_iff -/ ---#guard_msgs in ---example (n : Nat) : Prime n ↔ Nat.Prime n := by --- exact? - --- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/exact.3F.20recent.20regression.3F/near/387691588 --- Disabled for Std ---lemma ex' (x : Nat) (_h₁ : x = 0) (h : 2 * 2 ∣ x) : 2 ∣ x := by --- exact? says exact dvd_of_mul_left_dvd h - --- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/apply.3F.20failure/near/402534407 --- Disabled for Std ---example (P Q : Prop) (h : P → Q) (h' : ¬Q) : ¬P := by --- exact? says exact mt h h' - --- Removed until we come up with a way of handling nonspecific lemmas --- that does not pollute the output or cause too much slow-down. --- -- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/Exact.3F.20fails.20on.20le_antisymm/near/388993167 --- set_option linter.unreachableTactic false in --- example {x y : ℝ} (hxy : x ≤ y) (hyx : y ≤ x) : x = y := by --- -- This example non-deterministically picks between `le_antisymm hxy hyx` and `ge_antisymm hyx hxy`. --- first --- | exact? says exact le_antisymm hxy hyx --- | exact? says exact ge_antisymm hyx hxy - -/-- -info: Try this: refine Int.mul_ne_zero ?a0 h ---- -warning: declaration uses 'sorry' --/ -#guard_msgs in -example {x : Int} (h : x ≠ 0) : 2 * x ≠ 0 := by - apply? using h - --- Check that adding `with_reducible` prevents expensive kernel reductions. --- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/.60exact.3F.60.20failure.3A.20.22maximum.20recursion.20depth.20has.20been.20reached.22/near/417649319 -/-- info: Try this: exact Nat.add_comm n m -/ -#guard_msgs in -example (_h : List.range 10000 = List.range 10000) (n m : Nat) : n + m = m + n := by - with_reducible exact? From 946e6f87d48e9b2105e52f8366509f30d6e666a0 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 10:50:51 +1100 Subject: [PATCH 102/213] remove tests already in Lean --- test/bitvec_simproc.lean | 112 --------------------------------------- 1 file changed, 112 deletions(-) delete mode 100644 test/bitvec_simproc.lean diff --git a/test/bitvec_simproc.lean b/test/bitvec_simproc.lean deleted file mode 100644 index 1013b41664..0000000000 --- a/test/bitvec_simproc.lean +++ /dev/null @@ -1,112 +0,0 @@ -/- -Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura --/ -import Std.Data.BitVec -open BitVec - -example (h : x = (6 : BitVec 3)) : x = -2 := by - simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (5 : BitVec 3)) : x = ~~~2 := by - simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : BitVec 32)) : x = BitVec.abs (-1#32) := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (5 : BitVec 3)) : x = 2 + 3 := by - simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : BitVec 3)) : x = 5 &&& 3 := by - simp; guard_target =ₛ x = 1#3; assumption -example (h : x = (7 : BitVec 3)) : x = 5 ||| 3 := by - simp; guard_target =ₛ x = 7#3; assumption -example (h : x = (6 : BitVec 3)) : x = 5 ^^^ 3 := by - simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (3 : BitVec 32)) : x = 5 - 2 := by - simp; guard_target =ₛ x = 3#32; assumption -example (h : x = (10 : BitVec 32)) : x = 5 * 2 := by - simp; guard_target =ₛ x = 10#32; assumption -example (h : x = (4 : BitVec 32)) : x = 9 / 2 := by - simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : BitVec 32)) : x = 9 % 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : BitVec 32)) : x = udiv 9 2 := by - simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : BitVec 32)) : x = umod 9 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : BitVec 32)) : x = sdiv (-9) (-2) := by - simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : BitVec 32)) : x = smod (-9) 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : BitVec 32)) : x = - smtUDiv 9 0 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : BitVec 32)) : x = - srem (-9) 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : BitVec 32)) : x = - smtSDiv 9 0 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : BitVec 32)) : x = smtSDiv (-9) 0 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = false) : x = (4#3).getLsb 0:= by - simp; guard_target =ₛ x = false; assumption -example (h : x = true) : x = (4#3).getLsb 2:= by - simp; guard_target =ₛ x = true; assumption -example (h : x = true) : x = (4#3).getMsb 0:= by - simp; guard_target =ₛ x = true; assumption -example (h : x = false) : x = (4#3).getMsb 2:= by - simp; guard_target =ₛ x = false; assumption -example (h : x = (24 : BitVec 32)) : x = 6#32 <<< 2 := by - simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : BitVec 32)) : x = 6#32 >>> 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (24 : BitVec 32)) : x = BitVec.shiftLeft 6#32 2 := by - simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : BitVec 32)) : x = BitVec.ushiftRight 6#32 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (2 : BitVec 32)) : x = - BitVec.sshiftRight (- 6#32) 2 := by - simp; guard_target =ₛ x = 2#32; assumption -example (h : x = (5 : BitVec 3)) : x = BitVec.rotateLeft (6#3) 1 := by - simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (3 : BitVec 3)) : x = BitVec.rotateRight (6#3) 1 := by - simp; guard_target =ₛ x = 3#3; assumption -example (h : x = (7 : BitVec 5)) : x = 1#3 ++ 3#2 := by - simp; guard_target =ₛ x = 7#5; assumption -example (h : x = (1 : BitVec 3)) : x = BitVec.cast (by decide : 3=2+1) 1#3 := by - simp; guard_target =ₛ x = 1#3; assumption -example (h : x = 5) : x = (2#3 + 3#3).toNat := by - simp; guard_target =ₛ x = 5; assumption -example (h : x = -1) : x = (2#3 - 3#3).toInt := by - simp; guard_target =ₛ x = -1; assumption -example (h : x = (1 : BitVec 3)) : x = -BitVec.ofInt 3 (-1) := by - simp; guard_target =ₛ x = 1#3; assumption -example (h : x) : x = (1#3 < 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : x) : x = (BitVec.ult 1#3 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : ¬x) : x = (4#3 < 3#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : x) : x = (BitVec.slt (- 4#3) 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : x) : x = (BitVec.sle (- 4#3) 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : x) : x = (3#3 > 1#3) := by - simp; guard_target =ₛ x; assumption -example (h : ¬x) : x = (3#3 > 4#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : x) : x = (1#3 ≤ 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : ¬x) : x = (4#3 ≤ 3#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : ¬x) : x = (BitVec.ule 4#3 3#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : x) : x = (3#3 ≥ 1#3) := by - simp; guard_target =ₛ x; assumption -example (h : ¬x) : x = (3#3 ≥ 4#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend' (by decide) := by - simp; guard_target =ₛ x = 5#7; assumption -example (h : x = (80 : BitVec 7)) : x = (5#3).shiftLeftZeroExtend 4 := by - simp; guard_target =ₛ x = 80#7; assumption -example (h : x = (5: BitVec 3)) : x = (10#5).extractLsb' 1 3 := by - simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (9: BitVec 6)) : x = (1#3).replicate 2 := by - simp; guard_target =ₛ x = 9#6; assumption -example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend 7 := by - simp; guard_target =ₛ x = 5#7; assumption From 9a2342bb9d2f76005e3d46073746a659d2470d48 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 10:53:33 +1100 Subject: [PATCH 103/213] remove test already moved to Lean --- test/coe.lean | 70 --------------------------------------------------- 1 file changed, 70 deletions(-) delete mode 100644 test/coe.lean diff --git a/test/coe.lean b/test/coe.lean deleted file mode 100644 index 2edede07ff..0000000000 --- a/test/coe.lean +++ /dev/null @@ -1,70 +0,0 @@ -import Lean.Meta.CoeAttr - -set_option linter.missingDocs false - -structure WrappedNat where - val : Nat - - -structure WrappedFun (α) where - fn : Nat → α - - -structure WrappedType where - typ : Type - -attribute [coe] WrappedNat.val -instance : Coe WrappedNat Nat where coe := WrappedNat.val - -#eval Lean.Meta.registerCoercion ``WrappedFun.fn (some ⟨2, 1, .coeFun⟩) -instance : CoeFun (WrappedFun α) (fun _ => Nat → α) where coe := WrappedFun.fn - -#eval Lean.Meta.registerCoercion ``WrappedType.typ (some ⟨1, 0, .coeSort⟩) -instance : CoeSort WrappedType Type where coe := WrappedType.typ - -section coe -variable (n : WrappedNat) - -/-- info: ↑n : Nat -/ -#guard_msgs in #check n.val -/-- info: ↑n : Nat -/ -#guard_msgs in #check (↑n : Nat) - -end coe - -section coeFun -variable (f : WrappedFun Nat) (g : Nat → WrappedFun Nat) (h : WrappedFun (WrappedFun Nat)) - -/-- info: ⇑f : Nat → Nat -/ -#guard_msgs in #check f.fn -/-- info: ⇑f : Nat → Nat -/ -#guard_msgs in #check ⇑f --- applied functions do not need the `⇑` -/-- info: f 1 : Nat -/ -#guard_msgs in #check ⇑f 1 - -/-- info: ⇑(g 1) : Nat → Nat -/ -#guard_msgs in #check ⇑(g 1) -/-- info: (g 1) 2 : Nat -/ -- TODO: remove the `()`? -#guard_msgs in #check g 1 2 - -/-- info: ⇑h : Nat → WrappedFun Nat -/ -#guard_msgs in #check ⇑h -/-- info: h 1 : WrappedFun Nat -/ -#guard_msgs in #check h 1 -/-- info: ⇑(h 1) : Nat → Nat -/ -#guard_msgs in #check ⇑(h 1) -/-- info: (h 1) 2 : Nat -/ -- TODO: remove the `()`? -#guard_msgs in #check h 1 2 - -end coeFun - -section coeSort -variable (t : WrappedType) - -/-- info: ↥t : Type -/ -#guard_msgs in #check t.typ -/-- info: ↥t : Type -/ -#guard_msgs in #check ↥t - -end coeSort From a6501eeef4dc0ebcdffe348917997da9306dde32 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 10:55:33 +1100 Subject: [PATCH 104/213] migrate tests in https://github.com/leanprover/lean4/pull/3535 --- test/add_suggestion.lean | 45 --------------- test/bitvec.lean | 118 --------------------------------------- test/change.lean | 80 -------------------------- 3 files changed, 243 deletions(-) delete mode 100644 test/add_suggestion.lean delete mode 100644 test/bitvec.lean delete mode 100644 test/change.lean diff --git a/test/add_suggestion.lean b/test/add_suggestion.lean deleted file mode 100644 index c86c6a4c95..0000000000 --- a/test/add_suggestion.lean +++ /dev/null @@ -1,45 +0,0 @@ -import Lean.Meta.Tactic.TryThis - -set_option linter.unusedVariables false -set_option linter.missingDocs false - -section width --- here we test that the width of try this suggestions is not too big - --- simulate a long and complicated term -def longdef (a b : Nat) (h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h : a = b) : - 2 * a = 2 * b := by rw [h] - -namespace Lean.Meta.Tactic.TryThis -open Lean Elab Tactic - -set_option hygiene false in -elab "test" : tactic => do - addSuggestion (← getRef) (← - `(tactic| exact longdef a b h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h)) - -end Lean.Meta.Tactic.TryThis - -#guard_msgs (drop info, drop warning) in --- ideally we would have a #guard_widgets or #guard_infos too, but instead we can simply check by --- hand that the widget suggestion (not the message) fits into 100 columns -theorem asda (a b : Nat) (h : a = b) : 2 * a = 2 * b := by - test ---exact --- longdef a b h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h --- h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h --- h h h h h - have : 2 * a = 2 * b := by - test --- exact --- longdef a b h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h --- h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h --- h h h h h h h - sorry - sorry diff --git a/test/bitvec.lean b/test/bitvec.lean deleted file mode 100644 index 4814fdd1a8..0000000000 --- a/test/bitvec.lean +++ /dev/null @@ -1,118 +0,0 @@ -import Std.Data.BitVec - -open BitVec - --- Basic arithmetic -#guard 1#12 + 2#12 = 3#12 -#guard 3#5 * 7#5 = 0x15#5 -#guard 3#4 * 7#4 = 0x05#4 - -#guard zeroExtend 4 0x7f#8 = 0xf#4 -#guard zeroExtend 12 0x7f#8 = 0x07f#12 -#guard zeroExtend 12 0x80#8 = 0x080#12 -#guard zeroExtend 16 0xff#8 = 0x00ff#16 - -#guard signExtend 4 0x7f#8 = 0xf#4 -#guard signExtend 12 0x7f#8 = 0x07f#12 -#guard signExtend 12 0x80#8 = 0xf80#12 -#guard signExtend 16 0xff#8 = 0xffff#16 - --- Division and mod/rem - -#guard 3#4 / 0 = 0 -#guard 10#4 / 2 = 5 - -#guard 8#4 % 0 = 8 -#guard 4#4 % 1 = 0 -#guard 4#4 % 3 = 1 -#guard 0xf#4 % (-2) = 1 -#guard 0xf#4 % (-8) = 7 - -#guard sdiv 6#4 2 = 3#4 -#guard sdiv 7#4 2 = 3#4 -#guard sdiv 6#4 (-2) = -3#4 -#guard sdiv 7#4 (-2) = -3#4 -#guard sdiv (-6#4) 2 = -3#4 -#guard sdiv (-7#4) 2 = -3#4 -#guard sdiv (-6#4) (-2) = 3#4 -#guard sdiv (-7#4) (-2) = 3#4 - -#guard srem 3#4 2 = 1 -#guard srem (-4#4) 3 = -1 -#guard srem ( 4#4) (-3) = 1 -#guard srem (-4#4) (-3) = -1 - -#guard smod 3#4 2 = 1 -#guard smod (-4#4) 3 = 2 -#guard smod ( 4#4) (-3) = -2 -#guard smod (-4#4) (-3) = -1 - --- ofInt/toInt - -#guard .ofInt 3 (-1) = 0b111#3 -#guard .ofInt 3 0 = 0b000#3 -#guard .ofInt 3 4 = 0b100#3 -#guard .ofInt 3 (-2) = 0b110#3 -#guard .ofInt 3 (-4) = 0b100#3 - -#guard (0x0#4).toInt = 0 -#guard (0x7#4).toInt = 7 -#guard (0x8#4).toInt = -8 -#guard (0xe#4).toInt = -2 - --- Bitwise operations - -#guard ~~~0b1010#4 = 0b0101#4 -#guard 0b1010#4 &&& 0b0110#4 = 0b0010#4 -#guard 0b1010#4 ||| 0b0110#4 = 0b1110#4 -#guard 0b1010#4 ^^^ 0b0110#4 = 0b1100#4 - --- shift operations -#guard 0b0011#4 <<< 3 = 0b1000 -#guard 0b1011#4 >>> 1 = 0b0101 -#guard sshiftRight 0b1001#4 1 = 0b1100#4 -#guard rotateLeft 0b0011#4 3 = 0b1001 -#guard rotateRight 0b0010#4 2 = 0b1000 -#guard 0xab#8 ++ 0xcd#8 = 0xabcd#16 - --- get/extract - -#guard !getMsb 0b0101#4 0 -#guard getMsb 0b0101#4 1 -#guard !getMsb 0b0101#4 2 -#guard getMsb 0b0101#4 3 -#guard !getMsb 0b1111#4 4 - -#guard getLsb 0b0101#4 0 -#guard !getLsb 0b0101#4 1 -#guard getLsb 0b0101#4 2 -#guard !getLsb 0b0101#4 3 -#guard !getLsb 0b1111#4 4 - -#guard extractLsb 3 0 0x1234#16 = 4 -#guard extractLsb 7 4 0x1234#16 = 3 -#guard extractLsb' 0 4 0x1234#16 = 0x4#4 - -/-- -This tests the match compiler with bitvector literals to ensure -it can successfully generate a pattern for a bitvector literals. - -This fixes a regression introduced in PR #366. --/ -def testMatch8 (i : BitVec 32) := - let op1 := i.extractLsb 28 25 - match op1 with - | 0b1000#4 => some 0 - | _ => none - --- Pretty-printing - -#guard toString 5#12 = "0x005#12" -#guard toString 5#13 = "0x0005#13" -#guard toString 5#12 = "0x005#12" -#guard toString 5#13 = "0x0005#13" - --- Simp - -example (n w : Nat) (p : n < 2^w) : { toFin := { val := n, isLt := p } : BitVec w} = .ofNat w n := by - simp only [ofFin_eq_ofNat] diff --git a/test/change.lean b/test/change.lean deleted file mode 100644 index 04fa47c287..0000000000 --- a/test/change.lean +++ /dev/null @@ -1,80 +0,0 @@ - -private axiom test_sorry : ∀ {α}, α - -set_option linter.missingDocs false -set_option autoImplicit true - -example : n + 2 = m := by - change n + 1 + 1 = _ - guard_target =ₛ n + 1 + 1 = m - exact test_sorry - -example (h : n + 2 = m) : False := by - change _ + 1 = _ at h - guard_hyp h :ₛ n + 1 + 1 = m - exact test_sorry - -example : n + 2 = m := by - fail_if_success change true - fail_if_success change _ + 3 = _ - fail_if_success change _ * _ = _ - change (_ : Nat) + _ = _ - exact test_sorry - --- `change ... at ...` allows placeholders to mean different things at different hypotheses -example (h : n + 3 = m) (h' : n + 2 = m) : False := by - change _ + 1 = _ at h h' - guard_hyp h :ₛ n + 2 + 1 = m - guard_hyp h' :ₛ n + 1 + 1 = m - exact test_sorry - --- `change ... at ...` preserves dependencies -example (p : n + 2 = m → Type) (h : n + 2 = m) (x : p h) : false := by - change _ + 1 = _ at h - guard_hyp x :ₛ p h - exact test_sorry - -noncomputable example : Nat := by - fail_if_success change Type 1 - exact test_sorry - -def foo (a b c : Nat) := if a < b then c else 0 - -example : foo 1 2 3 = 3 := by - change (if _ then _ else _) = _ - change ite _ _ _ = _ - change (if _ < _ then _ else _) = _ - change _ = (if true then 3 else 4) - rfl - -example (h : foo 1 2 3 = 4) : True := by - change ite _ _ _ = _ at h - guard_hyp h :ₛ ite (1 < 2) 3 0 = 4 - trivial - -example (h : foo 1 2 3 = 4) : True := by - change (if _ then _ else _) = _ at h - guard_hyp h : (if 1 < 2 then 3 else 0) = 4 - trivial - -example (α : Type) [LT α] (x : α) (h : x < x) : x < id x := by - change _ < _ -- can defer LT typeclass lookup, just like `show` - change _ < _ at h -- can defer LT typeclass lookup at h too - guard_target =ₛ x < id x - change _ < x - guard_target =ₛ x < x - exact h - --- This example shows using named and anonymous placeholders to create a new goal. -example (x y : Nat) (h : x = y) : True := by - change (if 1 < 2 then x else ?z + ?_) = y at h - rotate_left - · exact 4 - · exact 37 - guard_hyp h : (if 1 < 2 then x else 4 + 37) = y - · trivial - -example : let x := 22; let y : Nat := x; let z : Fin (y + 1) := 0; z.1 < y + 1 := by - intro x y z -- `z` was previously erroneously marked as unused - change _ at y - exact z.2 From 0de6b50d853076642d7d8be8c3f53028623761c6 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 14:58:49 +1100 Subject: [PATCH 105/213] deleted tests upstreamed in https://github.com/leanprover/lean4/pull/3539 --- test/decidability.lean | 7 - test/ext.lean | 107 ----------- test/guard_msgs.lean | 52 ------ test/guardexpr.lean | 59 ------ test/int.lean | 15 -- test/json.lean | 22 --- test/left_right.lean | 66 ------- test/norm_cast.lean | 56 +----- test/omega/examples.lean | 57 ------ test/omega/test.lean | 382 --------------------------------------- test/rcases.lean | 211 --------------------- test/repeat.lean | 12 -- test/replace.lean | 50 ----- test/run_cmd.lean | 15 -- test/solve_by_elim.lean | 130 ------------- test/symm.lean | 27 --- 16 files changed, 1 insertion(+), 1267 deletions(-) delete mode 100644 test/decidability.lean delete mode 100644 test/ext.lean delete mode 100644 test/guard_msgs.lean delete mode 100644 test/guardexpr.lean delete mode 100644 test/int.lean delete mode 100644 test/json.lean delete mode 100644 test/left_right.lean delete mode 100644 test/omega/examples.lean delete mode 100644 test/omega/test.lean delete mode 100644 test/rcases.lean delete mode 100644 test/repeat.lean delete mode 100644 test/replace.lean delete mode 100644 test/run_cmd.lean delete mode 100644 test/symm.lean diff --git a/test/decidability.lean b/test/decidability.lean deleted file mode 100644 index 4b14856db7..0000000000 --- a/test/decidability.lean +++ /dev/null @@ -1,7 +0,0 @@ -import Std.Data.Nat.Lemmas - --- Prior to leanprover/lean4#2552 there was a performance trap --- depending on the implementation details in `decidableBallLT`. --- We keep this example (which would have gone over maxHeartbeats) --- as a regression test for the instance. -example : ∀ m, m < 25 → ∀ n, n < 25 → ∀ c, c < 25 → m ^ 2 + n ^ 2 + c ^ 2 ≠ 7 := by decide diff --git a/test/ext.lean b/test/ext.lean deleted file mode 100644 index 84f718d12f..0000000000 --- a/test/ext.lean +++ /dev/null @@ -1,107 +0,0 @@ -import Std.Logic - -set_option linter.missingDocs false -axiom mySorry {α : Sort _} : α - -structure A (n : Nat) where - a : Nat - -example (a b : A n) : a = b ∨ True := by - fail_if_success - apply Or.inl; ext - exact Or.inr trivial - -structure B (n) extends A n where - b : Nat - h : b > 0 - i : Fin b - -@[ext] structure C (n) extends B n where - c : Nat - -example (a b : C n) : a = b := by - ext - guard_target = a.a = b.a; exact mySorry - guard_target = a.b = b.b; exact mySorry - guard_target = HEq a.i b.i; exact mySorry - guard_target = a.c = b.c; exact mySorry - -@[ext (flat := false)] structure C' (n) extends B n where - c : Nat - -example (a b : C' n) : a = b := by - ext - guard_target = a.toB = b.toB; exact mySorry - guard_target = a.c = b.c; exact mySorry - -example (f g : Nat × Nat → Nat) : f = g := by - ext ⟨x, y⟩ - guard_target = f (x, y) = g (x, y); exact mySorry - --- Check that we generate a warning if there are too many patterns. -/-- warning: `ext` did not consume the patterns: [j] [linter.unusedRCasesPattern] -/ -#guard_msgs in -example (f g : Nat → Nat) (h : f = g) : f = g := by - ext i j - exact h ▸ rfl - --- allow more specific ext theorems -@[ext high] theorem Fin.zero_ext (a b : Fin 0) : True → a = b := by cases a.isLt -example (a b : Fin 0) : a = b := by ext; exact True.intro - -def Set (α : Type u) := α → Prop -@[ext] structure LocalEquiv (α : Type u) (β : Type v) where - source : Set α -@[ext] structure Pretrivialization {F : Type u} (proj : Z → β) extends LocalEquiv Z (β × F) where - baseSet : Set β - source_eq : source = baseSet ∘ proj - -structure MyUnit - -@[ext high] theorem MyUnit.ext1 (x y : MyUnit) (_h : 0 = 1) : x = y := rfl -@[ext high] theorem MyUnit.ext2 (x y : MyUnit) (_h : 1 = 1) : x = y := rfl -@[ext] theorem MyUnit.ext3 (x y : MyUnit) (_h : 2 = 1) : x = y := rfl - -example (x y : MyUnit) : x = y := by ext; rfl - --- Check that we don't generate a warning when `x` only uses a pattern in one branch: -example (f : ℕ × (ℕ → ℕ)) : f = f := by - ext x - · rfl - · guard_target = (f.2) x = (f.2) x - rfl - -example (f : Empty → Empty) : f = f := by - ext ⟨⟩ - -@[ext] theorem ext_intros {n m : Nat} (w : ∀ n m : Nat, n = m) : n = m := by apply w - -#guard_msgs (drop warning) in -example : 3 = 7 := by - ext : 1 - rename_i n m - guard_target = n = m - admit - -#guard_msgs (drop warning) in -example : 3 = 7 := by - ext n m : 1 - guard_target = n = m - admit - -section erasing_ext_attribute - -def f (p : Int × Int) : Int × Int := (p.2, p.1) - -example : f ∘ f = id := by - ext ⟨a, b⟩ - · simp [f] - · simp [f] - -attribute [-ext] Prod.ext - -example : f ∘ f = id := by - ext ⟨a, b⟩ - simp [f] - -end erasing_ext_attribute diff --git a/test/guard_msgs.lean b/test/guard_msgs.lean deleted file mode 100644 index 96d89f5aaa..0000000000 --- a/test/guard_msgs.lean +++ /dev/null @@ -1,52 +0,0 @@ - -#guard_msgs in -/-- error: unknown identifier 'x' -/ -#guard_msgs in -example : α := x - -/-- -error: unknown identifier 'x' ---- -error: ❌ Docstring on `#guard_msgs` does not match generated message: - -error: unknown identifier 'x' --/ -#guard_msgs in -#guard_msgs in -example : α := x - -#guard_msgs in -/-- warning: declaration uses 'sorry' -/ -#guard_msgs in -example : α := sorry - -#guard_msgs in -/-- warning: declaration uses 'sorry' -/ -#guard_msgs(warning) in -example : α := sorry - -/-- warning: declaration uses 'sorry' -/ -#guard_msgs in -#guard_msgs(error) in -example : α := sorry - -#guard_msgs in -#guard_msgs(drop warning) in -example : α := sorry - -#guard_msgs in -#guard_msgs(error, drop warning) in -example : α := sorry - -#guard_msgs in -/-- error: unknown identifier 'x' -/ -#guard_msgs(error, drop warning) in -example : α := x - -#guard_msgs in -/-- -error: failed to synthesize instance - OfNat α 22 --/ -#guard_msgs(error) in -example : α := 22 diff --git a/test/guardexpr.lean b/test/guardexpr.lean deleted file mode 100644 index caee2e81df..0000000000 --- a/test/guardexpr.lean +++ /dev/null @@ -1,59 +0,0 @@ -import Std.Tactic.Basic - -example (n : Nat) : Nat := by - guard_hyp n :ₛ Nat - let m : Nat := 1 - guard_expr 1 =ₛ (by exact 1) - fail_if_success guard_expr 1 = (by exact 2) - guard_hyp m := 1 - guard_hyp m : (fun x => x) Nat :=~ id 1 - guard_target = Nat - have : 1 = 1 := by conv => - guard_hyp m := 1 - guard_expr ‹Nat› = m - fail_if_success guard_target = 1 - lhs - guard_target = 1 - exact 0 - --- Now with a generic type to test that default instances work correctly -example [∀ n, OfNat α n] (n : α) : α := by - guard_hyp n - fail_if_success guard_hyp m - guard_hyp n :ₛ α - let q : α := 1 - guard_expr (1 : α) =ₛ 1 - fail_if_success guard_expr 1 =ₛ (2 : α) - fail_if_success guard_expr 1 =ₛ (by exact (2 : α)) - guard_hyp q := 1 - guard_hyp q : α := 1 - guard_hyp q : (fun x => x) α :=~ id 1 - guard_target = α - have : (1 : α) = 1 := by conv => - guard_hyp q := 1 - guard_expr ‹α› = q - fail_if_success guard_target = 1 - lhs - guard_target = 1 - exact 0 - -#guard_expr 1 = 1 -#guard_expr 1 =ₛ 1 -#guard_expr 2 = 1 + 1 - -section -variable {α : Type} [∀ n, OfNat α n] -#guard_expr (1 : α) = 1 -end - -#guard true -#guard 2 == 1 + 1 -#guard 2 = 1 + 1 - -instance (p : Bool → Prop) [DecidablePred p] : Decidable (∀ b, p b) := - if h : p false ∧ p true then - isTrue (by { intro b; cases h; cases b <;> assumption }) - else - isFalse (by { intro h'; simp [h'] at h }) - -#guard ∀ (b : Bool), b = !!b diff --git a/test/int.lean b/test/int.lean deleted file mode 100644 index 65397bfaca..0000000000 --- a/test/int.lean +++ /dev/null @@ -1,15 +0,0 @@ - --- complement -#guard ~~~(-1:Int) = 0 -#guard ~~~(0:Int) = -1 -#guard ~~~(1:Int) = -2 -#guard ~~~(-2:Int) = 1 - --- shiftRight -#guard (2:Int) >>> 1 = 1 -#guard (0:Int) >>> 1 = 0 -#guard ~~~(1:Int) >>> 1 = ~~~0 -#guard ~~~(0:Int) >>> 1 = ~~~0 -#guard ~~~(2:Int) >>> 1 = ~~~1 -#guard ~~~(4:Int) >>> 1 = ~~~2 -#guard ~~~(4:Int) >>> 2 = ~~~1 diff --git a/test/json.lean b/test/json.lean deleted file mode 100644 index 8755ab9126..0000000000 --- a/test/json.lean +++ /dev/null @@ -1,22 +0,0 @@ -import Lean.Data.Json.Elab - -/-- info: {"lookACalc": 131, - "lemonCount": 100000000000000000000000000000000, - "isCool": true, - "isBug": null, - "hello": "world", - "cheese": ["edam", "cheddar", {"rank": 100.2, "kind": "spicy"}]}-/ -#guard_msgs in -#eval json% { - hello : "world", - cheese : ["edam", "cheddar", {kind : "spicy", rank : 100.2}], - lemonCount : 100e30, - isCool : true, - isBug : null, - lookACalc: $(23 + 54 * 2) -} - --- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/json.20elaborator -example : Lean.Json := Id.run do - let _x := true - return json% {"x" : 1} diff --git a/test/left_right.lean b/test/left_right.lean deleted file mode 100644 index cf65bee79c..0000000000 --- a/test/left_right.lean +++ /dev/null @@ -1,66 +0,0 @@ - -/-- Construct a natural number using `left`. -/ -def zero : Nat := by - left - -example : zero = 0 := rfl - -/-- Construct a natural number using `right`. -/ -def two : Nat := by - right - exact 1 - -example : two = 2 := rfl - -set_option linter.missingDocs false - -/-- -error: tactic 'left' failed, -left tactic works for inductive types with exactly 2 constructors -⊢ Unit --/ -#guard_msgs in -example : Unit := by - left - -inductive F -| a | b | c - -/-- -error: tactic 'left' failed, -left tactic works for inductive types with exactly 2 constructors -⊢ F --/ -#guard_msgs in -example : F := by - left - -def G := Nat - -/-- Look through definitions. -/ -example : G := by - left - -/-- -error: tactic 'left' failed, target is not an inductive datatype -⊢ Type --/ -#guard_msgs in -example : Type := by - left - -example : Sum Nat (List Nat) := by - left - exact zero - -example : Sum Nat (List Nat) := by - right - exact [0] - -example : (1 = 1) ∨ (2 = 3) := by - left - rfl - -example : (1 = 2) ∨ (3 = 3) := by - right - rfl diff --git a/test/norm_cast.lean b/test/norm_cast.lean index ea57642f1b..956faedd97 100644 --- a/test/norm_cast.lean +++ b/test/norm_cast.lean @@ -1,77 +1,23 @@ import Std.Data.Rat.Lemmas /-! -# Tests for norm_cast +# Tests for norm_cast involving `Rat`. -/ - set_option linter.missingDocs false -- set_option trace.Meta.Tactic.simp true -variable (an bn cn dn : Nat) (az bz cz dz : Int) variable (aq bq cq dq : Rat) -example : (an : Int) = bn → an = bn := by intro h; exact_mod_cast h -example : an = bn → (an : Int) = bn := by intro h; exact_mod_cast h example : az = bz ↔ (az : Rat) = bz := by norm_cast -example : (an : Int) < bn ↔ an < bn := by norm_cast -example : (an : Int) ≠ (bn : Int) ↔ an ≠ bn := by norm_cast - -- zero and one cause special problems -example : az > (1 : Nat) ↔ az > 1 := by norm_cast -example : az > (0 : Nat) ↔ az > 0 := by norm_cast -example : (an : Int) ≠ 0 ↔ an ≠ 0 := by norm_cast example : aq < (1 : Nat) ↔ (aq : Rat) < (1 : Int) := by norm_cast -example (a b : Nat) (h : False) : (a : Int) < ((2 * b : Nat) : Int) := by - push_cast - guard_target = (a : Int) < 2 * (b : Int) - cases h - -example : (an : Int) + bn = (an + bn : Nat) := by norm_cast - -example (h : ((an + bn : Nat) : Int) = (an : Int) + (bn : Int)) : True := by - push_cast at h - guard_hyp h : (an : Int) + (bn : Int) = (an : Int) + (bn : Int) - trivial - -example (h : ((an * bn : Nat) : Int) = (an : Int) * (bn : Int)) : True := by - push_cast at h - guard_hyp h : (an : Int) * (bn : Int) = (an : Int) * (bn : Int) - trivial - --testing numerals -example : ((42 : Nat) : Int) = 42 := by norm_cast example : ((42 : Nat) : Rat) = 42 := by norm_cast example : ((42 : Int) : Rat) = 42 := by norm_cast -structure p (n : Int) -example : p 42 := by - norm_cast - guard_target = p 42 - exact ⟨⟩ - -- We don't yet have `{n m : Int} : (↑n : Rat) ≤ ↑m ↔ n ≤ m` in Std -- example (n : Int) (h : n + 1 > 0) : ((n + 1 : Int) : Rat) > 0 := by exact_mod_cast h - -example : an + bn = 1 ↔ (an + bn : Int) = 1 := by norm_cast - -example (h : bn ≤ an) : an - bn = 1 ↔ (an - bn : Int) = 1 := by norm_cast - -example (k : Nat) {x y : Nat} (h : ((x + y + k : Nat) : Int) = 0) : x + y + k = 0 := by - push_cast at h - guard_hyp h : (x : Int) + y + k = 0 - assumption_mod_cast - -example (a b : Nat) (h2 : ((a + b + 0 : Nat) : Int) = 10) : - ((a + b : Nat) : Int) = 10 := by - push_cast - push_cast [Int.add_zero] at h2 - exact h2 - -theorem b (_h g : true) : true ∧ true := by - constructor - assumption_mod_cast - assumption_mod_cast diff --git a/test/omega/examples.lean b/test/omega/examples.lean deleted file mode 100644 index 8e6603435e..0000000000 --- a/test/omega/examples.lean +++ /dev/null @@ -1,57 +0,0 @@ - --- Turn on `trace.omega` to get detailed information about the processing of hypotheses, --- and the justification of the contradiction found. --- set_option trace.omega true - --- Inequalities -example {x y : Nat} (_ : x + y > 10) (_ : x < 5) (_ : y < 5) : False := by omega - --- Tightening inequalities over `Int` or `Nat` -example {x y : Nat} (_ : x + y > 10) (_ : 2 * x < 11) (_ : y < 5) : False := by omega - --- GCDs not dividing constant terms -example {x y : Nat} (_ : 2 * x + 4 * y = 5) : False := by omega - --- Eliminating variables even when no coefficient is ±1 -example {x y : Nat} (_ : 6 * x + 7 * y = 5) : False := by omega - --- Case bashing on `Nat.sub` -example {x y z : Nat} (_ : x - y - z = 0) (_ : x > y + z) : False := by omega - --- Division with constant denominators -example {x y : Nat} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 4) : False := by omega - --- Annoying casts -example {x : Nat} : 1 < (1 + ((x + 1 : Nat) : Int) + 2) / 2 := by omega - --- Divisibility -example {x : Nat} (_ : 10000 ∣ x) (_ : ¬ 100 ∣ x) : False := by omega - --- Mod -example (x : Nat) : x % 1024 - x % 2048 = 0 := by omega - --- Systems of equations -example (a b c d e : Int) - (ha : 2 * a + b + c + d + e = 4) - (hb : a + 2 * b + c + d + e = 5) - (hc : a + b + 2 * c + d + e = 6) - (hd : a + b + c + 2 * d + e = 7) - (he : a + b + c + d + 2 * e = 8) : e = 3 := by omega - --- Case bashing on disjunctions -example (a b c d e : Int) - (ha : 2 * a + b + c + d + e = 4) - (hb : a + 2 * b + c + d + e = 5) - (hc : a + b + 2 * c + d + e = 6) - (hd : a + b + c + 2 * d + e = 7) - (he : a + b + c + d + 2 * e = 8 ∨ e = 3) : e = 3 := by omega - --- Case bashing conjunctions in the goal -example (ε : Int) (_ : ε > 0) : (ε - 2 ≤ ε / 3 + ε / 2 + ε / 2) ∧ (ε / 3 + ε / 4 + ε / 5 ≤ ε) := by - omega - --- Fast results with duplicated hypotheses -example {x : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : 2 * x + 1 ≤ 0) : False := by - iterate 64 have := h₁ - iterate 64 have := h₂ - omega diff --git a/test/omega/test.lean b/test/omega/test.lean deleted file mode 100644 index 3e136fb1fa..0000000000 --- a/test/omega/test.lean +++ /dev/null @@ -1,382 +0,0 @@ - -example : True := by - fail_if_success omega - trivial - --- set_option trace.omega true -example (_ : (1 : Int) < (0 : Int)) : False := by omega - -example (_ : (0 : Int) < (0 : Int)) : False := by omega -example (_ : (0 : Int) < (1 : Int)) : True := by (fail_if_success omega); trivial - -example {x : Int} (_ : 0 ≤ x) (_ : x ≤ 1) : True := by (fail_if_success omega); trivial -example {x : Int} (_ : 0 ≤ x) (_ : x ≤ -1) : False := by omega - -example {x : Int} (_ : x % 2 < x - 2 * (x / 2)) : False := by omega -example {x : Int} (_ : x % 2 > 5) : False := by omega - -example {x : Int} (_ : 2 * (x / 2) > x) : False := by omega -example {x : Int} (_ : 2 * (x / 2) ≤ x - 2) : False := by omega - -example {x : Nat} : x / 0 = 0 := by omega -example {x : Int} : x / 0 = 0 := by omega - -example {x : Int} : x / 2 + x / (-2) = 0 := by omega - -example {x : Nat} (_ : x ≠ 0) : 0 < x := by omega - -example {x y z : Nat} (_ : a ≤ c) (_ : b ≤ c) : a < Nat.succ c := by omega - -example (_ : 7 < 3) : False := by omega -example (_ : 0 < 0) : False := by omega - -example {x : Nat} (_ : x > 7) (_ : x < 3) : False := by omega -example {x : Nat} (_ : x ≥ 7) (_ : x ≤ 3) : False := by omega - -example {x y : Nat} (_ : x + y > 10) (_ : x < 5) (_ : y < 5) : False := by omega - -example {x y : Int} (_ : x + y > 10) (_ : 2 * x < 11) (_ : y < 5) : False := by omega -example {x y : Nat} (_ : x + y > 10) (_ : 2 * x < 11) (_ : y < 5) : False := by omega - -example {x y : Int} (_ : 2 * x + 4 * y = 5) : False := by omega -example {x y : Nat} (_ : 2 * x + 4 * y = 5) : False := by omega - -example {x y : Int} (_ : 6 * x + 7 * y = 5) : True := by (fail_if_success omega); trivial - -example {x y : Nat} (_ : 6 * x + 7 * y = 5) : False := by omega - -example {x y : Nat} (_ : x * 6 + y * 7 = 5) : False := by omega -example {x y : Nat} (_ : 2 * (3 * x) + y * 7 = 5) : False := by omega -example {x y : Nat} (_ : 2 * x * 3 + y * 7 = 5) : False := by omega -example {x y : Nat} (_ : 2 * 3 * x + y * 7 = 5) : False := by omega - -example {x : Nat} (_ : x < 0) : False := by omega - -example {x y z : Int} (_ : x + y > z) (_ : x < 0) (_ : y < 0) (_ : z > 0) : False := by omega - -example {x y : Nat} (_ : x - y = 0) (_ : x > y) : False := by - fail_if_success omega (config := { splitNatSub := false }) - omega - -example {x y z : Int} (_ : x - y - z = 0) (_ : x > y + z) : False := by omega - -example {x y z : Nat} (_ : x - y - z = 0) (_ : x > y + z) : False := by omega - -example {a b c d e f : Nat} (_ : a - b - c - d - e - f = 0) (_ : a > b + c + d + e + f) : - False := by - omega - -example {x y : Nat} (h₁ : x - y ≤ 0) (h₂ : y < x) : False := by omega - -example {x y : Int} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 6) : False := by omega - -example {x y : Nat} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 6) : False := by omega - -example {x y : Nat} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 4) : False := by omega - -example {x y : Nat} (_ : x / 2 - y / 3 < x % 2) (_ : 3 * x ≥ 2 * y + 4) : False := by omega - -example {x : Int} (h₁ : 5 ≤ x) (h₂ : x ≤ 4) : False := by omega - -example {x : Nat} (h₁ : 5 ≤ x) (h₂ : x ≤ 4) : False := by omega - -example {x : Nat} (h₁ : x / 3 ≥ 2) (h₂ : x < 6) : False := by omega - -example {x : Int} {y : Nat} (_ : 0 < x) (_ : x + y ≤ 0) : False := by omega - -example {a b c : Nat} (_ : a - (b - c) ≤ 5) (_ : b ≥ c + 3) (_ : a + c ≥ b + 6) : False := by omega - -example {x : Nat} : 1 < (1 + ((x + 1 : Nat) : Int) + 2) / 2 := by omega - -example {x : Nat} : (x + 4) / 2 ≤ x + 2 := by omega - -example {x : Int} {m : Nat} (_ : 0 < m) (_ : ¬x % ↑m < (↑m + 1) / 2) : -↑m / 2 ≤ x % ↑m - ↑m := by - omega - -example (h : (7 : Int) = 0) : False := by omega - -example (h : (7 : Int) ≤ 0) : False := by omega - -example (h : (-7 : Int) + 14 = 0) : False := by omega - -example (h : (-7 : Int) + 14 ≤ 0) : False := by omega - -example (h : (1 : Int) + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 = 0) : False := by - omega - -example (h : (7 : Int) - 14 = 0) : False := by omega - -example (h : (14 : Int) - 7 ≤ 0) : False := by omega - -example (h : (1 : Int) - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 = 0) : False := by - omega - -example (h : -(7 : Int) = 0) : False := by omega - -example (h : -(-7 : Int) ≤ 0) : False := by omega - -example (h : 2 * (7 : Int) = 0) : False := by omega - -example (h : (7 : Int) < 0) : False := by omega - -example {x : Int} (h : x + x + 1 = 0) : False := by omega - -example {x : Int} (h : 2 * x + 1 = 0) : False := by omega - -example {x y : Int} (h : x + x + y + y + 1 = 0) : False := by omega - -example {x y : Int} (h : 2 * x + 2 * y + 1 = 0) : False := by omega - -example {x : Int} (h₁ : 0 ≤ -7 + x) (h₂ : 0 ≤ 3 - x) : False := by omega - -example {x : Int} (h₁ : 0 ≤ -7 + x) (h₂ : 0 < 4 - x) : False := by omega - -example {x : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : 2 * x + 1 ≤ 0) : False := by omega - -example {x : Int} (h₁ : 0 < 2 * x + 2) (h₂ : 2 * x + 1 ≤ 0) : False := by omega - -example {x y : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : x = y) (h₃ : 2 * y + 1 ≤ 0) : False := by omega - -example {x y z : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : x = y) (h₃ : y = z) (h₄ : 2 * z + 1 ≤ 0) : - False := by omega - -example {x1 x2 x3 x4 x5 x6 : Int} (h : 0 ≤ 2 * x1 + 1) (h : x1 = x2) (h : x2 = x3) (h : x3 = x4) - (h : x4 = x5) (h : x5 = x6) (h : 2 * x6 + 1 ≤ 0) : False := by omega - -example {x : Int} (_ : 1 ≤ -3 * x) (_ : 1 ≤ 2 * x) : False := by omega - -example {x y : Int} (_ : 2 * x + 3 * y = 0) (_ : 1 ≤ x) (_ : 1 ≤ y) : False := by omega - -example {x y z : Int} (_ : 2 * x + 3 * y = 0) (_ : 3 * y + 4 * z = 0) (_ : 1 ≤ x) (_ : 1 ≤ -z) : - False := by omega - -example {x y z : Int} (_ : 2 * x + 3 * y + 4 * z = 0) (_ : 1 ≤ x + y) (_ : 1 ≤ y + z) - (_ : 1 ≤ x + z) : False := by omega - -example {x y : Int} (_ : 1 ≤ 3 * x) (_ : y ≤ 2) (_ : 6 * x - 2 ≤ y) : False := by omega - -example {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : 1 ≤ x) : False := by - omega -example {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : x ≥ 1) : False := by - omega -example {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : 0 < x) : False := by - omega -example {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : x > 0) : False := by - omega - -example {x : Nat} (_ : 10 ∣ x) (_ : ¬ 5 ∣ x) : False := by omega -example {x y : Nat} (_ : 5 ∣ x) (_ : ¬ 10 ∣ x) (_ : y = 7) (_ : x - y ≤ 2) (_ : x ≥ 6) : False := by - omega - -example (x : Nat) : x % 4 - x % 8 = 0 := by omega - -example {n : Nat} (_ : n > 0) : (2*n - 1) % 2 = 1 := by omega - -example (x : Int) (_ : x > 0 ∧ x < -1) : False := by omega -example (x : Int) (_ : x > 7) : x < 0 ∨ x > 3 := by omega - -example (_ : ∃ n : Nat, n < 0) : False := by omega -example (_ : { x : Int // x < 0 ∧ x > 0 }) : False := by omega -example {x y : Int} (_ : x < y) (z : { z : Int // y ≤ z ∧ z ≤ x }) : False := by omega - -example (a b c d e : Int) - (ha : 2 * a + b + c + d + e = 4) - (hb : a + 2 * b + c + d + e = 5) - (hc : a + b + 2 * c + d + e = 6) - (hd : a + b + c + 2 * d + e = 7) - (he : a + b + c + d + 2 * e = 8) : e = 3 := by omega - -example (a b c d e : Int) - (ha : 2 * a + b + c + d + e = 4) - (hb : a + 2 * b + c + d + e = 5) - (hc : a + b + 2 * c + d + e = 6) - (hd : a + b + c + 2 * d + e = 7) - (he : a + b + c + d + 2 * e = 8 ∨ e = 3) : e = 3 := by - fail_if_success omega (config := { splitDisjunctions := false }) - omega - -example {x : Int} (h : x = 7) : x.natAbs = 7 := by - fail_if_success omega (config := { splitNatAbs := false }) - fail_if_success omega (config := { splitDisjunctions := false }) - omega - -example {x y : Int} (_ : (x - y).natAbs < 3) (_ : x < 5) (_ : y > 15) : False := by - omega - -example {a b : Int} (h : a < b) (w : b < a) : False := by omega - -example (_e b c a v0 v1 : Int) (_h1 : v0 = 5 * a) (_h2 : v1 = 3 * b) (h3 : v0 + v1 + c = 10) : - v0 + 5 + (v1 - 3) + (c - 2) = 10 := by omega - -example (h : (1 : Int) < 0) (_ : ¬ (37 : Int) < 42) (_ : True) (_ : (-7 : Int) < 5) : - (3 : Int) < 7 := by omega - -example (A B : Int) (h : 0 < A * B) : 0 < 8 * (A * B) := by omega - -example (A B : Nat) (h : 7 < A * B) : 0 < A*B/8 := by omega -example (A B : Int) (h : 7 < A * B) : 0 < A*B/8 := by omega - -example (ε : Int) (h1 : ε > 0) : ε / 2 + ε / 3 + ε / 7 < ε := by omega - -example (x y z : Int) (h1 : 2*x < 3*y) (h2 : -4*x + z/2 < 0) (h3 : 12*y - z < 0) : False := by omega - -example (ε : Int) (h1 : ε > 0) : ε / 2 < ε := by omega - -example (ε : Int) (_ : ε > 0) : ε - 2 ≤ ε / 3 + ε / 3 + ε / 3 := by omega -example (ε : Int) (_ : ε > 0) : ε / 3 + ε / 3 + ε / 3 ≤ ε := by omega -example (ε : Int) (_ : ε > 0) : ε - 2 ≤ ε / 3 + ε / 3 + ε / 3 ∧ ε / 3 + ε / 3 + ε / 3 ≤ ε := by - omega - -example (x : Int) (h : 0 < x) : 0 < x / 1 := by omega - -example (x : Int) (h : 5 < x) : 0 < x/2/3 := by omega - -example (_a b _c : Nat) (h2 : b + 2 > 3 + b) : False := by omega -example (_a b _c : Int) (h2 : b + 2 > 3 + b) : False := by omega - -example (g v V c h : Int) (_ : h = 0) (_ : v = V) (_ : V > 0) (_ : g > 0) - (_ : 0 ≤ c) (_ : c < 1) : v ≤ V := by omega - -example (x y z : Int) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) (h3 : 12 * y - 4 * z < 0) : - False := by - omega - -example (x y z : Int) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) (_h3 : x * y < 5) - (h3 : 12 * y - 4 * z < 0) : False := by omega - -example (a b c : Int) (h1 : a > 0) (h2 : b > 5) (h3 : c < -10) (h4 : a + b - c < 3) : False := by - omega - -example (_ b _ : Int) (h2 : b > 0) (h3 : ¬ b ≥ 0) : False := by - omega - -example (x y z : Int) (hx : x ≤ 3 * y) (h2 : y ≤ 2 * z) (h3 : x ≥ 6 * z) : x = 3 * y := by - omega - -example (x y z : Int) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) (_h3 : x * y < 5) : - ¬ 12 * y - 4 * z < 0 := by - omega - -example (x y z : Int) (hx : ¬ x > 3 * y) (h2 : ¬ y > 2 * z) (h3 : x ≥ 6 * z) : x = 3 * y := by - omega - -example (x y : Int) (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3) (h' : (x + 4) * x ≥ 0) - (h'' : (6 + 3 * y) * y ≥ 0) : False := by omega - -example (a : Int) (ha : 0 ≤ a) : 0 * 0 ≤ 2 * a := by omega - -example (x y : Int) (h : x < y) : x ≠ y := by omega - -example (x y : Int) (h : x < y) : ¬ x = y := by omega - -example (x : Int) : id x ≥ x := by omega - -example (prime : Nat → Prop) (x y z : Int) (h1 : 2 * x + ((-3) * y) < 0) (h2 : (-4) * x + 2* z < 0) - (h3 : 12 * y + (-4) * z < 0) (_ : prime 7) : False := by omega - -example (i n : Nat) (h : (2 : Int) ^ i ≤ 2 ^ n) : (0 : Int) ≤ 2 ^ n - 2 ^ i := by omega - --- Check we use `exfalso` on non-comparison goals. -example (prime : Nat → Prop) (_ b _ : Nat) (h2 : b > 0) (h3 : b < 0) : prime 10 := by - omega - -example (a b c : Nat) (h2 : (2 : Nat) > 3) : a + b - c ≥ 3 := by omega - --- Verify that we split conjunctions in hypotheses. -example (x y : Int) - (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3 ∧ (x + 4) * x ≥ 0 ∧ (6 + 3 * y) * y ≥ 0) : - False := by omega - -example (mess : Nat → Nat) (S n : Nat) : - mess S + (n * mess S + n * 2 + 1) < n * mess S + mess S + (n * 2 + 2) := by omega - -example (p n p' n' : Nat) (h : p + n' = p' + n) : n + p' = n' + p := by - omega - -example (a b c : Int) (h1 : 32 / a < b) (h2 : b < c) : 32 / a < c := by omega - --- Check that `autoParam` wrappers do not get in the way of using hypotheses. -example (i n : Nat) (hi : i ≤ n := by omega) : i < n + 1 := by - omega - --- Test that we consume expression metadata when necessary. -example : 0 = 0 := by - have : 0 = 0 := by omega - omega -- This used to fail. - -/-! ### `Prod.Lex` -/ - --- This example comes from the termination proof --- for `permutationsAux.rec` in `Mathlib.Data.List.Defs`. -example {x y : Nat} : Prod.Lex (· < ·) (· < ·) (x, x) (Nat.succ y + x, Nat.succ y) := by omega - --- We test the termination proof in-situ: -def List.permutationsAux.rec' {C : List α → List α → Sort v} (H0 : ∀ is, C [] is) - (H1 : ∀ t ts is, C ts (t :: is) → C is [] → C (t :: ts) is) : ∀ l₁ l₂, C l₁ l₂ - | [], is => H0 is - | t :: ts, is => - H1 t ts is (permutationsAux.rec' H0 H1 ts (t :: is)) (permutationsAux.rec' H0 H1 is []) - termination_by ts is => (length ts + length is, length ts) - decreasing_by all_goals simp_wf; omega - -example {x y w z : Nat} (h : Prod.Lex (· < ·) (· < ·) (x + 1, y + 1) (w, z)) : - Prod.Lex (· < ·) (· < ·) (x, y) (w, z) := by omega - --- Verify that we can handle `iff` statements in hypotheses: -example (a b : Int) (h : a < 0 ↔ b < 0) (w : b > 3) : a ≥ 0 := by omega - --- Verify that we can prove `iff` goals: -example (a b : Int) (h : a > 7) (w : b > 2) : a > 0 ↔ b > 0 := by omega - --- Verify that we can prove implications: -example (a : Int) : a > 0 → a > -1 := by omega - --- Verify that we can introduce multiple arguments: -example (x y : Int) : x + 1 ≤ y → ¬ y + 1 ≤ x := by omega - --- Verify that we can handle double negation: -example (x y : Int) (_ : x < y) (_ : ¬ ¬ y < x) : False := by omega - --- Verify that we don't treat function goals as implications. -example (a : Nat) (h : a < 0) : Nat → Nat := by omega - --- Example from Cedar: -example {a₁ a₂ p₁ p₂ : Nat} - (h₁ : a₁ = a₂ → ¬p₁ = p₂) : - (a₁ < a₂ ∨ a₁ = a₂ ∧ p₁ < p₂) ∨ a₂ < a₁ ∨ a₂ = a₁ ∧ p₂ < p₁ := by omega - --- From https://github.com/leanprover/std4/issues/562 -example {i : Nat} (h1 : i < 330) (_h2 : 7 ∣ (660 + i) * (1319 - i)) : 1319 - i < 1979 := by - omega - -example {a : Int} (_ : a < min a b) : False := by omega (config := { splitMinMax := false }) -example {a : Int} (_ : max a b < b) : False := by omega (config := { splitMinMax := false }) -example {a : Nat} (_ : a < min a b) : False := by omega (config := { splitMinMax := false }) -example {a : Nat} (_ : max a b < b) : False := by omega (config := { splitMinMax := false }) - -example {a b : Nat} (_ : a = 7) (_ : b = 3) : min a b = 3 := by - fail_if_success omega (config := { splitMinMax := false }) - omega - -example {a b : Nat} (_ : a + b = 9) : (min a b) % 2 + (max a b) % 2 = 1 := by - fail_if_success omega (config := { splitMinMax := false }) - omega - -example {a : Int} (_ : a < if a ≤ b then a else b) : False := by omega -example {a b : Int} : (if a < b then a else b - 1) ≤ b := by omega - --- Check that we use local values. -example (i j : Nat) (p : i ≥ j) : True := by - let l := j - 1 - have _ : i ≥ l := by omega - trivial - -example (i j : Nat) (p : i ≥ j) : True := by - let l := j - 1 - let k := l - have _ : i ≥ k := by omega - trivial - -example (i : Fin 7) : (i : Nat) < 8 := by omega - -example (x y z i : Nat) (hz : z ≤ 1) : x % 2 ^ i + y % 2 ^ i + z < 2 * 2^ i := by omega diff --git a/test/rcases.lean b/test/rcases.lean deleted file mode 100644 index 39c728a9cc..0000000000 --- a/test/rcases.lean +++ /dev/null @@ -1,211 +0,0 @@ -import Std.Tactic.Basic - -set_option linter.missingDocs false - -example (x : α × β × γ) : True := by - rcases x with ⟨a, b, c⟩ - guard_hyp a : α - guard_hyp b : β - guard_hyp c : γ - trivial - -example (x : α × β × γ) : True := by - rcases x with ⟨(a : α) : id α, -, c : id γ⟩ - guard_hyp a : α - fail_if_success have : β := by assumption - guard_hyp c : id γ - trivial - -example (x : (α × β) × γ) : True := by - fail_if_success rcases x with ⟨_a, b, c⟩ - fail_if_success rcases x with ⟨⟨a:β, b⟩, c⟩ - rcases x with ⟨⟨a:α, b⟩, c⟩ - guard_hyp a : α - guard_hyp b : β - guard_hyp c : γ - trivial - -example : @Inhabited.{1} α × Option β ⊕ γ → True := by - rintro (⟨⟨a⟩, _ | b⟩ | c) - · guard_hyp a : α; trivial - · guard_hyp a : α; guard_hyp b : β; trivial - · guard_hyp c : γ; trivial - -example : cond false Nat Int → cond true Int Nat → Nat ⊕ Unit → True := by - rintro (x y : Int) (z | u) - · guard_hyp x : Int; guard_hyp y : Int; guard_hyp z : Nat; trivial - · guard_hyp x : Int; guard_hyp y : Int; guard_hyp u : Unit; trivial - -example (x y : Nat) (h : x = y) : True := by - rcases x with _|⟨⟩|z - · guard_hyp h : Nat.zero = y; trivial - · guard_hyp h : Nat.succ Nat.zero = y; trivial - · guard_hyp z : Nat - guard_hyp h : Nat.succ (Nat.succ z) = y; trivial - -example (h : x = 3) (h₂ : x < 4) : x < 4 := by - rcases h with ⟨⟩ - guard_hyp h₂ : 3 < 4; guard_target = 3 < 4; exact h₂ - -example (h : x = 3) (h₂ : x < 4) : x < 4 := by - rcases h with rfl - guard_hyp h₂ : 3 < 4; guard_target = 3 < 4; exact h₂ - -example (h : 3 = x) (h₂ : x < 4) : x < 4 := by - rcases h with ⟨⟩ - guard_hyp h₂ : 3 < 4; guard_target = 3 < 4; exact h₂ - -example (h : 3 = x) (h₂ : x < 4) : x < 4 := by - rcases h with rfl - guard_hyp h₂ : 3 < 4; guard_target = 3 < 4; exact h₂ - -example (s : α ⊕ Empty) : True := by - rcases s with s|⟨⟨⟩⟩ - guard_hyp s : α; trivial - -example : True := by - obtain ⟨n : Nat, _h : n = n, -⟩ : ∃ n : Nat, n = n ∧ True - · exact ⟨0, rfl, trivial⟩ - trivial - -example : True := by - obtain (h : True) | ⟨⟨⟩⟩ : True ∨ False - · exact Or.inl trivial - guard_hyp h : True; trivial - -example : True := by - obtain h | ⟨⟨⟩⟩ : True ∨ False := Or.inl trivial - guard_hyp h : True; trivial - -example : True := by - obtain ⟨h, h2⟩ := And.intro trivial trivial - guard_hyp h : True; guard_hyp h2 : True; trivial - -example : True := by - fail_if_success obtain ⟨h, h2⟩ - trivial - -example (x y : α × β) : True := by - rcases x, y with ⟨⟨a, b⟩, c, d⟩ - guard_hyp a : α; guard_hyp b : β - guard_hyp c : α; guard_hyp d : β - trivial - -example (x y : α ⊕ β) : True := by - rcases x, y with ⟨a|b, c|d⟩ - · guard_hyp a : α; guard_hyp c : α; trivial - · guard_hyp a : α; guard_hyp d : β; trivial - · guard_hyp b : β; guard_hyp c : α; trivial - · guard_hyp b : β; guard_hyp d : β; trivial - -example (i j : Nat) : (Σ' x, i ≤ x ∧ x ≤ j) → i ≤ j := by - intro h - rcases h' : h with ⟨x, h₀, h₁⟩ - guard_hyp h' : h = ⟨x, h₀, h₁⟩ - apply Nat.le_trans h₀ h₁ - -example (x : Quot fun _ _ : α => True) (h : x = x): x = x := by - rcases x with ⟨z⟩ - guard_hyp z : α - guard_hyp h : Quot.mk (fun _ _ => True) z = Quot.mk (fun _ _ => True) z - guard_target = Quot.mk (fun _ _ => True) z = Quot.mk (fun _ _ => True) z - exact h - -example (n : Nat) : True := by - obtain _one_lt_n | _n_le_one : 1 < n + 1 ∨ n + 1 ≤ 1 := Nat.lt_or_ge 1 (n + 1) - {trivial}; trivial - -example (n : Nat) : True := by - obtain _one_lt_n | (_n_le_one : n + 1 ≤ 1) := Nat.lt_or_ge 1 (n + 1) - {trivial}; trivial - -open Lean Elab Tactic in -/-- Asserts that the goal has `n` hypotheses. Used for testing. -/ -elab "check_num_hyps " n:num : tactic => liftMetaMAtMain fun _ => do - -- +1 because the _example recursion decl is in the list - guard $ (← getLCtx).foldl (fun i _ => i+1) 0 = n.1.toNat + 1 - -example (h : ∃ x : Nat, x = x ∧ 1 = 1) : True := by - rcases h with ⟨-, _⟩ - check_num_hyps 0 - trivial - -example (h : ∃ x : Nat, x = x ∧ 1 = 1) : True := by - rcases h with ⟨-, _, h⟩ - check_num_hyps 1 - guard_hyp h : 1 = 1 - trivial - -example (h : True ∨ True ∨ True) : True := by - rcases h with - | - | - - iterate 3 · check_num_hyps 0; trivial - -example (h : True ∨ True ∨ True) : True := by - rcases h with -|-|- - iterate 3 · check_num_hyps 0; trivial - -example : Bool → False → True -| false => by rintro ⟨⟩ -| true => by rintro ⟨⟩ - -example : (b : Bool) → cond b False False → True := by - rintro ⟨⟩ ⟨⟩ - -structure Baz {α : Type _} (f : α → α) : Prop where - [inst : Nonempty α] - h : f ∘ f = id - -example {α} (f : α → α) (h : Baz f) : True := by rcases h with ⟨_⟩; trivial - -example {α} (f : α → α) (h : Baz f) : True := by rcases h with @⟨_, _⟩; trivial - -inductive Test : Nat → Prop - | a (n) : Test (2 + n) - | b {n} : n > 5 → Test (n * n) - -example {n} (h : Test n) : n = n := by - have : True := by - rcases h with (a | b) - · guard_hyp a : Nat - trivial - · guard_hyp b : ‹Nat› > 5 - trivial - · rcases h with (a | @⟨n, b⟩) - · guard_hyp a : Nat - trivial - · guard_hyp b : n > 5 - trivial - -example (h : a ≤ 2 ∨ 2 < a) : True := by - obtain ha1 | ha2 : a ≤ 2 ∨ 3 ≤ a := h - · guard_hyp ha1 : a ≤ 2; trivial - · guard_hyp ha2 : 3 ≤ a; trivial - -example (h : a ≤ 2 ∨ 2 < a) : True := by - obtain ha1 | ha2 : a ≤ 2 ∨ 3 ≤ a := id h - · guard_hyp ha1 : a ≤ 2; trivial - · guard_hyp ha2 : 3 ≤ a; trivial - -example (a : Nat) : True := by - rcases h : a with _ | n - · guard_hyp h : a = 0; trivial - · guard_hyp h : a = n + 1; trivial - -inductive BaseType : Type where - | one - -inductive BaseTypeHom : BaseType → BaseType → Type where - | loop : BaseTypeHom one one - | id (X : BaseType) : BaseTypeHom X X - -example : BaseTypeHom one one → Unit := by rintro ⟨_⟩ <;> constructor - -axiom test_sorry {α} : α -example (b c : Nat) : True := by - obtain rfl : b = c ^ 2 := test_sorry - trivial - -example (b c : Nat) : True := by - obtain h : b = c ^ 2 := test_sorry - subst h - trivial diff --git a/test/repeat.lean b/test/repeat.lean deleted file mode 100644 index 276e283f8f..0000000000 --- a/test/repeat.lean +++ /dev/null @@ -1,12 +0,0 @@ -import Std.Tactic.Basic - -open Lean Elab Tactic Meta - -elab "foo" : tactic => liftMetaTactic fun g => do - g.assign (← mkFreshExprMVar (← g.getType)) - throwError "" - -#guard_msgs in -example : True := by - repeat' foo - trivial diff --git a/test/replace.lean b/test/replace.lean deleted file mode 100644 index 99cfd227fe..0000000000 --- a/test/replace.lean +++ /dev/null @@ -1,50 +0,0 @@ -/- -Copyright (c) 2022 Arthur Paulino. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Arthur Paulino --/ - -set_option linter.unusedVariables false - --- tests with an explicitly named hypothesis - -example (h : Int) : Nat := by - replace h : Nat := 0 - exact h - -example (h : Nat) : Nat := by - have h : Int := 0 - assumption -- original `h` is not absent but... - -example (h : Nat) : Nat := by - replace h : Int := 0 - fail_if_success assumption -- original `h` is absent now - replace h : Nat := 0 - exact h - --- tests with `this` - -example : Nat := by - have : Int := 0 - replace : Nat := 0 - assumption - -example : Nat := by - have : Nat := 0 - have : Int := 0 - assumption -- original `this` is not absent but... - -example : Nat := by - have : Nat := 0 - replace : Int := 0 - fail_if_success assumption -- original `this` is absent now - replace : Nat := 0 - assumption - --- trying to replace the type of a variable when the goal depends on it - -example {a : Nat} : a = a := by - replace a : Int := 0 - have : Nat := by assumption -- old `a` is not gone - have : Int := by exact a -- new `a` is of type `Int` - simp diff --git a/test/run_cmd.lean b/test/run_cmd.lean deleted file mode 100644 index a3b649e5e0..0000000000 --- a/test/run_cmd.lean +++ /dev/null @@ -1,15 +0,0 @@ -import Lean.Elab.Tactic.ElabTerm -import Lean.Elab.Command - -open Lean Elab Tactic - -/-- info: hello world -/ -#guard_msgs in -run_cmd logInfo m!"hello world" - -example : True := by - run_tac - evalApplyLikeTactic MVarId.apply (← `(True.intro)) - -example : True := by_elab - Term.elabTerm (← `(True.intro)) none diff --git a/test/solve_by_elim.lean b/test/solve_by_elim.lean index fbe6abba90..2da0eb6c05 100644 --- a/test/solve_by_elim.lean +++ b/test/solve_by_elim.lean @@ -11,90 +11,6 @@ import Lean.Elab.Tactic.SolveByElim -- FIXME we need to make SolveByElimConfig b set_option autoImplicit true -example (h : Nat) : Nat := by solve_by_elim -example {α β : Type} (f : α → β) (a : α) : β := by solve_by_elim -example {α β : Type} (f : α → α → β) (a : α) : β := by solve_by_elim -example {α β γ : Type} (f : α → β) (g : β → γ) (a : α) : γ := by solve_by_elim -example {α β γ : Type} (_f : α → β) (g : β → γ) (b : β) : γ := by solve_by_elim -example {α : Nat → Type} (f : (n : Nat) → α n → α (n+1)) (a : α 0) : α 4 := by solve_by_elim - -example (h : Nat) : Nat := by solve_by_elim [] -example {α β : Type} (f : α → β) (a : α) : β := by solve_by_elim [] -example {α β : Type} (f : α → α → β) (a : α) : β := by solve_by_elim [] -example {α β γ : Type} (f : α → β) (g : β → γ) (a : α) : γ := by solve_by_elim [] -example {α β γ : Type} (_f : α → β) (g : β → γ) (b : β) : γ := by solve_by_elim [] -example {α : Nat → Type} (f : (n : Nat) → α n → α (n+1)) (a : α 0) : α 4 := by solve_by_elim [] - -example {α β : Type} (f : α → β) (a : α) : β := by - fail_if_success solve_by_elim [-f] - fail_if_success solve_by_elim [-a] - fail_if_success solve_by_elim only [f] - solve_by_elim - -example {α β γ : Type} (f : α → β) (g : β → γ) (b : β) : γ := by - fail_if_success solve_by_elim [-g] - solve_by_elim [-f] - -example (h : Nat) : Nat := by solve_by_elim only [h] -example {α β : Type} (f : α → β) (a : α) : β := by solve_by_elim only [f, a] -example {α β : Type} (f : α → α → β) (a : α) : β := by solve_by_elim only [f, a] -example {α β γ : Type} (f : α → β) (g : β → γ) (a : α) : γ := by solve_by_elim only [f, g, a] -example {α β γ : Type} (_f : α → β) (g : β → γ) (b : β) : γ := by solve_by_elim only [g, b] -example {α : Nat → Type} (f : (n : Nat) → α n → α (n+1)) (a : α 0) : α 4 := by - solve_by_elim only [f, a] - -set_option linter.unusedVariables false in -example (h₁ h₂ : False) : True := by - -- 'It doesn't make sense to remove local hypotheses when using `only` without `*`.' - fail_if_success solve_by_elim only [-h₁] - -- 'It does make sense to use `*` without `only`.' - fail_if_success solve_by_elim [*, -h₁] - solve_by_elim only [*, -h₁] - --- Verify that already assigned metavariables are skipped. -example (P₁ P₂ : α → Prop) (f : ∀ (a : α), P₁ a → P₂ a → β) - (a : α) (ha₁ : P₁ a) (ha₂ : P₂ a) : β := by - solve_by_elim - -example {X : Type} (x : X) : x = x := by - fail_if_success solve_by_elim (config := {constructor := false}) only -- needs the `rfl` lemma - solve_by_elim - --- Needs to apply `rfl` twice, with different implicit arguments each time. --- A naive implementation of solve_by_elim would get stuck. -example {X : Type} (x y : X) (p : Prop) (h : x = x → y = y → p) : p := by solve_by_elim - -example : True := by - fail_if_success solve_by_elim (config := {constructor := false}) only -- needs the `trivial` lemma - solve_by_elim - --- Requires backtracking. -example (P₁ P₂ : α → Prop) (f : ∀ (a: α), P₁ a → P₂ a → β) - (a : α) (_ha₁ : P₁ a) - (a' : α) (ha'₁ : P₁ a') (ha'₂ : P₂ a') : β := by - fail_if_success solve_by_elim (config := .noBackTracking) - solve_by_elim - -attribute [symm] Eq.symm in -example {α : Type} {a b : α → Prop} (h₀ : b = a) (y : α) : a y = b y := by - fail_if_success solve_by_elim (config := {symm := false}) - solve_by_elim - -example (P : True → False) : 3 = 7 := by - fail_if_success solve_by_elim (config := {exfalso := false}) - solve_by_elim - --- Verifying that `solve_by_elim` acts only on the main goal. -example (n : Nat) : Nat × Nat := by - constructor - solve_by_elim - solve_by_elim - --- Verifying that `solve_by_elim*` acts on all remaining goals. -example (n : Nat) : Nat × Nat := by - constructor - solve_by_elim* - open Lean Elab Tactic in /-- `fconstructor` is like `constructor` @@ -106,21 +22,6 @@ elab "fconstructor" : tactic => withMainContext do Term.synthesizeSyntheticMVarsNoPostponing replaceMainGoal mvarIds' --- Verifying that `solve_by_elim*` backtracks when given multiple goals. -example (n m : Nat) (f : Nat → Nat → Prop) (h : f n m) : ∃ p : Nat × Nat, f p.1 p.2 := by - fconstructor - fconstructor - solve_by_elim* - --- test that metavariables created for implicit arguments don't get stuck -example (P : Nat → Type) (f : {n : Nat} → P n) : P 2 × P 3 := by - fconstructor - solve_by_elim* only [f] - -example : 6 = 6 ∧ [7] = [7] := by - fconstructor - solve_by_elim* only [@rfl _] - -- Test that `solve_by_elim*`, which works on multiple goals, -- successfully uses the relevant local hypotheses for each goal. example (f g : Nat → Prop) : (∃ k : Nat, f k) ∨ (∃ k : Nat, g k) ↔ ∃ k : Nat, f k ∨ g k := by @@ -129,32 +30,6 @@ example (f g : Nat → Prop) : (∃ k : Nat, f k) ∨ (∃ k : Nat, g k) ↔ ∃ on_goal 3 => rintro ⟨n, hf | hg⟩ solve_by_elim* (config := {maxDepth := 13}) [Or.inl, Or.inr, Exists.intro] --- Test that `Config.intros` causes `solve_by_elim` to call `intro` on intermediate goals. -example (P : Prop) : P → P := by - fail_if_success solve_by_elim (config := {intros := false}) - solve_by_elim - --- This worked in mathlib3 without the `@`, but now goes into a loop. --- If someone wants to diagnose this, please do! -example (P Q : Prop) : P ∧ Q → P ∧ Q := by - solve_by_elim [And.imp, @id] - -section apply_assumption - -example {a b : Type} (h₀ : a → b) (h₁ : a) : b := by - apply_assumption - apply_assumption - -example {α : Type} {p : α → Prop} (h₀ : ∀ x, p x) (y : α) : p y := by - apply_assumption - --- Check that `apply_assumption` uses `exfalso`. -example {P Q : Prop} (p : P) (q : Q) (h : P → ¬ Q) : Nat := by - fail_if_success apply_assumption (config := {exfalso := false}) - apply_assumption <;> assumption - -end apply_assumption - section «using» /-- -/ @@ -184,8 +59,3 @@ example : 5 ≤ 7 := by exact mySorry end issue1581 - -example (x : (α × (β × γ))) : (α × β) × γ := by - rcases x with ⟨a, b, c⟩ - fail_if_success solve_by_elim (config := {constructor := false}) - solve_by_elim diff --git a/test/symm.lean b/test/symm.lean deleted file mode 100644 index 33f2146617..0000000000 --- a/test/symm.lean +++ /dev/null @@ -1,27 +0,0 @@ -import Init.Tactics - -set_option autoImplicit true -set_option linter.missingDocs false - --- testing that the attribute is recognized -@[symm] def eq_symm {α : Type} (a b : α) : a = b → b = a := Eq.symm - -example (a b : Nat) : a = b → b = a := by intros; symm; assumption -example (a b : Nat) : a = b → True → b = a := by intro h _; symm at h; assumption - -def sameParity : Nat → Nat → Prop - | n, m => n % 2 = m % 2 - -@[symm] def sameParity_symm (n m : Nat) : sameParity n m → sameParity m n := Eq.symm - -example (a b : Nat) : sameParity a b → sameParity b a := by intros; symm; assumption - -def MyEq (n m : Nat) := ∃ k, n + k = m ∧ m + k = n - -@[symm] theorem MyEq.symm {n m : Nat} (h : MyEq n m) : MyEq m n := by - rcases h with ⟨k, h1, h2⟩ - exact ⟨k, h2, h1⟩ - -example {n m : Nat} (h : MyEq n m) : MyEq m n := by - symm - assumption From ffd8e6954bb8095eb80d95b042fc48a0e957ed62 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Thu, 29 Feb 2024 09:15:37 +0000 Subject: [PATCH 106/213] chore: bump to nightly-2024-02-29 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 7a8de20d64..4cdff30f83 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-28 +leanprover/lean4:nightly-2024-02-29 From 004dcf854d9ebe61ec97a398d9be562d469ded26 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 22:13:22 +1100 Subject: [PATCH 107/213] remove upstreamed lemmas --- Std.lean | 1 - Std/Data/Array/Lemmas.lean | 34 ------------------------------ Std/Data/HashMap/WF.lean | 1 - Std/Data/List/Basic.lean | 19 ----------------- Std/Data/List/Lemmas.lean | 20 ------------------ Std/Tactic/Basic.lean | 1 - Std/Tactic/ShowTerm.lean | 42 -------------------------------------- test/show_term.lean | 1 - test/simpa.lean | 1 - 9 files changed, 120 deletions(-) delete mode 100644 Std/Tactic/ShowTerm.lean diff --git a/Std.lean b/Std.lean index f4906385c5..2d3a6d9782 100644 --- a/Std.lean +++ b/Std.lean @@ -94,7 +94,6 @@ import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix import Std.Tactic.Relation.Rfl import Std.Tactic.SeqFocus -import Std.Tactic.ShowTerm import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable import Std.Tactic.Where diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 330f553080..cbf26c0de2 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -50,26 +50,12 @@ theorem mem_data {a : α} {l : Array α} : a ∈ l.data ↔ a ∈ l := (mem_def theorem not_mem_nil (a : α) : ¬ a ∈ #[] := nofun -/-- # set -/ - -@[simp] theorem set!_is_setD : @set! = @setD := rfl - -@[simp] theorem size_setD (a : Array α) (index : Nat) (val : α) : - (Array.setD a index val).size = a.size := by - if h : index < a.size then - simp [setD, h] - else - simp [setD, h] - - /-- # get lemmas -/ theorem getElem?_mem {l : Array α} {i : Fin l.size} : l[i] ∈ l := by erw [Array.mem_def, getElem_eq_data_get] apply List.get_mem -@[simp] theorem get_eq_getElem (a : Array α) (i : Fin _) : a.get i = a[i.1] := rfl -@[simp] theorem get?_eq_getElem? (a : Array α) (i : Nat) : a.get? i = a[i]? := rfl theorem getElem_fin_eq_data_get (a : Array α) (i : Fin _) : a[i] = a.data.get i := rfl @[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) : @@ -90,11 +76,6 @@ theorem getElem?_eq_data_get? (a : Array α) (i : Nat) : a[i]? = a.data.get? i : theorem get?_eq_data_get? (a : Array α) (i : Nat) : a.get? i = a.data.get? i := getElem?_eq_data_get? .. -@[simp] theorem getD_eq_get? (a : Array α) (n d) : a.getD n d = (a.get? n).getD d := by - simp [get?, getD]; split <;> simp - -theorem get!_eq_getD [Inhabited α] (a : Array α) : a.get! n = a.getD n default := rfl - @[simp] theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by simp [get!_eq_getD] @@ -131,10 +112,6 @@ theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x el (a.set i v)[i.1]'(by simp [i.2]) = v := by simp only [set, getElem_eq_data_get, List.get_set_eq] -@[simp] theorem get_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) (hj : j < a.size) - (h : i.1 ≠ j) : (a.set i v)[j]'(by simp [*]) = a[j] := by - simp only [set, getElem_eq_data_get, List.get_set_ne h] - @[simp] theorem get?_set_eq (a : Array α) (i : Fin a.size) (v : α) : (a.set i v)[i.1]? = v := by simp [getElem?_pos, i.2] @@ -155,17 +132,6 @@ theorem get_set (a : Array α) (i : Fin a.size) (j : Nat) (hj : j < a.size) (v : simp at h simp only [setD, h, dite_true, get_set, ite_true] -/-- -This lemma simplifies a normal form from `get!` --/ -@[simp] theorem getD_get?_setD (a : Array α) (i : Nat) (v d : α) : - Option.getD (setD a i v)[i]? d = if i < a.size then v else d := by - if h : i < a.size then - simp [setD, h, getElem?, get_set] - else - have p : i ≥ a.size := Nat.le_of_not_gt h - simp [setD, h, get?_len_le, p] - theorem set_set (a : Array α) (i : Fin a.size) (v v' : α) : (a.set i v).set ⟨i, by simp [i.2]⟩ v' = a.set i v' := by simp [set, List.set_set] diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index 0688ad3417..025f31252b 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -6,7 +6,6 @@ Authors: Mario Carneiro import Std.Data.HashMap.Basic import Std.Data.List.Lemmas import Std.Data.Array.Lemmas -import Std.Tactic.ShowTerm namespace Std.HashMap namespace Imp diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index 34e80890b9..804a32ff8f 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -637,25 +637,6 @@ def scanr (f : α → β → β) (b : β) (l : List α) : List β := let (b', l') := l.foldr (fun a (b', l') => (f a b', b' :: l')) (b, []) b' :: l' -/-- -Given a function `f : α → β ⊕ γ`, `partitionMap f l` maps the list by `f` -whilst partitioning the result it into a pair of lists, `List β × List γ`, -partitioning the `.inl _` into the left list, and the `.inr _` into the right List. -``` -partitionMap (id : Nat ⊕ Nat → Nat ⊕ Nat) [inl 0, inr 1, inl 2] = ([0, 2], [1]) -``` --/ -@[inline] def partitionMap (f : α → β ⊕ γ) (l : List α) : List β × List γ := go l #[] #[] where - /-- Auxiliary for `partitionMap`: - `partitionMap.go f l acc₁ acc₂ = (acc₁.toList ++ left, acc₂.toList ++ right)` - if `partitionMap f l = (left, right)`. -/ - @[specialize] go : List α → Array β → Array γ → List β × List γ - | [], acc₁, acc₂ => (acc₁.toList, acc₂.toList) - | x :: xs, acc₁, acc₂ => - match f x with - | .inl a => go xs (acc₁.push a) acc₂ - | .inr b => go xs acc₁ (acc₂.push b) - /-- Fold a list from left to right as with `foldl`, but the combining function also receives each element's index. diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 03d1fc1788..137c2e3124 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -718,12 +718,6 @@ are often used for theorems about `Array.pop`. -/ /-! ### nth element -/ -@[simp] theorem get_cons_succ {as : List α} {h : i + 1 < (a :: as).length} : - (a :: as).get ⟨i+1, h⟩ = as.get ⟨i, Nat.lt_of_succ_lt_succ h⟩ := rfl - -@[simp] theorem get_cons_succ' {as : List α} {i : Fin as.length} : - (a :: as).get i.succ = as.get i := rfl - @[simp] theorem get_cons_cons_one : (a₁ :: a₂ :: as).get (1 : Fin (as.length + 2)) = a₂ := rfl theorem get!_cons_succ [Inhabited α] (l : List α) (a : α) (n : Nat) : @@ -997,11 +991,6 @@ theorem get?_set_of_lt' (a : α) {m n} (l : List α) (h : m < length l) : (set l m a).get? n = if m = n then some a else l.get? n := by simp [get?_set]; split <;> subst_vars <;> simp [*, get?_eq_get h] -@[simp] theorem set_nil (n : Nat) (a : α) : [].set n a = [] := rfl - -@[simp] theorem set_succ (x : α) (xs : List α) (n : Nat) (a : α) : - (x :: xs).set n.succ a = x :: xs.set n a := rfl - theorem set_comm (a b : α) : ∀ {n m : Nat} (l : List α), n ≠ m → (l.set n a).set m b = (l.set m b).set n a | _, _, [], _ => by simp @@ -1015,15 +1004,6 @@ theorem set_set (a b : α) : ∀ (l : List α) (n : Nat), (l.set n a).set n b = | _ :: _, 0 => by simp [set] | _ :: _, _+1 => by simp [set, set_set] -@[simp] theorem get_set_eq (l : List α) (i : Nat) (a : α) (h : i < (l.set i a).length) : - (l.set i a).get ⟨i, h⟩ = a := by - rw [← Option.some_inj, ← get?_eq_get, get?_set_eq, get?_eq_get] <;> simp_all - -@[simp] theorem get_set_ne {l : List α} {i j : Nat} (h : i ≠ j) (a : α) - (hj : j < (l.set i a).length) : - (l.set i a).get ⟨j, hj⟩ = l.get ⟨j, by simp at hj; exact hj⟩ := by - rw [← Option.some_inj, ← get?_eq_get, get?_set_ne _ _ h, get?_eq_get] - theorem get_set (a : α) {m n} (l : List α) (h) : (set l m a).get ⟨n, h⟩ = if m = n then a else l.get ⟨n, length_set .. ▸ h⟩ := by if h : m = n then subst m; simp else simp [h] diff --git a/Std/Tactic/Basic.lean b/Std/Tactic/Basic.lean index bda6786db5..16f4b14484 100644 --- a/Std/Tactic/Basic.lean +++ b/Std/Tactic/Basic.lean @@ -2,7 +2,6 @@ import Lean.Elab.Tactic.ElabTerm import Std.Linter import Std.Tactic.Init import Std.Tactic.SeqFocus -import Std.Tactic.ShowTerm import Std.Util.ProofWanted -- This is an import only file for common tactics used throughout Std diff --git a/Std/Tactic/ShowTerm.lean b/Std/Tactic/ShowTerm.lean deleted file mode 100644 index f554cb7d64..0000000000 --- a/Std/Tactic/ShowTerm.lean +++ /dev/null @@ -1,42 +0,0 @@ -/- -Copyright (c) 2021 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison, Mario Carneiro --/ -import Lean.Elab.ElabRules -import Lean.Meta.Tactic.TryThis - -namespace Std.Tactic -open Lean Elab Tactic Meta.Tactic.TryThis - -/-- -`show_term tac` runs `tac`, then prints the generated term in the form -"exact X Y Z" or "refine X ?_ Z" if there are remaining subgoals. - -(For some tactics, the printed term will not be human readable.) --/ -elab (name := showTermTac) tk:"show_term " t:tacticSeq : tactic => withMainContext do - let g ← getMainGoal - evalTactic t - addExactSuggestion tk (← instantiateMVars (mkMVar g)).headBeta (origSpan? := ← getRef) - -/-- Implementation of `show_term`. -/ -local elab (name := showTermImpl) tk:"show_term_impl " t:term : term <= ty => do - let e ← Term.elabTermEnsuringType t ty - Term.synthesizeSyntheticMVarsNoPostponing - addTermSuggestion tk (← instantiateMVars e).headBeta (origSpan? := ← getRef) - pure e - -/-- -`show_term e` elaborates `e`, then prints the generated term. - -(For some tactics, the printed term will not be human readable.) --/ -macro (name := showTerm) tk:"show_term " t:term : term => - `(no_implicit_lambda% (show_term_impl%$tk $t)) - -/-- -The command `by?` will print a suggestion for replacing the proof block with a proof term -using `show_term`. --/ -macro (name := by?) tk:"by?" t:tacticSeq : term => `(show_term%$tk by%$tk $t) diff --git a/test/show_term.lean b/test/show_term.lean index 922e034238..8557e8229b 100644 --- a/test/show_term.lean +++ b/test/show_term.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Std.Tactic.ShowTerm /-- info: Try this: exact (n, 37) -/ #guard_msgs in example (n : Nat) : Nat × Nat := by diff --git a/test/simpa.lean b/test/simpa.lean index 065e3b8328..0c2d7c6aea 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Arthur Paulino. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Gabriel Ebner -/ -import Std.Tactic.ShowTerm set_option linter.missingDocs false From 6d22f96c12def2210299724e21e6b191b5b2b852 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 22:18:26 +1100 Subject: [PATCH 108/213] fixed --- Std/Data/Array/Lemmas.lean | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index cbf26c0de2..c42e2da1cf 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -127,6 +127,10 @@ theorem get_set (a : Array α) (i : Fin a.size) (j : Nat) (hj : j < a.size) (v : (a.set i v)[j]'(by simp [*]) = if i = j then v else a[j] := by if h : i.1 = j then subst j; simp [*] else simp [*] +@[simp] theorem get_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) (hj : j < a.size) + (h : i.1 ≠ j) : (a.set i v)[j]'(by simp [*]) = a[j] := by + simp only [set, getElem_eq_data_get, List.get_set_ne _ h] + @[simp] theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) : (setD a i v)[i]'h = v := by simp at h From e2648a09d2bdf1c217f3f127877f528208aec1af Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 22:19:09 +1100 Subject: [PATCH 109/213] oops, omega benchmark regression --- test/omega/benchmark.lean | 2 -- 1 file changed, 2 deletions(-) diff --git a/test/omega/benchmark.lean b/test/omega/benchmark.lean index 8df5b77417..f3a5113dd1 100644 --- a/test/omega/benchmark.lean +++ b/test/omega/benchmark.lean @@ -311,8 +311,6 @@ example (x y : Int) (h : x < y) : x ≠ y := by omega example (x y : Int) (h : x < y) : ¬ x = y := by omega -example (x : Int) : id x ≥ x := by omega - example (prime : Nat → Prop) (x y z : Int) (h1 : 2 * x + ((-3) * y) < 0) (h2 : (-4) * x + 2* z < 0) (h3 : 12 * y + (-4) * z < 0) (_ : prime 7) : False := by omega From 7179275e917a2b771d0853767cea007ad81c99d0 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 29 Feb 2024 22:21:09 +1100 Subject: [PATCH 110/213] remove @[simp] from lemmas simp can prove --- Std/Data/Array/Lemmas.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index c42e2da1cf..555598b53c 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -76,7 +76,7 @@ theorem getElem?_eq_data_get? (a : Array α) (i : Nat) : a[i]? = a.data.get? i : theorem get?_eq_data_get? (a : Array α) (i : Nat) : a.get? i = a.data.get? i := getElem?_eq_data_get? .. -@[simp] theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by +theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by simp [get!_eq_getD] @[simp] theorem back_eq_back? [Inhabited α] (a : Array α) : a.back = a.back?.getD default := by @@ -108,11 +108,11 @@ theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x el @[simp] theorem data_set (a : Array α) (i v) : (a.set i v).data = a.data.set i.1 v := rfl -@[simp] theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) : +theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) : (a.set i v)[i.1]'(by simp [i.2]) = v := by simp only [set, getElem_eq_data_get, List.get_set_eq] -@[simp] theorem get?_set_eq (a : Array α) (i : Fin a.size) (v : α) : +theorem get?_set_eq (a : Array α) (i : Fin a.size) (v : α) : (a.set i v)[i.1]? = v := by simp [getElem?_pos, i.2] @[simp] theorem get?_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) @@ -131,7 +131,7 @@ theorem get_set (a : Array α) (i : Fin a.size) (j : Nat) (hj : j < a.size) (v : (h : i.1 ≠ j) : (a.set i v)[j]'(by simp [*]) = a[j] := by simp only [set, getElem_eq_data_get, List.get_set_ne _ h] -@[simp] theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) : +theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) : (setD a i v)[i]'h = v := by simp at h simp only [setD, h, dite_true, get_set, ite_true] From 9d123ffdc53f4665eca5f5ee82f2b7ecd3bc68e1 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 1 Mar 2024 09:17:02 +0000 Subject: [PATCH 111/213] chore: bump to nightly-2024-03-01 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 4cdff30f83..f16b484e3d 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-29 +leanprover/lean4:nightly-2024-03-01 From ff94a5742bf5028e039e3e19bed22957d65c199b Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 1 Mar 2024 22:54:48 +1100 Subject: [PATCH 112/213] upstreamed lemmas --- Std/Data/Int/DivMod.lean | 10 ------ Std/Data/Int/Order.lean | 68 ---------------------------------------- 2 files changed, 78 deletions(-) diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 383a6c2088..94c51c510b 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -103,10 +103,6 @@ theorem ediv_neg' {a b : Int} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 := | succ _ => congrArg Nat.cast (Nat.div_one _) | -[_+1] => congrArg negSucc (Nat.div_one _) -@[simp] theorem ediv_one : ∀ a : Int, a / 1 = a - | (_:Nat) => congrArg Nat.cast (Nat.div_one _) - | -[_+1] => congrArg negSucc (Nat.div_one _) - theorem div_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.div b = 0 := match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2 @@ -155,9 +151,6 @@ theorem add_mul_ediv_left (a : Int) {b : Int} @[simp] protected theorem fdiv_self {a : Int} (H : a ≠ 0) : a.fdiv a = 1 := by have := Int.mul_fdiv_cancel 1 H; rwa [Int.one_mul] at this -@[simp] protected theorem ediv_self {a : Int} (H : a ≠ 0) : a / a = 1 := by - have := Int.mul_ediv_cancel 1 H; rwa [Int.one_mul] at this - /-! ### mod -/ theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by cases m <;> simp [fmod] @@ -242,9 +235,6 @@ theorem fmod_eq_mod {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fmod a b = mod a @[simp] theorem mod_one (a : Int) : mod a 1 = 0 := by simp [mod_def, Int.div_one, Int.one_mul, Int.sub_self] -@[local simp] theorem emod_one (a : Int) : a % 1 = 0 := by - simp [emod_def, Int.one_mul, Int.sub_self] - @[simp] theorem fmod_one (a : Int) : a.fmod 1 = 0 := by simp [fmod_def, Int.one_mul, Int.sub_self] diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 443ec4e28a..c6001d4cab 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -19,17 +19,6 @@ protected alias ⟨lt_of_not_ge, not_le_of_gt⟩ := Int.not_le protected theorem le_of_not_le {a b : Int} : ¬ a ≤ b → b ≤ a := (Int.le_total a b).resolve_left -protected theorem min_eq_left {a b : Int} (h : a ≤ b) : min a b = a := by simp [Int.min_def, h] - -protected theorem min_eq_right {a b : Int} (h : b ≤ a) : min a b = b := by - rw [Int.min_comm a b]; exact Int.min_eq_left h - -protected theorem max_eq_right {a b : Int} (h : a ≤ b) : max a b = b := by - simp [Int.max_def, h, Int.not_lt.2 h] - -protected theorem max_eq_left {a b : Int} (h : b ≤ a) : max a b = a := by - rw [← Int.max_comm b a]; exact Int.max_eq_right h - @[simp] theorem negSucc_not_pos (n : Nat) : 0 < -[n+1] ↔ False := by simp only [Int.not_lt, iff_false]; constructor @@ -532,60 +521,3 @@ theorem natAbs_lt_natAbs_of_nonneg_of_lt {a b : Int} theorem eq_natAbs_iff_mul_eq_zero : natAbs a = n ↔ (a - n) * (a + n) = 0 := by rw [natAbs_eq_iff, Int.mul_eq_zero, ← Int.sub_neg, Int.sub_eq_zero, Int.sub_eq_zero] - - - -/-! ### toNat -/ - -theorem toNat_eq_max : ∀ a : Int, (toNat a : Int) = max a 0 - | (n : Nat) => (Int.max_eq_left (ofNat_zero_le n)).symm - | -[n+1] => (Int.max_eq_right (Int.le_of_lt (negSucc_lt_zero n))).symm - -@[simp] theorem toNat_zero : (0 : Int).toNat = 0 := rfl - -@[simp] theorem toNat_one : (1 : Int).toNat = 1 := rfl - -@[simp] theorem toNat_of_nonneg {a : Int} (h : 0 ≤ a) : (toNat a : Int) = a := by - rw [toNat_eq_max, Int.max_eq_left h] - -@[simp] theorem toNat_ofNat (n : Nat) : toNat ↑n = n := rfl - -@[simp] theorem toNat_ofNat_add_one {n : Nat} : ((n : Int) + 1).toNat = n + 1 := rfl - -theorem self_le_toNat (a : Int) : a ≤ toNat a := by rw [toNat_eq_max]; apply Int.le_max_left - -@[simp] theorem le_toNat {n : Nat} {z : Int} (h : 0 ≤ z) : n ≤ z.toNat ↔ (n : Int) ≤ z := by - rw [← Int.ofNat_le, Int.toNat_of_nonneg h] - -@[simp] theorem toNat_lt {n : Nat} {z : Int} (h : 0 ≤ z) : z.toNat < n ↔ z < (n : Int) := by - rw [← Int.not_le, ← Nat.not_le, Int.le_toNat h] - -theorem toNat_add {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : (a + b).toNat = a.toNat + b.toNat := - match a, b, eq_ofNat_of_zero_le ha, eq_ofNat_of_zero_le hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => rfl - -theorem toNat_add_nat {a : Int} (ha : 0 ≤ a) (n : Nat) : (a + n).toNat = a.toNat + n := - match a, eq_ofNat_of_zero_le ha with | _, ⟨_, rfl⟩ => rfl - -@[simp] theorem pred_toNat : ∀ i : Int, (i - 1).toNat = i.toNat - 1 - | 0 => rfl - | (n+1:Nat) => by simp [ofNat_add] - | -[n+1] => rfl - -@[simp] theorem toNat_sub_toNat_neg : ∀ n : Int, ↑n.toNat - ↑(-n).toNat = n - | 0 => rfl - | (_+1:Nat) => Int.sub_zero _ - | -[_+1] => Int.zero_sub _ - -@[simp] theorem toNat_add_toNat_neg_eq_natAbs : ∀ n : Int, n.toNat + (-n).toNat = n.natAbs - | 0 => rfl - | (_+1:Nat) => Nat.add_zero _ - | -[_+1] => Nat.zero_add _ - -theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n - | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm - | -[m+1], n => by constructor <;> nofun - -@[simp] theorem toNat_neg_nat : ∀ n : Nat, (-(n : Int)).toNat = 0 - | 0 => rfl - | _+1 => rfl From bafb6c22bbdcd10626957aa9cac512d81746a183 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 1 Mar 2024 22:55:38 +1100 Subject: [PATCH 113/213] lint --- Std/Data/Int/DivMod.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 94c51c510b..4ba5091ade 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -626,7 +626,7 @@ theorem lt_of_mul_lt_mul_right {a b c : Int} (w : b * a < c * a) (h : 0 ≤ a) : -/ -@[simp] theorem emod_bmod {x : Int} {m : Nat} : bmod (x % m) m = bmod x m := by +theorem emod_bmod {x : Int} {m : Nat} : bmod (x % m) m = bmod x m := by simp [bmod] @[simp] theorem bmod_bmod : bmod (bmod x m) m = bmod x m := by From f7b73e302165e356789a0598dc397311eb51a502 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 1 Mar 2024 23:14:59 +1100 Subject: [PATCH 114/213] restore one lemma --- Std/Data/Int/Order.lean | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index c6001d4cab..3efb3be5ea 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -521,3 +521,9 @@ theorem natAbs_lt_natAbs_of_nonneg_of_lt {a b : Int} theorem eq_natAbs_iff_mul_eq_zero : natAbs a = n ↔ (a - n) * (a + n) = 0 := by rw [natAbs_eq_iff, Int.mul_eq_zero, ← Int.sub_neg, Int.sub_eq_zero, Int.sub_eq_zero] + +/-! ### toNat -/ + +theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n + | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm + | -[m+1], n => by constructor <;> nofun From 0f560206288f151891d3fb648c47f4b982eb7fcd Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 2 Mar 2024 09:13:10 +0000 Subject: [PATCH 115/213] chore: bump to nightly-2024-03-02 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index f16b484e3d..6f6f75939e 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-01 +leanprover/lean4:nightly-2024-03-02 From d0a9d566ff47a6fb99cd03fd29c5e3932abd04e6 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 2 Mar 2024 23:06:03 +1100 Subject: [PATCH 116/213] chore: adaptations for nightly-2024-03-01 (#678) * chore: adaptations for nightly-2024-03-01 * restore one lemma --- Std.lean | 1 - Std/Data/Array/Lemmas.lean | 46 +--- Std/Data/HashMap/WF.lean | 1 - Std/Data/Int/DivMod.lean | 12 +- Std/Data/Int/Order.lean | 62 ------ Std/Data/List/Basic.lean | 19 -- Std/Data/List/Lemmas.lean | 20 -- Std/Tactic/Basic.lean | 1 - Std/Tactic/ShowTerm.lean | 42 ---- lean-toolchain | 2 +- test/add_suggestion.lean | 45 ---- test/bitvec.lean | 118 ---------- test/bitvec_simproc.lean | 112 ---------- test/change.lean | 80 ------- test/coe.lean | 70 ------ test/decidability.lean | 7 - test/ext.lean | 107 --------- test/guard_msgs.lean | 52 ----- test/guardexpr.lean | 59 ----- test/int.lean | 15 -- test/json.lean | 22 -- test/left_right.lean | 66 ------ test/library_search/basic.lean | 252 ---------------------- test/norm_cast.lean | 56 +---- test/omega/benchmark.lean | 2 - test/omega/examples.lean | 57 ----- test/omega/test.lean | 382 --------------------------------- test/rcases.lean | 211 ------------------ test/repeat.lean | 12 -- test/replace.lean | 50 ----- test/run_cmd.lean | 15 -- test/show_term.lean | 1 - test/simpa.lean | 1 - test/solve_by_elim.lean | 130 ----------- test/symm.lean | 27 --- 35 files changed, 11 insertions(+), 2144 deletions(-) delete mode 100644 Std/Tactic/ShowTerm.lean delete mode 100644 test/add_suggestion.lean delete mode 100644 test/bitvec.lean delete mode 100644 test/bitvec_simproc.lean delete mode 100644 test/change.lean delete mode 100644 test/coe.lean delete mode 100644 test/decidability.lean delete mode 100644 test/ext.lean delete mode 100644 test/guard_msgs.lean delete mode 100644 test/guardexpr.lean delete mode 100644 test/int.lean delete mode 100644 test/json.lean delete mode 100644 test/left_right.lean delete mode 100644 test/library_search/basic.lean delete mode 100644 test/omega/examples.lean delete mode 100644 test/omega/test.lean delete mode 100644 test/rcases.lean delete mode 100644 test/repeat.lean delete mode 100644 test/replace.lean delete mode 100644 test/run_cmd.lean delete mode 100644 test/symm.lean diff --git a/Std.lean b/Std.lean index f4906385c5..2d3a6d9782 100644 --- a/Std.lean +++ b/Std.lean @@ -94,7 +94,6 @@ import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix import Std.Tactic.Relation.Rfl import Std.Tactic.SeqFocus -import Std.Tactic.ShowTerm import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable import Std.Tactic.Where diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 330f553080..555598b53c 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -50,26 +50,12 @@ theorem mem_data {a : α} {l : Array α} : a ∈ l.data ↔ a ∈ l := (mem_def theorem not_mem_nil (a : α) : ¬ a ∈ #[] := nofun -/-- # set -/ - -@[simp] theorem set!_is_setD : @set! = @setD := rfl - -@[simp] theorem size_setD (a : Array α) (index : Nat) (val : α) : - (Array.setD a index val).size = a.size := by - if h : index < a.size then - simp [setD, h] - else - simp [setD, h] - - /-- # get lemmas -/ theorem getElem?_mem {l : Array α} {i : Fin l.size} : l[i] ∈ l := by erw [Array.mem_def, getElem_eq_data_get] apply List.get_mem -@[simp] theorem get_eq_getElem (a : Array α) (i : Fin _) : a.get i = a[i.1] := rfl -@[simp] theorem get?_eq_getElem? (a : Array α) (i : Nat) : a.get? i = a[i]? := rfl theorem getElem_fin_eq_data_get (a : Array α) (i : Fin _) : a[i] = a.data.get i := rfl @[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) : @@ -90,12 +76,7 @@ theorem getElem?_eq_data_get? (a : Array α) (i : Nat) : a[i]? = a.data.get? i : theorem get?_eq_data_get? (a : Array α) (i : Nat) : a.get? i = a.data.get? i := getElem?_eq_data_get? .. -@[simp] theorem getD_eq_get? (a : Array α) (n d) : a.getD n d = (a.get? n).getD d := by - simp [get?, getD]; split <;> simp - -theorem get!_eq_getD [Inhabited α] (a : Array α) : a.get! n = a.getD n default := rfl - -@[simp] theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by +theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by simp [get!_eq_getD] @[simp] theorem back_eq_back? [Inhabited α] (a : Array α) : a.back = a.back?.getD default := by @@ -127,15 +108,11 @@ theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x el @[simp] theorem data_set (a : Array α) (i v) : (a.set i v).data = a.data.set i.1 v := rfl -@[simp] theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) : +theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) : (a.set i v)[i.1]'(by simp [i.2]) = v := by simp only [set, getElem_eq_data_get, List.get_set_eq] -@[simp] theorem get_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) (hj : j < a.size) - (h : i.1 ≠ j) : (a.set i v)[j]'(by simp [*]) = a[j] := by - simp only [set, getElem_eq_data_get, List.get_set_ne h] - -@[simp] theorem get?_set_eq (a : Array α) (i : Fin a.size) (v : α) : +theorem get?_set_eq (a : Array α) (i : Fin a.size) (v : α) : (a.set i v)[i.1]? = v := by simp [getElem?_pos, i.2] @[simp] theorem get?_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) @@ -150,22 +127,15 @@ theorem get_set (a : Array α) (i : Fin a.size) (j : Nat) (hj : j < a.size) (v : (a.set i v)[j]'(by simp [*]) = if i = j then v else a[j] := by if h : i.1 = j then subst j; simp [*] else simp [*] -@[simp] theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) : +@[simp] theorem get_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) (hj : j < a.size) + (h : i.1 ≠ j) : (a.set i v)[j]'(by simp [*]) = a[j] := by + simp only [set, getElem_eq_data_get, List.get_set_ne _ h] + +theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) : (setD a i v)[i]'h = v := by simp at h simp only [setD, h, dite_true, get_set, ite_true] -/-- -This lemma simplifies a normal form from `get!` --/ -@[simp] theorem getD_get?_setD (a : Array α) (i : Nat) (v d : α) : - Option.getD (setD a i v)[i]? d = if i < a.size then v else d := by - if h : i < a.size then - simp [setD, h, getElem?, get_set] - else - have p : i ≥ a.size := Nat.le_of_not_gt h - simp [setD, h, get?_len_le, p] - theorem set_set (a : Array α) (i : Fin a.size) (v v' : α) : (a.set i v).set ⟨i, by simp [i.2]⟩ v' = a.set i v' := by simp [set, List.set_set] diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index 0688ad3417..025f31252b 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -6,7 +6,6 @@ Authors: Mario Carneiro import Std.Data.HashMap.Basic import Std.Data.List.Lemmas import Std.Data.Array.Lemmas -import Std.Tactic.ShowTerm namespace Std.HashMap namespace Imp diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 383a6c2088..4ba5091ade 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -103,10 +103,6 @@ theorem ediv_neg' {a b : Int} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 := | succ _ => congrArg Nat.cast (Nat.div_one _) | -[_+1] => congrArg negSucc (Nat.div_one _) -@[simp] theorem ediv_one : ∀ a : Int, a / 1 = a - | (_:Nat) => congrArg Nat.cast (Nat.div_one _) - | -[_+1] => congrArg negSucc (Nat.div_one _) - theorem div_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.div b = 0 := match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2 @@ -155,9 +151,6 @@ theorem add_mul_ediv_left (a : Int) {b : Int} @[simp] protected theorem fdiv_self {a : Int} (H : a ≠ 0) : a.fdiv a = 1 := by have := Int.mul_fdiv_cancel 1 H; rwa [Int.one_mul] at this -@[simp] protected theorem ediv_self {a : Int} (H : a ≠ 0) : a / a = 1 := by - have := Int.mul_ediv_cancel 1 H; rwa [Int.one_mul] at this - /-! ### mod -/ theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by cases m <;> simp [fmod] @@ -242,9 +235,6 @@ theorem fmod_eq_mod {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fmod a b = mod a @[simp] theorem mod_one (a : Int) : mod a 1 = 0 := by simp [mod_def, Int.div_one, Int.one_mul, Int.sub_self] -@[local simp] theorem emod_one (a : Int) : a % 1 = 0 := by - simp [emod_def, Int.one_mul, Int.sub_self] - @[simp] theorem fmod_one (a : Int) : a.fmod 1 = 0 := by simp [fmod_def, Int.one_mul, Int.sub_self] @@ -636,7 +626,7 @@ theorem lt_of_mul_lt_mul_right {a b c : Int} (w : b * a < c * a) (h : 0 ≤ a) : -/ -@[simp] theorem emod_bmod {x : Int} {m : Nat} : bmod (x % m) m = bmod x m := by +theorem emod_bmod {x : Int} {m : Nat} : bmod (x % m) m = bmod x m := by simp [bmod] @[simp] theorem bmod_bmod : bmod (bmod x m) m = bmod x m := by diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 443ec4e28a..3efb3be5ea 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -19,17 +19,6 @@ protected alias ⟨lt_of_not_ge, not_le_of_gt⟩ := Int.not_le protected theorem le_of_not_le {a b : Int} : ¬ a ≤ b → b ≤ a := (Int.le_total a b).resolve_left -protected theorem min_eq_left {a b : Int} (h : a ≤ b) : min a b = a := by simp [Int.min_def, h] - -protected theorem min_eq_right {a b : Int} (h : b ≤ a) : min a b = b := by - rw [Int.min_comm a b]; exact Int.min_eq_left h - -protected theorem max_eq_right {a b : Int} (h : a ≤ b) : max a b = b := by - simp [Int.max_def, h, Int.not_lt.2 h] - -protected theorem max_eq_left {a b : Int} (h : b ≤ a) : max a b = a := by - rw [← Int.max_comm b a]; exact Int.max_eq_right h - @[simp] theorem negSucc_not_pos (n : Nat) : 0 < -[n+1] ↔ False := by simp only [Int.not_lt, iff_false]; constructor @@ -533,59 +522,8 @@ theorem natAbs_lt_natAbs_of_nonneg_of_lt {a b : Int} theorem eq_natAbs_iff_mul_eq_zero : natAbs a = n ↔ (a - n) * (a + n) = 0 := by rw [natAbs_eq_iff, Int.mul_eq_zero, ← Int.sub_neg, Int.sub_eq_zero, Int.sub_eq_zero] - - /-! ### toNat -/ -theorem toNat_eq_max : ∀ a : Int, (toNat a : Int) = max a 0 - | (n : Nat) => (Int.max_eq_left (ofNat_zero_le n)).symm - | -[n+1] => (Int.max_eq_right (Int.le_of_lt (negSucc_lt_zero n))).symm - -@[simp] theorem toNat_zero : (0 : Int).toNat = 0 := rfl - -@[simp] theorem toNat_one : (1 : Int).toNat = 1 := rfl - -@[simp] theorem toNat_of_nonneg {a : Int} (h : 0 ≤ a) : (toNat a : Int) = a := by - rw [toNat_eq_max, Int.max_eq_left h] - -@[simp] theorem toNat_ofNat (n : Nat) : toNat ↑n = n := rfl - -@[simp] theorem toNat_ofNat_add_one {n : Nat} : ((n : Int) + 1).toNat = n + 1 := rfl - -theorem self_le_toNat (a : Int) : a ≤ toNat a := by rw [toNat_eq_max]; apply Int.le_max_left - -@[simp] theorem le_toNat {n : Nat} {z : Int} (h : 0 ≤ z) : n ≤ z.toNat ↔ (n : Int) ≤ z := by - rw [← Int.ofNat_le, Int.toNat_of_nonneg h] - -@[simp] theorem toNat_lt {n : Nat} {z : Int} (h : 0 ≤ z) : z.toNat < n ↔ z < (n : Int) := by - rw [← Int.not_le, ← Nat.not_le, Int.le_toNat h] - -theorem toNat_add {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : (a + b).toNat = a.toNat + b.toNat := - match a, b, eq_ofNat_of_zero_le ha, eq_ofNat_of_zero_le hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => rfl - -theorem toNat_add_nat {a : Int} (ha : 0 ≤ a) (n : Nat) : (a + n).toNat = a.toNat + n := - match a, eq_ofNat_of_zero_le ha with | _, ⟨_, rfl⟩ => rfl - -@[simp] theorem pred_toNat : ∀ i : Int, (i - 1).toNat = i.toNat - 1 - | 0 => rfl - | (n+1:Nat) => by simp [ofNat_add] - | -[n+1] => rfl - -@[simp] theorem toNat_sub_toNat_neg : ∀ n : Int, ↑n.toNat - ↑(-n).toNat = n - | 0 => rfl - | (_+1:Nat) => Int.sub_zero _ - | -[_+1] => Int.zero_sub _ - -@[simp] theorem toNat_add_toNat_neg_eq_natAbs : ∀ n : Int, n.toNat + (-n).toNat = n.natAbs - | 0 => rfl - | (_+1:Nat) => Nat.add_zero _ - | -[_+1] => Nat.zero_add _ - theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm | -[m+1], n => by constructor <;> nofun - -@[simp] theorem toNat_neg_nat : ∀ n : Nat, (-(n : Int)).toNat = 0 - | 0 => rfl - | _+1 => rfl diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index 34e80890b9..804a32ff8f 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -637,25 +637,6 @@ def scanr (f : α → β → β) (b : β) (l : List α) : List β := let (b', l') := l.foldr (fun a (b', l') => (f a b', b' :: l')) (b, []) b' :: l' -/-- -Given a function `f : α → β ⊕ γ`, `partitionMap f l` maps the list by `f` -whilst partitioning the result it into a pair of lists, `List β × List γ`, -partitioning the `.inl _` into the left list, and the `.inr _` into the right List. -``` -partitionMap (id : Nat ⊕ Nat → Nat ⊕ Nat) [inl 0, inr 1, inl 2] = ([0, 2], [1]) -``` --/ -@[inline] def partitionMap (f : α → β ⊕ γ) (l : List α) : List β × List γ := go l #[] #[] where - /-- Auxiliary for `partitionMap`: - `partitionMap.go f l acc₁ acc₂ = (acc₁.toList ++ left, acc₂.toList ++ right)` - if `partitionMap f l = (left, right)`. -/ - @[specialize] go : List α → Array β → Array γ → List β × List γ - | [], acc₁, acc₂ => (acc₁.toList, acc₂.toList) - | x :: xs, acc₁, acc₂ => - match f x with - | .inl a => go xs (acc₁.push a) acc₂ - | .inr b => go xs acc₁ (acc₂.push b) - /-- Fold a list from left to right as with `foldl`, but the combining function also receives each element's index. diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 03d1fc1788..137c2e3124 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -718,12 +718,6 @@ are often used for theorems about `Array.pop`. -/ /-! ### nth element -/ -@[simp] theorem get_cons_succ {as : List α} {h : i + 1 < (a :: as).length} : - (a :: as).get ⟨i+1, h⟩ = as.get ⟨i, Nat.lt_of_succ_lt_succ h⟩ := rfl - -@[simp] theorem get_cons_succ' {as : List α} {i : Fin as.length} : - (a :: as).get i.succ = as.get i := rfl - @[simp] theorem get_cons_cons_one : (a₁ :: a₂ :: as).get (1 : Fin (as.length + 2)) = a₂ := rfl theorem get!_cons_succ [Inhabited α] (l : List α) (a : α) (n : Nat) : @@ -997,11 +991,6 @@ theorem get?_set_of_lt' (a : α) {m n} (l : List α) (h : m < length l) : (set l m a).get? n = if m = n then some a else l.get? n := by simp [get?_set]; split <;> subst_vars <;> simp [*, get?_eq_get h] -@[simp] theorem set_nil (n : Nat) (a : α) : [].set n a = [] := rfl - -@[simp] theorem set_succ (x : α) (xs : List α) (n : Nat) (a : α) : - (x :: xs).set n.succ a = x :: xs.set n a := rfl - theorem set_comm (a b : α) : ∀ {n m : Nat} (l : List α), n ≠ m → (l.set n a).set m b = (l.set m b).set n a | _, _, [], _ => by simp @@ -1015,15 +1004,6 @@ theorem set_set (a b : α) : ∀ (l : List α) (n : Nat), (l.set n a).set n b = | _ :: _, 0 => by simp [set] | _ :: _, _+1 => by simp [set, set_set] -@[simp] theorem get_set_eq (l : List α) (i : Nat) (a : α) (h : i < (l.set i a).length) : - (l.set i a).get ⟨i, h⟩ = a := by - rw [← Option.some_inj, ← get?_eq_get, get?_set_eq, get?_eq_get] <;> simp_all - -@[simp] theorem get_set_ne {l : List α} {i j : Nat} (h : i ≠ j) (a : α) - (hj : j < (l.set i a).length) : - (l.set i a).get ⟨j, hj⟩ = l.get ⟨j, by simp at hj; exact hj⟩ := by - rw [← Option.some_inj, ← get?_eq_get, get?_set_ne _ _ h, get?_eq_get] - theorem get_set (a : α) {m n} (l : List α) (h) : (set l m a).get ⟨n, h⟩ = if m = n then a else l.get ⟨n, length_set .. ▸ h⟩ := by if h : m = n then subst m; simp else simp [h] diff --git a/Std/Tactic/Basic.lean b/Std/Tactic/Basic.lean index bda6786db5..16f4b14484 100644 --- a/Std/Tactic/Basic.lean +++ b/Std/Tactic/Basic.lean @@ -2,7 +2,6 @@ import Lean.Elab.Tactic.ElabTerm import Std.Linter import Std.Tactic.Init import Std.Tactic.SeqFocus -import Std.Tactic.ShowTerm import Std.Util.ProofWanted -- This is an import only file for common tactics used throughout Std diff --git a/Std/Tactic/ShowTerm.lean b/Std/Tactic/ShowTerm.lean deleted file mode 100644 index f554cb7d64..0000000000 --- a/Std/Tactic/ShowTerm.lean +++ /dev/null @@ -1,42 +0,0 @@ -/- -Copyright (c) 2021 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison, Mario Carneiro --/ -import Lean.Elab.ElabRules -import Lean.Meta.Tactic.TryThis - -namespace Std.Tactic -open Lean Elab Tactic Meta.Tactic.TryThis - -/-- -`show_term tac` runs `tac`, then prints the generated term in the form -"exact X Y Z" or "refine X ?_ Z" if there are remaining subgoals. - -(For some tactics, the printed term will not be human readable.) --/ -elab (name := showTermTac) tk:"show_term " t:tacticSeq : tactic => withMainContext do - let g ← getMainGoal - evalTactic t - addExactSuggestion tk (← instantiateMVars (mkMVar g)).headBeta (origSpan? := ← getRef) - -/-- Implementation of `show_term`. -/ -local elab (name := showTermImpl) tk:"show_term_impl " t:term : term <= ty => do - let e ← Term.elabTermEnsuringType t ty - Term.synthesizeSyntheticMVarsNoPostponing - addTermSuggestion tk (← instantiateMVars e).headBeta (origSpan? := ← getRef) - pure e - -/-- -`show_term e` elaborates `e`, then prints the generated term. - -(For some tactics, the printed term will not be human readable.) --/ -macro (name := showTerm) tk:"show_term " t:term : term => - `(no_implicit_lambda% (show_term_impl%$tk $t)) - -/-- -The command `by?` will print a suggestion for replacing the proof block with a proof term -using `show_term`. --/ -macro (name := by?) tk:"by?" t:tacticSeq : term => `(show_term%$tk by%$tk $t) diff --git a/lean-toolchain b/lean-toolchain index 09c577cc33..f16b484e3d 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-02-27 +leanprover/lean4:nightly-2024-03-01 diff --git a/test/add_suggestion.lean b/test/add_suggestion.lean deleted file mode 100644 index c86c6a4c95..0000000000 --- a/test/add_suggestion.lean +++ /dev/null @@ -1,45 +0,0 @@ -import Lean.Meta.Tactic.TryThis - -set_option linter.unusedVariables false -set_option linter.missingDocs false - -section width --- here we test that the width of try this suggestions is not too big - --- simulate a long and complicated term -def longdef (a b : Nat) (h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h : a = b) : - 2 * a = 2 * b := by rw [h] - -namespace Lean.Meta.Tactic.TryThis -open Lean Elab Tactic - -set_option hygiene false in -elab "test" : tactic => do - addSuggestion (← getRef) (← - `(tactic| exact longdef a b h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h - h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h)) - -end Lean.Meta.Tactic.TryThis - -#guard_msgs (drop info, drop warning) in --- ideally we would have a #guard_widgets or #guard_infos too, but instead we can simply check by --- hand that the widget suggestion (not the message) fits into 100 columns -theorem asda (a b : Nat) (h : a = b) : 2 * a = 2 * b := by - test ---exact --- longdef a b h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h --- h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h --- h h h h h - have : 2 * a = 2 * b := by - test --- exact --- longdef a b h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h --- h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h h --- h h h h h h h - sorry - sorry diff --git a/test/bitvec.lean b/test/bitvec.lean deleted file mode 100644 index 4814fdd1a8..0000000000 --- a/test/bitvec.lean +++ /dev/null @@ -1,118 +0,0 @@ -import Std.Data.BitVec - -open BitVec - --- Basic arithmetic -#guard 1#12 + 2#12 = 3#12 -#guard 3#5 * 7#5 = 0x15#5 -#guard 3#4 * 7#4 = 0x05#4 - -#guard zeroExtend 4 0x7f#8 = 0xf#4 -#guard zeroExtend 12 0x7f#8 = 0x07f#12 -#guard zeroExtend 12 0x80#8 = 0x080#12 -#guard zeroExtend 16 0xff#8 = 0x00ff#16 - -#guard signExtend 4 0x7f#8 = 0xf#4 -#guard signExtend 12 0x7f#8 = 0x07f#12 -#guard signExtend 12 0x80#8 = 0xf80#12 -#guard signExtend 16 0xff#8 = 0xffff#16 - --- Division and mod/rem - -#guard 3#4 / 0 = 0 -#guard 10#4 / 2 = 5 - -#guard 8#4 % 0 = 8 -#guard 4#4 % 1 = 0 -#guard 4#4 % 3 = 1 -#guard 0xf#4 % (-2) = 1 -#guard 0xf#4 % (-8) = 7 - -#guard sdiv 6#4 2 = 3#4 -#guard sdiv 7#4 2 = 3#4 -#guard sdiv 6#4 (-2) = -3#4 -#guard sdiv 7#4 (-2) = -3#4 -#guard sdiv (-6#4) 2 = -3#4 -#guard sdiv (-7#4) 2 = -3#4 -#guard sdiv (-6#4) (-2) = 3#4 -#guard sdiv (-7#4) (-2) = 3#4 - -#guard srem 3#4 2 = 1 -#guard srem (-4#4) 3 = -1 -#guard srem ( 4#4) (-3) = 1 -#guard srem (-4#4) (-3) = -1 - -#guard smod 3#4 2 = 1 -#guard smod (-4#4) 3 = 2 -#guard smod ( 4#4) (-3) = -2 -#guard smod (-4#4) (-3) = -1 - --- ofInt/toInt - -#guard .ofInt 3 (-1) = 0b111#3 -#guard .ofInt 3 0 = 0b000#3 -#guard .ofInt 3 4 = 0b100#3 -#guard .ofInt 3 (-2) = 0b110#3 -#guard .ofInt 3 (-4) = 0b100#3 - -#guard (0x0#4).toInt = 0 -#guard (0x7#4).toInt = 7 -#guard (0x8#4).toInt = -8 -#guard (0xe#4).toInt = -2 - --- Bitwise operations - -#guard ~~~0b1010#4 = 0b0101#4 -#guard 0b1010#4 &&& 0b0110#4 = 0b0010#4 -#guard 0b1010#4 ||| 0b0110#4 = 0b1110#4 -#guard 0b1010#4 ^^^ 0b0110#4 = 0b1100#4 - --- shift operations -#guard 0b0011#4 <<< 3 = 0b1000 -#guard 0b1011#4 >>> 1 = 0b0101 -#guard sshiftRight 0b1001#4 1 = 0b1100#4 -#guard rotateLeft 0b0011#4 3 = 0b1001 -#guard rotateRight 0b0010#4 2 = 0b1000 -#guard 0xab#8 ++ 0xcd#8 = 0xabcd#16 - --- get/extract - -#guard !getMsb 0b0101#4 0 -#guard getMsb 0b0101#4 1 -#guard !getMsb 0b0101#4 2 -#guard getMsb 0b0101#4 3 -#guard !getMsb 0b1111#4 4 - -#guard getLsb 0b0101#4 0 -#guard !getLsb 0b0101#4 1 -#guard getLsb 0b0101#4 2 -#guard !getLsb 0b0101#4 3 -#guard !getLsb 0b1111#4 4 - -#guard extractLsb 3 0 0x1234#16 = 4 -#guard extractLsb 7 4 0x1234#16 = 3 -#guard extractLsb' 0 4 0x1234#16 = 0x4#4 - -/-- -This tests the match compiler with bitvector literals to ensure -it can successfully generate a pattern for a bitvector literals. - -This fixes a regression introduced in PR #366. --/ -def testMatch8 (i : BitVec 32) := - let op1 := i.extractLsb 28 25 - match op1 with - | 0b1000#4 => some 0 - | _ => none - --- Pretty-printing - -#guard toString 5#12 = "0x005#12" -#guard toString 5#13 = "0x0005#13" -#guard toString 5#12 = "0x005#12" -#guard toString 5#13 = "0x0005#13" - --- Simp - -example (n w : Nat) (p : n < 2^w) : { toFin := { val := n, isLt := p } : BitVec w} = .ofNat w n := by - simp only [ofFin_eq_ofNat] diff --git a/test/bitvec_simproc.lean b/test/bitvec_simproc.lean deleted file mode 100644 index 1013b41664..0000000000 --- a/test/bitvec_simproc.lean +++ /dev/null @@ -1,112 +0,0 @@ -/- -Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura --/ -import Std.Data.BitVec -open BitVec - -example (h : x = (6 : BitVec 3)) : x = -2 := by - simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (5 : BitVec 3)) : x = ~~~2 := by - simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : BitVec 32)) : x = BitVec.abs (-1#32) := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (5 : BitVec 3)) : x = 2 + 3 := by - simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (1 : BitVec 3)) : x = 5 &&& 3 := by - simp; guard_target =ₛ x = 1#3; assumption -example (h : x = (7 : BitVec 3)) : x = 5 ||| 3 := by - simp; guard_target =ₛ x = 7#3; assumption -example (h : x = (6 : BitVec 3)) : x = 5 ^^^ 3 := by - simp; guard_target =ₛ x = 6#3; assumption -example (h : x = (3 : BitVec 32)) : x = 5 - 2 := by - simp; guard_target =ₛ x = 3#32; assumption -example (h : x = (10 : BitVec 32)) : x = 5 * 2 := by - simp; guard_target =ₛ x = 10#32; assumption -example (h : x = (4 : BitVec 32)) : x = 9 / 2 := by - simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : BitVec 32)) : x = 9 % 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : BitVec 32)) : x = udiv 9 2 := by - simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : BitVec 32)) : x = umod 9 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (4 : BitVec 32)) : x = sdiv (-9) (-2) := by - simp; guard_target =ₛ x = 4#32; assumption -example (h : x = (1 : BitVec 32)) : x = smod (-9) 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : BitVec 32)) : x = - smtUDiv 9 0 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : BitVec 32)) : x = - srem (-9) 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : BitVec 32)) : x = - smtSDiv 9 0 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (1 : BitVec 32)) : x = smtSDiv (-9) 0 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = false) : x = (4#3).getLsb 0:= by - simp; guard_target =ₛ x = false; assumption -example (h : x = true) : x = (4#3).getLsb 2:= by - simp; guard_target =ₛ x = true; assumption -example (h : x = true) : x = (4#3).getMsb 0:= by - simp; guard_target =ₛ x = true; assumption -example (h : x = false) : x = (4#3).getMsb 2:= by - simp; guard_target =ₛ x = false; assumption -example (h : x = (24 : BitVec 32)) : x = 6#32 <<< 2 := by - simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : BitVec 32)) : x = 6#32 >>> 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (24 : BitVec 32)) : x = BitVec.shiftLeft 6#32 2 := by - simp; guard_target =ₛ x = 24#32; assumption -example (h : x = (1 : BitVec 32)) : x = BitVec.ushiftRight 6#32 2 := by - simp; guard_target =ₛ x = 1#32; assumption -example (h : x = (2 : BitVec 32)) : x = - BitVec.sshiftRight (- 6#32) 2 := by - simp; guard_target =ₛ x = 2#32; assumption -example (h : x = (5 : BitVec 3)) : x = BitVec.rotateLeft (6#3) 1 := by - simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (3 : BitVec 3)) : x = BitVec.rotateRight (6#3) 1 := by - simp; guard_target =ₛ x = 3#3; assumption -example (h : x = (7 : BitVec 5)) : x = 1#3 ++ 3#2 := by - simp; guard_target =ₛ x = 7#5; assumption -example (h : x = (1 : BitVec 3)) : x = BitVec.cast (by decide : 3=2+1) 1#3 := by - simp; guard_target =ₛ x = 1#3; assumption -example (h : x = 5) : x = (2#3 + 3#3).toNat := by - simp; guard_target =ₛ x = 5; assumption -example (h : x = -1) : x = (2#3 - 3#3).toInt := by - simp; guard_target =ₛ x = -1; assumption -example (h : x = (1 : BitVec 3)) : x = -BitVec.ofInt 3 (-1) := by - simp; guard_target =ₛ x = 1#3; assumption -example (h : x) : x = (1#3 < 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : x) : x = (BitVec.ult 1#3 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : ¬x) : x = (4#3 < 3#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : x) : x = (BitVec.slt (- 4#3) 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : x) : x = (BitVec.sle (- 4#3) 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : x) : x = (3#3 > 1#3) := by - simp; guard_target =ₛ x; assumption -example (h : ¬x) : x = (3#3 > 4#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : x) : x = (1#3 ≤ 3#3) := by - simp; guard_target =ₛ x; assumption -example (h : ¬x) : x = (4#3 ≤ 3#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : ¬x) : x = (BitVec.ule 4#3 3#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : x) : x = (3#3 ≥ 1#3) := by - simp; guard_target =ₛ x; assumption -example (h : ¬x) : x = (3#3 ≥ 4#3) := by - simp; guard_target =ₛ ¬x; assumption -example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend' (by decide) := by - simp; guard_target =ₛ x = 5#7; assumption -example (h : x = (80 : BitVec 7)) : x = (5#3).shiftLeftZeroExtend 4 := by - simp; guard_target =ₛ x = 80#7; assumption -example (h : x = (5: BitVec 3)) : x = (10#5).extractLsb' 1 3 := by - simp; guard_target =ₛ x = 5#3; assumption -example (h : x = (9: BitVec 6)) : x = (1#3).replicate 2 := by - simp; guard_target =ₛ x = 9#6; assumption -example (h : x = (5 : BitVec 7)) : x = (5#3).zeroExtend 7 := by - simp; guard_target =ₛ x = 5#7; assumption diff --git a/test/change.lean b/test/change.lean deleted file mode 100644 index 04fa47c287..0000000000 --- a/test/change.lean +++ /dev/null @@ -1,80 +0,0 @@ - -private axiom test_sorry : ∀ {α}, α - -set_option linter.missingDocs false -set_option autoImplicit true - -example : n + 2 = m := by - change n + 1 + 1 = _ - guard_target =ₛ n + 1 + 1 = m - exact test_sorry - -example (h : n + 2 = m) : False := by - change _ + 1 = _ at h - guard_hyp h :ₛ n + 1 + 1 = m - exact test_sorry - -example : n + 2 = m := by - fail_if_success change true - fail_if_success change _ + 3 = _ - fail_if_success change _ * _ = _ - change (_ : Nat) + _ = _ - exact test_sorry - --- `change ... at ...` allows placeholders to mean different things at different hypotheses -example (h : n + 3 = m) (h' : n + 2 = m) : False := by - change _ + 1 = _ at h h' - guard_hyp h :ₛ n + 2 + 1 = m - guard_hyp h' :ₛ n + 1 + 1 = m - exact test_sorry - --- `change ... at ...` preserves dependencies -example (p : n + 2 = m → Type) (h : n + 2 = m) (x : p h) : false := by - change _ + 1 = _ at h - guard_hyp x :ₛ p h - exact test_sorry - -noncomputable example : Nat := by - fail_if_success change Type 1 - exact test_sorry - -def foo (a b c : Nat) := if a < b then c else 0 - -example : foo 1 2 3 = 3 := by - change (if _ then _ else _) = _ - change ite _ _ _ = _ - change (if _ < _ then _ else _) = _ - change _ = (if true then 3 else 4) - rfl - -example (h : foo 1 2 3 = 4) : True := by - change ite _ _ _ = _ at h - guard_hyp h :ₛ ite (1 < 2) 3 0 = 4 - trivial - -example (h : foo 1 2 3 = 4) : True := by - change (if _ then _ else _) = _ at h - guard_hyp h : (if 1 < 2 then 3 else 0) = 4 - trivial - -example (α : Type) [LT α] (x : α) (h : x < x) : x < id x := by - change _ < _ -- can defer LT typeclass lookup, just like `show` - change _ < _ at h -- can defer LT typeclass lookup at h too - guard_target =ₛ x < id x - change _ < x - guard_target =ₛ x < x - exact h - --- This example shows using named and anonymous placeholders to create a new goal. -example (x y : Nat) (h : x = y) : True := by - change (if 1 < 2 then x else ?z + ?_) = y at h - rotate_left - · exact 4 - · exact 37 - guard_hyp h : (if 1 < 2 then x else 4 + 37) = y - · trivial - -example : let x := 22; let y : Nat := x; let z : Fin (y + 1) := 0; z.1 < y + 1 := by - intro x y z -- `z` was previously erroneously marked as unused - change _ at y - exact z.2 diff --git a/test/coe.lean b/test/coe.lean deleted file mode 100644 index 2edede07ff..0000000000 --- a/test/coe.lean +++ /dev/null @@ -1,70 +0,0 @@ -import Lean.Meta.CoeAttr - -set_option linter.missingDocs false - -structure WrappedNat where - val : Nat - - -structure WrappedFun (α) where - fn : Nat → α - - -structure WrappedType where - typ : Type - -attribute [coe] WrappedNat.val -instance : Coe WrappedNat Nat where coe := WrappedNat.val - -#eval Lean.Meta.registerCoercion ``WrappedFun.fn (some ⟨2, 1, .coeFun⟩) -instance : CoeFun (WrappedFun α) (fun _ => Nat → α) where coe := WrappedFun.fn - -#eval Lean.Meta.registerCoercion ``WrappedType.typ (some ⟨1, 0, .coeSort⟩) -instance : CoeSort WrappedType Type where coe := WrappedType.typ - -section coe -variable (n : WrappedNat) - -/-- info: ↑n : Nat -/ -#guard_msgs in #check n.val -/-- info: ↑n : Nat -/ -#guard_msgs in #check (↑n : Nat) - -end coe - -section coeFun -variable (f : WrappedFun Nat) (g : Nat → WrappedFun Nat) (h : WrappedFun (WrappedFun Nat)) - -/-- info: ⇑f : Nat → Nat -/ -#guard_msgs in #check f.fn -/-- info: ⇑f : Nat → Nat -/ -#guard_msgs in #check ⇑f --- applied functions do not need the `⇑` -/-- info: f 1 : Nat -/ -#guard_msgs in #check ⇑f 1 - -/-- info: ⇑(g 1) : Nat → Nat -/ -#guard_msgs in #check ⇑(g 1) -/-- info: (g 1) 2 : Nat -/ -- TODO: remove the `()`? -#guard_msgs in #check g 1 2 - -/-- info: ⇑h : Nat → WrappedFun Nat -/ -#guard_msgs in #check ⇑h -/-- info: h 1 : WrappedFun Nat -/ -#guard_msgs in #check h 1 -/-- info: ⇑(h 1) : Nat → Nat -/ -#guard_msgs in #check ⇑(h 1) -/-- info: (h 1) 2 : Nat -/ -- TODO: remove the `()`? -#guard_msgs in #check h 1 2 - -end coeFun - -section coeSort -variable (t : WrappedType) - -/-- info: ↥t : Type -/ -#guard_msgs in #check t.typ -/-- info: ↥t : Type -/ -#guard_msgs in #check ↥t - -end coeSort diff --git a/test/decidability.lean b/test/decidability.lean deleted file mode 100644 index 4b14856db7..0000000000 --- a/test/decidability.lean +++ /dev/null @@ -1,7 +0,0 @@ -import Std.Data.Nat.Lemmas - --- Prior to leanprover/lean4#2552 there was a performance trap --- depending on the implementation details in `decidableBallLT`. --- We keep this example (which would have gone over maxHeartbeats) --- as a regression test for the instance. -example : ∀ m, m < 25 → ∀ n, n < 25 → ∀ c, c < 25 → m ^ 2 + n ^ 2 + c ^ 2 ≠ 7 := by decide diff --git a/test/ext.lean b/test/ext.lean deleted file mode 100644 index 84f718d12f..0000000000 --- a/test/ext.lean +++ /dev/null @@ -1,107 +0,0 @@ -import Std.Logic - -set_option linter.missingDocs false -axiom mySorry {α : Sort _} : α - -structure A (n : Nat) where - a : Nat - -example (a b : A n) : a = b ∨ True := by - fail_if_success - apply Or.inl; ext - exact Or.inr trivial - -structure B (n) extends A n where - b : Nat - h : b > 0 - i : Fin b - -@[ext] structure C (n) extends B n where - c : Nat - -example (a b : C n) : a = b := by - ext - guard_target = a.a = b.a; exact mySorry - guard_target = a.b = b.b; exact mySorry - guard_target = HEq a.i b.i; exact mySorry - guard_target = a.c = b.c; exact mySorry - -@[ext (flat := false)] structure C' (n) extends B n where - c : Nat - -example (a b : C' n) : a = b := by - ext - guard_target = a.toB = b.toB; exact mySorry - guard_target = a.c = b.c; exact mySorry - -example (f g : Nat × Nat → Nat) : f = g := by - ext ⟨x, y⟩ - guard_target = f (x, y) = g (x, y); exact mySorry - --- Check that we generate a warning if there are too many patterns. -/-- warning: `ext` did not consume the patterns: [j] [linter.unusedRCasesPattern] -/ -#guard_msgs in -example (f g : Nat → Nat) (h : f = g) : f = g := by - ext i j - exact h ▸ rfl - --- allow more specific ext theorems -@[ext high] theorem Fin.zero_ext (a b : Fin 0) : True → a = b := by cases a.isLt -example (a b : Fin 0) : a = b := by ext; exact True.intro - -def Set (α : Type u) := α → Prop -@[ext] structure LocalEquiv (α : Type u) (β : Type v) where - source : Set α -@[ext] structure Pretrivialization {F : Type u} (proj : Z → β) extends LocalEquiv Z (β × F) where - baseSet : Set β - source_eq : source = baseSet ∘ proj - -structure MyUnit - -@[ext high] theorem MyUnit.ext1 (x y : MyUnit) (_h : 0 = 1) : x = y := rfl -@[ext high] theorem MyUnit.ext2 (x y : MyUnit) (_h : 1 = 1) : x = y := rfl -@[ext] theorem MyUnit.ext3 (x y : MyUnit) (_h : 2 = 1) : x = y := rfl - -example (x y : MyUnit) : x = y := by ext; rfl - --- Check that we don't generate a warning when `x` only uses a pattern in one branch: -example (f : ℕ × (ℕ → ℕ)) : f = f := by - ext x - · rfl - · guard_target = (f.2) x = (f.2) x - rfl - -example (f : Empty → Empty) : f = f := by - ext ⟨⟩ - -@[ext] theorem ext_intros {n m : Nat} (w : ∀ n m : Nat, n = m) : n = m := by apply w - -#guard_msgs (drop warning) in -example : 3 = 7 := by - ext : 1 - rename_i n m - guard_target = n = m - admit - -#guard_msgs (drop warning) in -example : 3 = 7 := by - ext n m : 1 - guard_target = n = m - admit - -section erasing_ext_attribute - -def f (p : Int × Int) : Int × Int := (p.2, p.1) - -example : f ∘ f = id := by - ext ⟨a, b⟩ - · simp [f] - · simp [f] - -attribute [-ext] Prod.ext - -example : f ∘ f = id := by - ext ⟨a, b⟩ - simp [f] - -end erasing_ext_attribute diff --git a/test/guard_msgs.lean b/test/guard_msgs.lean deleted file mode 100644 index 96d89f5aaa..0000000000 --- a/test/guard_msgs.lean +++ /dev/null @@ -1,52 +0,0 @@ - -#guard_msgs in -/-- error: unknown identifier 'x' -/ -#guard_msgs in -example : α := x - -/-- -error: unknown identifier 'x' ---- -error: ❌ Docstring on `#guard_msgs` does not match generated message: - -error: unknown identifier 'x' --/ -#guard_msgs in -#guard_msgs in -example : α := x - -#guard_msgs in -/-- warning: declaration uses 'sorry' -/ -#guard_msgs in -example : α := sorry - -#guard_msgs in -/-- warning: declaration uses 'sorry' -/ -#guard_msgs(warning) in -example : α := sorry - -/-- warning: declaration uses 'sorry' -/ -#guard_msgs in -#guard_msgs(error) in -example : α := sorry - -#guard_msgs in -#guard_msgs(drop warning) in -example : α := sorry - -#guard_msgs in -#guard_msgs(error, drop warning) in -example : α := sorry - -#guard_msgs in -/-- error: unknown identifier 'x' -/ -#guard_msgs(error, drop warning) in -example : α := x - -#guard_msgs in -/-- -error: failed to synthesize instance - OfNat α 22 --/ -#guard_msgs(error) in -example : α := 22 diff --git a/test/guardexpr.lean b/test/guardexpr.lean deleted file mode 100644 index caee2e81df..0000000000 --- a/test/guardexpr.lean +++ /dev/null @@ -1,59 +0,0 @@ -import Std.Tactic.Basic - -example (n : Nat) : Nat := by - guard_hyp n :ₛ Nat - let m : Nat := 1 - guard_expr 1 =ₛ (by exact 1) - fail_if_success guard_expr 1 = (by exact 2) - guard_hyp m := 1 - guard_hyp m : (fun x => x) Nat :=~ id 1 - guard_target = Nat - have : 1 = 1 := by conv => - guard_hyp m := 1 - guard_expr ‹Nat› = m - fail_if_success guard_target = 1 - lhs - guard_target = 1 - exact 0 - --- Now with a generic type to test that default instances work correctly -example [∀ n, OfNat α n] (n : α) : α := by - guard_hyp n - fail_if_success guard_hyp m - guard_hyp n :ₛ α - let q : α := 1 - guard_expr (1 : α) =ₛ 1 - fail_if_success guard_expr 1 =ₛ (2 : α) - fail_if_success guard_expr 1 =ₛ (by exact (2 : α)) - guard_hyp q := 1 - guard_hyp q : α := 1 - guard_hyp q : (fun x => x) α :=~ id 1 - guard_target = α - have : (1 : α) = 1 := by conv => - guard_hyp q := 1 - guard_expr ‹α› = q - fail_if_success guard_target = 1 - lhs - guard_target = 1 - exact 0 - -#guard_expr 1 = 1 -#guard_expr 1 =ₛ 1 -#guard_expr 2 = 1 + 1 - -section -variable {α : Type} [∀ n, OfNat α n] -#guard_expr (1 : α) = 1 -end - -#guard true -#guard 2 == 1 + 1 -#guard 2 = 1 + 1 - -instance (p : Bool → Prop) [DecidablePred p] : Decidable (∀ b, p b) := - if h : p false ∧ p true then - isTrue (by { intro b; cases h; cases b <;> assumption }) - else - isFalse (by { intro h'; simp [h'] at h }) - -#guard ∀ (b : Bool), b = !!b diff --git a/test/int.lean b/test/int.lean deleted file mode 100644 index 65397bfaca..0000000000 --- a/test/int.lean +++ /dev/null @@ -1,15 +0,0 @@ - --- complement -#guard ~~~(-1:Int) = 0 -#guard ~~~(0:Int) = -1 -#guard ~~~(1:Int) = -2 -#guard ~~~(-2:Int) = 1 - --- shiftRight -#guard (2:Int) >>> 1 = 1 -#guard (0:Int) >>> 1 = 0 -#guard ~~~(1:Int) >>> 1 = ~~~0 -#guard ~~~(0:Int) >>> 1 = ~~~0 -#guard ~~~(2:Int) >>> 1 = ~~~1 -#guard ~~~(4:Int) >>> 1 = ~~~2 -#guard ~~~(4:Int) >>> 2 = ~~~1 diff --git a/test/json.lean b/test/json.lean deleted file mode 100644 index 8755ab9126..0000000000 --- a/test/json.lean +++ /dev/null @@ -1,22 +0,0 @@ -import Lean.Data.Json.Elab - -/-- info: {"lookACalc": 131, - "lemonCount": 100000000000000000000000000000000, - "isCool": true, - "isBug": null, - "hello": "world", - "cheese": ["edam", "cheddar", {"rank": 100.2, "kind": "spicy"}]}-/ -#guard_msgs in -#eval json% { - hello : "world", - cheese : ["edam", "cheddar", {kind : "spicy", rank : 100.2}], - lemonCount : 100e30, - isCool : true, - isBug : null, - lookACalc: $(23 + 54 * 2) -} - --- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/json.20elaborator -example : Lean.Json := Id.run do - let _x := true - return json% {"x" : 1} diff --git a/test/left_right.lean b/test/left_right.lean deleted file mode 100644 index cf65bee79c..0000000000 --- a/test/left_right.lean +++ /dev/null @@ -1,66 +0,0 @@ - -/-- Construct a natural number using `left`. -/ -def zero : Nat := by - left - -example : zero = 0 := rfl - -/-- Construct a natural number using `right`. -/ -def two : Nat := by - right - exact 1 - -example : two = 2 := rfl - -set_option linter.missingDocs false - -/-- -error: tactic 'left' failed, -left tactic works for inductive types with exactly 2 constructors -⊢ Unit --/ -#guard_msgs in -example : Unit := by - left - -inductive F -| a | b | c - -/-- -error: tactic 'left' failed, -left tactic works for inductive types with exactly 2 constructors -⊢ F --/ -#guard_msgs in -example : F := by - left - -def G := Nat - -/-- Look through definitions. -/ -example : G := by - left - -/-- -error: tactic 'left' failed, target is not an inductive datatype -⊢ Type --/ -#guard_msgs in -example : Type := by - left - -example : Sum Nat (List Nat) := by - left - exact zero - -example : Sum Nat (List Nat) := by - right - exact [0] - -example : (1 = 1) ∨ (2 = 3) := by - left - rfl - -example : (1 = 2) ∨ (3 = 3) := by - right - rfl diff --git a/test/library_search/basic.lean b/test/library_search/basic.lean deleted file mode 100644 index 4879724e05..0000000000 --- a/test/library_search/basic.lean +++ /dev/null @@ -1,252 +0,0 @@ -import Std -set_option autoImplicit true - --- Enable this option for tracing: --- set_option trace.Tactic.stdLibrarySearch true --- And this option to trace all candidate lemmas before application. --- set_option trace.Tactic.stdLibrarySearch.lemmas true - --- Many of the tests here are quite volatile, --- and when changes are made to `solve_by_elim` or `exact?`, --- or the library itself, the printed messages change. --- Hence many of the tests here use `#guard_msgs (drop info)`, --- and do not actually verify the particular output, just that `exact?` succeeds. --- We keep the most recent output as a comment --- (not a doc-comment: so `#guard_msgs` doesn't check it) --- for reference. --- If you find further tests failing please: --- 1. update the comment using the code action on `#guard_msgs` --- 2. (optional) add `(drop info)` after `#guard_msgs` and change the doc-comment to a comment - -noncomputable section - -/-- info: Try this: exact Nat.lt.base x -/ -#guard_msgs in -example (x : Nat) : x ≠ x.succ := Nat.ne_of_lt (by apply?) - -/-- info: Try this: exact Nat.zero_lt_succ 1 -/ -#guard_msgs in -example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by apply?) - -example : 0 ≠ 1 + 1 := Nat.ne_of_lt (by exact Fin.size_pos') - -/-- info: Try this: exact Nat.add_comm x y -/ -#guard_msgs in -example (x y : Nat) : x + y = y + x := by apply? - -/-- info: Try this: exact fun a => Nat.add_le_add_right a k -/ -#guard_msgs in -example (n m k : Nat) : n ≤ m → n + k ≤ m + k := by apply? - -/-- info: Try this: exact Nat.mul_dvd_mul_left a w -/ -#guard_msgs in -example (ha : a > 0) (w : b ∣ c) : a * b ∣ a * c := by apply? - --- Could be any number of results (`Int.one`, `Int.zero`, etc) -#guard_msgs (drop info) in -example : Int := by apply? - -/-- info: Try this: Nat.lt.base x -/ -#guard_msgs in -example : x < x + 1 := exact?% - -/-- info: Try this: exact p -/ -#guard_msgs in -example (P : Prop) (p : P) : P := by apply? -/-- info: Try this: exact False.elim (np p) -/ -#guard_msgs in -example (P : Prop) (p : P) (np : ¬P) : false := by apply? -/-- info: Try this: exact h x rfl -/ -#guard_msgs in -example (X : Type) (P : Prop) (x : X) (h : ∀ x : X, x = x → P) : P := by apply? - --- Could be any number of results (`fun x => x`, `id`, etc) -#guard_msgs (drop info) in -example (α : Prop) : α → α := by apply? - --- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example (p : Prop) : (¬¬p) → p := by apply? -- says: `exact not_not.mp` --- example (a b : Prop) (h : a ∧ b) : a := by apply? -- says: `exact h.left` --- example (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by apply? -- say: `exact Function.mtr` - -/-- info: Try this: exact Nat.add_comm a b -/ -#guard_msgs in -example (a b : Nat) : a + b = b + a := -by apply? - -/-- info: Try this: exact Nat.mul_sub_left_distrib n m k -/ -#guard_msgs in -example (n m k : Nat) : n * (m - k) = n * m - n * k := -by apply? - -attribute [symm] Eq.symm - -/-- info: Try this: exact Eq.symm (Nat.mul_sub_left_distrib n m k) -/ -#guard_msgs in -example (n m k : Nat) : n * m - n * k = n * (m - k) := by - apply? - -/-- info: Try this: exact eq_comm -/ -#guard_msgs in -example {α : Type} (x y : α) : x = y ↔ y = x := by apply? - -/-- info: Try this: exact Nat.add_pos_left ha b -/ -#guard_msgs in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? - -/-- info: Try this: exact Nat.add_pos_left ha b -/ -#guard_msgs in --- Verify that if maxHeartbeats is 0 we don't stop immediately. -set_option maxHeartbeats 0 in -example (a b : Nat) (ha : 0 < a) (_hb : 0 < b) : 0 < a + b := by apply? - -section synonym - -/-- info: Try this: exact Nat.add_pos_left ha b -/ -#guard_msgs in -example (a b : Nat) (ha : a > 0) (_hb : 0 < b) : 0 < a + b := by apply? - -/-- info: Try this: exact Nat.le_of_dvd w h -/ -#guard_msgs in -example (a b : Nat) (h : a ∣ b) (w : b > 0) : a ≤ b := -by apply? - -/-- info: Try this: exact Nat.le_of_dvd w h -/ -#guard_msgs in -example (a b : Nat) (h : a ∣ b) (w : b > 0) : b ≥ a := by apply? - --- TODO: A lemma with head symbol `¬` can be used to prove `¬ p` or `⊥` -/-- info: Try this: exact Nat.not_lt_zero a -/ -#guard_msgs in -example (a : Nat) : ¬ (a < 0) := by apply? -/-- info: Try this: exact Nat.not_succ_le_zero a h -/ -#guard_msgs in -example (a : Nat) (h : a < 0) : False := by apply? - --- An inductive type hides the constructor's arguments enough --- so that `apply?` doesn't accidentally close the goal. -inductive P : Nat → Prop - | gt_in_head {n : Nat} : n < 0 → P n - --- This lemma with `>` as its head symbol should also be found for goals with head symbol `<`. -theorem lemma_with_gt_in_head (a : Nat) (h : P a) : 0 > a := by cases h; assumption - --- This lemma with `false` as its head symbols should also be found for goals with head symbol `¬`. -theorem lemma_with_false_in_head (a b : Nat) (_h1 : a < b) (h2 : P a) : False := by - apply Nat.not_lt_zero; cases h2; assumption - -/-- info: Try this: exact lemma_with_gt_in_head a h -/ -#guard_msgs in -example (a : Nat) (h : P a) : 0 > a := by apply? -/-- info: Try this: exact lemma_with_gt_in_head a h -/ -#guard_msgs in -example (a : Nat) (h : P a) : a < 0 := by apply? - -/-- info: Try this: exact lemma_with_false_in_head a b h1 h2 -/ -#guard_msgs in -example (a b : Nat) (h1 : a < b) (h2 : P a) : False := by apply? - --- TODO this no longer works: --- example (a b : Nat) (h1 : a < b) : ¬ (P a) := by apply? -- says `exact lemma_with_false_in_head a b h1` - -end synonym - -/-- info: Try this: exact fun P => iff_not_self -/ -#guard_msgs in -example : ∀ P : Prop, ¬(P ↔ ¬P) := by apply? - --- We even find `iff` results: -/-- info: Try this: exact (Nat.dvd_add_iff_left h₁).mpr h₂ -/ -#guard_msgs in -example {a b c : Nat} (h₁ : a ∣ c) (h₂ : a ∣ b + c) : a ∣ b := by apply? - --- Note: these examples no longer work after we turned off lemmas with discrimination key `#[*]`. --- example {α : Sort u} (h : Empty) : α := by apply? -- says `exact Empty.elim h` --- example (f : A → C) (g : B → C) : (A ⊕ B) → C := by apply? -- says `exact Sum.elim f g` --- example (n : Nat) (r : ℚ) : ℚ := by apply? using n, r -- exact nsmulRec n r - -opaque f : Nat → Nat -axiom F (a b : Nat) : f a ≤ f b ↔ a ≤ b - -/-- info: Try this: exact (F a b).mpr h -/ -#guard_msgs in -example (a b : Nat) (h : a ≤ b) : f a ≤ f b := by apply? - -/-- info: Try this: exact List.join L -/ -#guard_msgs in -example (L : List (List Nat)) : List Nat := by apply? using L - --- Could be any number of results -#guard_msgs (drop info) in -example (P _Q : List Nat) (h : Nat) : List Nat := by apply? using h, P - --- Could be any number of results -#guard_msgs (drop info) in -example (l : List α) (f : α → β ⊕ γ) : List β × List γ := by - apply? using f -- partitionMap f l - --- Could be any number of results (`Nat.mul n m`, `Nat.add n m`, etc) -#guard_msgs (drop info) in -example (n m : Nat) : Nat := by apply? using n, m - -#guard_msgs (drop info) in -example (P Q : List Nat) (_h : Nat) : List Nat := by exact? using P, Q - --- Check that we don't use sorryAx: --- (see https://github.com/leanprover-community/mathlib4/issues/226) -theorem Bool_eq_iff {A B : Bool} : (A = B) = (A ↔ B) := - by (cases A <;> cases B <;> simp) - -/-- info: Try this: exact Bool_eq_iff -/ -#guard_msgs in -theorem Bool_eq_iff2 {A B : Bool} : (A = B) = (A ↔ B) := by - apply? -- exact Bool_eq_iff - --- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/library_search.20regression/near/354025788 --- Disabled for Std ---/-- info: Try this: exact surjective_quot_mk r -/ ---#guard_msgs in ---example {r : α → α → Prop} : Function.Surjective (Quot.mk r) := by exact? - --- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/library_search.20failing.20to.20apply.20symm --- Disabled for Std --- /-- info: Try this: exact Iff.symm Nat.prime_iff -/ ---#guard_msgs in ---example (n : Nat) : Prime n ↔ Nat.Prime n := by --- exact? - --- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/exact.3F.20recent.20regression.3F/near/387691588 --- Disabled for Std ---lemma ex' (x : Nat) (_h₁ : x = 0) (h : 2 * 2 ∣ x) : 2 ∣ x := by --- exact? says exact dvd_of_mul_left_dvd h - --- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/apply.3F.20failure/near/402534407 --- Disabled for Std ---example (P Q : Prop) (h : P → Q) (h' : ¬Q) : ¬P := by --- exact? says exact mt h h' - --- Removed until we come up with a way of handling nonspecific lemmas --- that does not pollute the output or cause too much slow-down. --- -- Example from https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/Exact.3F.20fails.20on.20le_antisymm/near/388993167 --- set_option linter.unreachableTactic false in --- example {x y : ℝ} (hxy : x ≤ y) (hyx : y ≤ x) : x = y := by --- -- This example non-deterministically picks between `le_antisymm hxy hyx` and `ge_antisymm hyx hxy`. --- first --- | exact? says exact le_antisymm hxy hyx --- | exact? says exact ge_antisymm hyx hxy - -/-- -info: Try this: refine Int.mul_ne_zero ?a0 h ---- -warning: declaration uses 'sorry' --/ -#guard_msgs in -example {x : Int} (h : x ≠ 0) : 2 * x ≠ 0 := by - apply? using h - --- Check that adding `with_reducible` prevents expensive kernel reductions. --- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/.60exact.3F.60.20failure.3A.20.22maximum.20recursion.20depth.20has.20been.20reached.22/near/417649319 -/-- info: Try this: exact Nat.add_comm n m -/ -#guard_msgs in -example (_h : List.range 10000 = List.range 10000) (n m : Nat) : n + m = m + n := by - with_reducible exact? diff --git a/test/norm_cast.lean b/test/norm_cast.lean index ea57642f1b..956faedd97 100644 --- a/test/norm_cast.lean +++ b/test/norm_cast.lean @@ -1,77 +1,23 @@ import Std.Data.Rat.Lemmas /-! -# Tests for norm_cast +# Tests for norm_cast involving `Rat`. -/ - set_option linter.missingDocs false -- set_option trace.Meta.Tactic.simp true -variable (an bn cn dn : Nat) (az bz cz dz : Int) variable (aq bq cq dq : Rat) -example : (an : Int) = bn → an = bn := by intro h; exact_mod_cast h -example : an = bn → (an : Int) = bn := by intro h; exact_mod_cast h example : az = bz ↔ (az : Rat) = bz := by norm_cast -example : (an : Int) < bn ↔ an < bn := by norm_cast -example : (an : Int) ≠ (bn : Int) ↔ an ≠ bn := by norm_cast - -- zero and one cause special problems -example : az > (1 : Nat) ↔ az > 1 := by norm_cast -example : az > (0 : Nat) ↔ az > 0 := by norm_cast -example : (an : Int) ≠ 0 ↔ an ≠ 0 := by norm_cast example : aq < (1 : Nat) ↔ (aq : Rat) < (1 : Int) := by norm_cast -example (a b : Nat) (h : False) : (a : Int) < ((2 * b : Nat) : Int) := by - push_cast - guard_target = (a : Int) < 2 * (b : Int) - cases h - -example : (an : Int) + bn = (an + bn : Nat) := by norm_cast - -example (h : ((an + bn : Nat) : Int) = (an : Int) + (bn : Int)) : True := by - push_cast at h - guard_hyp h : (an : Int) + (bn : Int) = (an : Int) + (bn : Int) - trivial - -example (h : ((an * bn : Nat) : Int) = (an : Int) * (bn : Int)) : True := by - push_cast at h - guard_hyp h : (an : Int) * (bn : Int) = (an : Int) * (bn : Int) - trivial - --testing numerals -example : ((42 : Nat) : Int) = 42 := by norm_cast example : ((42 : Nat) : Rat) = 42 := by norm_cast example : ((42 : Int) : Rat) = 42 := by norm_cast -structure p (n : Int) -example : p 42 := by - norm_cast - guard_target = p 42 - exact ⟨⟩ - -- We don't yet have `{n m : Int} : (↑n : Rat) ≤ ↑m ↔ n ≤ m` in Std -- example (n : Int) (h : n + 1 > 0) : ((n + 1 : Int) : Rat) > 0 := by exact_mod_cast h - -example : an + bn = 1 ↔ (an + bn : Int) = 1 := by norm_cast - -example (h : bn ≤ an) : an - bn = 1 ↔ (an - bn : Int) = 1 := by norm_cast - -example (k : Nat) {x y : Nat} (h : ((x + y + k : Nat) : Int) = 0) : x + y + k = 0 := by - push_cast at h - guard_hyp h : (x : Int) + y + k = 0 - assumption_mod_cast - -example (a b : Nat) (h2 : ((a + b + 0 : Nat) : Int) = 10) : - ((a + b : Nat) : Int) = 10 := by - push_cast - push_cast [Int.add_zero] at h2 - exact h2 - -theorem b (_h g : true) : true ∧ true := by - constructor - assumption_mod_cast - assumption_mod_cast diff --git a/test/omega/benchmark.lean b/test/omega/benchmark.lean index 8df5b77417..f3a5113dd1 100644 --- a/test/omega/benchmark.lean +++ b/test/omega/benchmark.lean @@ -311,8 +311,6 @@ example (x y : Int) (h : x < y) : x ≠ y := by omega example (x y : Int) (h : x < y) : ¬ x = y := by omega -example (x : Int) : id x ≥ x := by omega - example (prime : Nat → Prop) (x y z : Int) (h1 : 2 * x + ((-3) * y) < 0) (h2 : (-4) * x + 2* z < 0) (h3 : 12 * y + (-4) * z < 0) (_ : prime 7) : False := by omega diff --git a/test/omega/examples.lean b/test/omega/examples.lean deleted file mode 100644 index 8e6603435e..0000000000 --- a/test/omega/examples.lean +++ /dev/null @@ -1,57 +0,0 @@ - --- Turn on `trace.omega` to get detailed information about the processing of hypotheses, --- and the justification of the contradiction found. --- set_option trace.omega true - --- Inequalities -example {x y : Nat} (_ : x + y > 10) (_ : x < 5) (_ : y < 5) : False := by omega - --- Tightening inequalities over `Int` or `Nat` -example {x y : Nat} (_ : x + y > 10) (_ : 2 * x < 11) (_ : y < 5) : False := by omega - --- GCDs not dividing constant terms -example {x y : Nat} (_ : 2 * x + 4 * y = 5) : False := by omega - --- Eliminating variables even when no coefficient is ±1 -example {x y : Nat} (_ : 6 * x + 7 * y = 5) : False := by omega - --- Case bashing on `Nat.sub` -example {x y z : Nat} (_ : x - y - z = 0) (_ : x > y + z) : False := by omega - --- Division with constant denominators -example {x y : Nat} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 4) : False := by omega - --- Annoying casts -example {x : Nat} : 1 < (1 + ((x + 1 : Nat) : Int) + 2) / 2 := by omega - --- Divisibility -example {x : Nat} (_ : 10000 ∣ x) (_ : ¬ 100 ∣ x) : False := by omega - --- Mod -example (x : Nat) : x % 1024 - x % 2048 = 0 := by omega - --- Systems of equations -example (a b c d e : Int) - (ha : 2 * a + b + c + d + e = 4) - (hb : a + 2 * b + c + d + e = 5) - (hc : a + b + 2 * c + d + e = 6) - (hd : a + b + c + 2 * d + e = 7) - (he : a + b + c + d + 2 * e = 8) : e = 3 := by omega - --- Case bashing on disjunctions -example (a b c d e : Int) - (ha : 2 * a + b + c + d + e = 4) - (hb : a + 2 * b + c + d + e = 5) - (hc : a + b + 2 * c + d + e = 6) - (hd : a + b + c + 2 * d + e = 7) - (he : a + b + c + d + 2 * e = 8 ∨ e = 3) : e = 3 := by omega - --- Case bashing conjunctions in the goal -example (ε : Int) (_ : ε > 0) : (ε - 2 ≤ ε / 3 + ε / 2 + ε / 2) ∧ (ε / 3 + ε / 4 + ε / 5 ≤ ε) := by - omega - --- Fast results with duplicated hypotheses -example {x : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : 2 * x + 1 ≤ 0) : False := by - iterate 64 have := h₁ - iterate 64 have := h₂ - omega diff --git a/test/omega/test.lean b/test/omega/test.lean deleted file mode 100644 index 3e136fb1fa..0000000000 --- a/test/omega/test.lean +++ /dev/null @@ -1,382 +0,0 @@ - -example : True := by - fail_if_success omega - trivial - --- set_option trace.omega true -example (_ : (1 : Int) < (0 : Int)) : False := by omega - -example (_ : (0 : Int) < (0 : Int)) : False := by omega -example (_ : (0 : Int) < (1 : Int)) : True := by (fail_if_success omega); trivial - -example {x : Int} (_ : 0 ≤ x) (_ : x ≤ 1) : True := by (fail_if_success omega); trivial -example {x : Int} (_ : 0 ≤ x) (_ : x ≤ -1) : False := by omega - -example {x : Int} (_ : x % 2 < x - 2 * (x / 2)) : False := by omega -example {x : Int} (_ : x % 2 > 5) : False := by omega - -example {x : Int} (_ : 2 * (x / 2) > x) : False := by omega -example {x : Int} (_ : 2 * (x / 2) ≤ x - 2) : False := by omega - -example {x : Nat} : x / 0 = 0 := by omega -example {x : Int} : x / 0 = 0 := by omega - -example {x : Int} : x / 2 + x / (-2) = 0 := by omega - -example {x : Nat} (_ : x ≠ 0) : 0 < x := by omega - -example {x y z : Nat} (_ : a ≤ c) (_ : b ≤ c) : a < Nat.succ c := by omega - -example (_ : 7 < 3) : False := by omega -example (_ : 0 < 0) : False := by omega - -example {x : Nat} (_ : x > 7) (_ : x < 3) : False := by omega -example {x : Nat} (_ : x ≥ 7) (_ : x ≤ 3) : False := by omega - -example {x y : Nat} (_ : x + y > 10) (_ : x < 5) (_ : y < 5) : False := by omega - -example {x y : Int} (_ : x + y > 10) (_ : 2 * x < 11) (_ : y < 5) : False := by omega -example {x y : Nat} (_ : x + y > 10) (_ : 2 * x < 11) (_ : y < 5) : False := by omega - -example {x y : Int} (_ : 2 * x + 4 * y = 5) : False := by omega -example {x y : Nat} (_ : 2 * x + 4 * y = 5) : False := by omega - -example {x y : Int} (_ : 6 * x + 7 * y = 5) : True := by (fail_if_success omega); trivial - -example {x y : Nat} (_ : 6 * x + 7 * y = 5) : False := by omega - -example {x y : Nat} (_ : x * 6 + y * 7 = 5) : False := by omega -example {x y : Nat} (_ : 2 * (3 * x) + y * 7 = 5) : False := by omega -example {x y : Nat} (_ : 2 * x * 3 + y * 7 = 5) : False := by omega -example {x y : Nat} (_ : 2 * 3 * x + y * 7 = 5) : False := by omega - -example {x : Nat} (_ : x < 0) : False := by omega - -example {x y z : Int} (_ : x + y > z) (_ : x < 0) (_ : y < 0) (_ : z > 0) : False := by omega - -example {x y : Nat} (_ : x - y = 0) (_ : x > y) : False := by - fail_if_success omega (config := { splitNatSub := false }) - omega - -example {x y z : Int} (_ : x - y - z = 0) (_ : x > y + z) : False := by omega - -example {x y z : Nat} (_ : x - y - z = 0) (_ : x > y + z) : False := by omega - -example {a b c d e f : Nat} (_ : a - b - c - d - e - f = 0) (_ : a > b + c + d + e + f) : - False := by - omega - -example {x y : Nat} (h₁ : x - y ≤ 0) (h₂ : y < x) : False := by omega - -example {x y : Int} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 6) : False := by omega - -example {x y : Nat} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 6) : False := by omega - -example {x y : Nat} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 4) : False := by omega - -example {x y : Nat} (_ : x / 2 - y / 3 < x % 2) (_ : 3 * x ≥ 2 * y + 4) : False := by omega - -example {x : Int} (h₁ : 5 ≤ x) (h₂ : x ≤ 4) : False := by omega - -example {x : Nat} (h₁ : 5 ≤ x) (h₂ : x ≤ 4) : False := by omega - -example {x : Nat} (h₁ : x / 3 ≥ 2) (h₂ : x < 6) : False := by omega - -example {x : Int} {y : Nat} (_ : 0 < x) (_ : x + y ≤ 0) : False := by omega - -example {a b c : Nat} (_ : a - (b - c) ≤ 5) (_ : b ≥ c + 3) (_ : a + c ≥ b + 6) : False := by omega - -example {x : Nat} : 1 < (1 + ((x + 1 : Nat) : Int) + 2) / 2 := by omega - -example {x : Nat} : (x + 4) / 2 ≤ x + 2 := by omega - -example {x : Int} {m : Nat} (_ : 0 < m) (_ : ¬x % ↑m < (↑m + 1) / 2) : -↑m / 2 ≤ x % ↑m - ↑m := by - omega - -example (h : (7 : Int) = 0) : False := by omega - -example (h : (7 : Int) ≤ 0) : False := by omega - -example (h : (-7 : Int) + 14 = 0) : False := by omega - -example (h : (-7 : Int) + 14 ≤ 0) : False := by omega - -example (h : (1 : Int) + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 = 0) : False := by - omega - -example (h : (7 : Int) - 14 = 0) : False := by omega - -example (h : (14 : Int) - 7 ≤ 0) : False := by omega - -example (h : (1 : Int) - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 = 0) : False := by - omega - -example (h : -(7 : Int) = 0) : False := by omega - -example (h : -(-7 : Int) ≤ 0) : False := by omega - -example (h : 2 * (7 : Int) = 0) : False := by omega - -example (h : (7 : Int) < 0) : False := by omega - -example {x : Int} (h : x + x + 1 = 0) : False := by omega - -example {x : Int} (h : 2 * x + 1 = 0) : False := by omega - -example {x y : Int} (h : x + x + y + y + 1 = 0) : False := by omega - -example {x y : Int} (h : 2 * x + 2 * y + 1 = 0) : False := by omega - -example {x : Int} (h₁ : 0 ≤ -7 + x) (h₂ : 0 ≤ 3 - x) : False := by omega - -example {x : Int} (h₁ : 0 ≤ -7 + x) (h₂ : 0 < 4 - x) : False := by omega - -example {x : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : 2 * x + 1 ≤ 0) : False := by omega - -example {x : Int} (h₁ : 0 < 2 * x + 2) (h₂ : 2 * x + 1 ≤ 0) : False := by omega - -example {x y : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : x = y) (h₃ : 2 * y + 1 ≤ 0) : False := by omega - -example {x y z : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : x = y) (h₃ : y = z) (h₄ : 2 * z + 1 ≤ 0) : - False := by omega - -example {x1 x2 x3 x4 x5 x6 : Int} (h : 0 ≤ 2 * x1 + 1) (h : x1 = x2) (h : x2 = x3) (h : x3 = x4) - (h : x4 = x5) (h : x5 = x6) (h : 2 * x6 + 1 ≤ 0) : False := by omega - -example {x : Int} (_ : 1 ≤ -3 * x) (_ : 1 ≤ 2 * x) : False := by omega - -example {x y : Int} (_ : 2 * x + 3 * y = 0) (_ : 1 ≤ x) (_ : 1 ≤ y) : False := by omega - -example {x y z : Int} (_ : 2 * x + 3 * y = 0) (_ : 3 * y + 4 * z = 0) (_ : 1 ≤ x) (_ : 1 ≤ -z) : - False := by omega - -example {x y z : Int} (_ : 2 * x + 3 * y + 4 * z = 0) (_ : 1 ≤ x + y) (_ : 1 ≤ y + z) - (_ : 1 ≤ x + z) : False := by omega - -example {x y : Int} (_ : 1 ≤ 3 * x) (_ : y ≤ 2) (_ : 6 * x - 2 ≤ y) : False := by omega - -example {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : 1 ≤ x) : False := by - omega -example {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : x ≥ 1) : False := by - omega -example {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : 0 < x) : False := by - omega -example {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : x > 0) : False := by - omega - -example {x : Nat} (_ : 10 ∣ x) (_ : ¬ 5 ∣ x) : False := by omega -example {x y : Nat} (_ : 5 ∣ x) (_ : ¬ 10 ∣ x) (_ : y = 7) (_ : x - y ≤ 2) (_ : x ≥ 6) : False := by - omega - -example (x : Nat) : x % 4 - x % 8 = 0 := by omega - -example {n : Nat} (_ : n > 0) : (2*n - 1) % 2 = 1 := by omega - -example (x : Int) (_ : x > 0 ∧ x < -1) : False := by omega -example (x : Int) (_ : x > 7) : x < 0 ∨ x > 3 := by omega - -example (_ : ∃ n : Nat, n < 0) : False := by omega -example (_ : { x : Int // x < 0 ∧ x > 0 }) : False := by omega -example {x y : Int} (_ : x < y) (z : { z : Int // y ≤ z ∧ z ≤ x }) : False := by omega - -example (a b c d e : Int) - (ha : 2 * a + b + c + d + e = 4) - (hb : a + 2 * b + c + d + e = 5) - (hc : a + b + 2 * c + d + e = 6) - (hd : a + b + c + 2 * d + e = 7) - (he : a + b + c + d + 2 * e = 8) : e = 3 := by omega - -example (a b c d e : Int) - (ha : 2 * a + b + c + d + e = 4) - (hb : a + 2 * b + c + d + e = 5) - (hc : a + b + 2 * c + d + e = 6) - (hd : a + b + c + 2 * d + e = 7) - (he : a + b + c + d + 2 * e = 8 ∨ e = 3) : e = 3 := by - fail_if_success omega (config := { splitDisjunctions := false }) - omega - -example {x : Int} (h : x = 7) : x.natAbs = 7 := by - fail_if_success omega (config := { splitNatAbs := false }) - fail_if_success omega (config := { splitDisjunctions := false }) - omega - -example {x y : Int} (_ : (x - y).natAbs < 3) (_ : x < 5) (_ : y > 15) : False := by - omega - -example {a b : Int} (h : a < b) (w : b < a) : False := by omega - -example (_e b c a v0 v1 : Int) (_h1 : v0 = 5 * a) (_h2 : v1 = 3 * b) (h3 : v0 + v1 + c = 10) : - v0 + 5 + (v1 - 3) + (c - 2) = 10 := by omega - -example (h : (1 : Int) < 0) (_ : ¬ (37 : Int) < 42) (_ : True) (_ : (-7 : Int) < 5) : - (3 : Int) < 7 := by omega - -example (A B : Int) (h : 0 < A * B) : 0 < 8 * (A * B) := by omega - -example (A B : Nat) (h : 7 < A * B) : 0 < A*B/8 := by omega -example (A B : Int) (h : 7 < A * B) : 0 < A*B/8 := by omega - -example (ε : Int) (h1 : ε > 0) : ε / 2 + ε / 3 + ε / 7 < ε := by omega - -example (x y z : Int) (h1 : 2*x < 3*y) (h2 : -4*x + z/2 < 0) (h3 : 12*y - z < 0) : False := by omega - -example (ε : Int) (h1 : ε > 0) : ε / 2 < ε := by omega - -example (ε : Int) (_ : ε > 0) : ε - 2 ≤ ε / 3 + ε / 3 + ε / 3 := by omega -example (ε : Int) (_ : ε > 0) : ε / 3 + ε / 3 + ε / 3 ≤ ε := by omega -example (ε : Int) (_ : ε > 0) : ε - 2 ≤ ε / 3 + ε / 3 + ε / 3 ∧ ε / 3 + ε / 3 + ε / 3 ≤ ε := by - omega - -example (x : Int) (h : 0 < x) : 0 < x / 1 := by omega - -example (x : Int) (h : 5 < x) : 0 < x/2/3 := by omega - -example (_a b _c : Nat) (h2 : b + 2 > 3 + b) : False := by omega -example (_a b _c : Int) (h2 : b + 2 > 3 + b) : False := by omega - -example (g v V c h : Int) (_ : h = 0) (_ : v = V) (_ : V > 0) (_ : g > 0) - (_ : 0 ≤ c) (_ : c < 1) : v ≤ V := by omega - -example (x y z : Int) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) (h3 : 12 * y - 4 * z < 0) : - False := by - omega - -example (x y z : Int) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) (_h3 : x * y < 5) - (h3 : 12 * y - 4 * z < 0) : False := by omega - -example (a b c : Int) (h1 : a > 0) (h2 : b > 5) (h3 : c < -10) (h4 : a + b - c < 3) : False := by - omega - -example (_ b _ : Int) (h2 : b > 0) (h3 : ¬ b ≥ 0) : False := by - omega - -example (x y z : Int) (hx : x ≤ 3 * y) (h2 : y ≤ 2 * z) (h3 : x ≥ 6 * z) : x = 3 * y := by - omega - -example (x y z : Int) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) (_h3 : x * y < 5) : - ¬ 12 * y - 4 * z < 0 := by - omega - -example (x y z : Int) (hx : ¬ x > 3 * y) (h2 : ¬ y > 2 * z) (h3 : x ≥ 6 * z) : x = 3 * y := by - omega - -example (x y : Int) (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3) (h' : (x + 4) * x ≥ 0) - (h'' : (6 + 3 * y) * y ≥ 0) : False := by omega - -example (a : Int) (ha : 0 ≤ a) : 0 * 0 ≤ 2 * a := by omega - -example (x y : Int) (h : x < y) : x ≠ y := by omega - -example (x y : Int) (h : x < y) : ¬ x = y := by omega - -example (x : Int) : id x ≥ x := by omega - -example (prime : Nat → Prop) (x y z : Int) (h1 : 2 * x + ((-3) * y) < 0) (h2 : (-4) * x + 2* z < 0) - (h3 : 12 * y + (-4) * z < 0) (_ : prime 7) : False := by omega - -example (i n : Nat) (h : (2 : Int) ^ i ≤ 2 ^ n) : (0 : Int) ≤ 2 ^ n - 2 ^ i := by omega - --- Check we use `exfalso` on non-comparison goals. -example (prime : Nat → Prop) (_ b _ : Nat) (h2 : b > 0) (h3 : b < 0) : prime 10 := by - omega - -example (a b c : Nat) (h2 : (2 : Nat) > 3) : a + b - c ≥ 3 := by omega - --- Verify that we split conjunctions in hypotheses. -example (x y : Int) - (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3 ∧ (x + 4) * x ≥ 0 ∧ (6 + 3 * y) * y ≥ 0) : - False := by omega - -example (mess : Nat → Nat) (S n : Nat) : - mess S + (n * mess S + n * 2 + 1) < n * mess S + mess S + (n * 2 + 2) := by omega - -example (p n p' n' : Nat) (h : p + n' = p' + n) : n + p' = n' + p := by - omega - -example (a b c : Int) (h1 : 32 / a < b) (h2 : b < c) : 32 / a < c := by omega - --- Check that `autoParam` wrappers do not get in the way of using hypotheses. -example (i n : Nat) (hi : i ≤ n := by omega) : i < n + 1 := by - omega - --- Test that we consume expression metadata when necessary. -example : 0 = 0 := by - have : 0 = 0 := by omega - omega -- This used to fail. - -/-! ### `Prod.Lex` -/ - --- This example comes from the termination proof --- for `permutationsAux.rec` in `Mathlib.Data.List.Defs`. -example {x y : Nat} : Prod.Lex (· < ·) (· < ·) (x, x) (Nat.succ y + x, Nat.succ y) := by omega - --- We test the termination proof in-situ: -def List.permutationsAux.rec' {C : List α → List α → Sort v} (H0 : ∀ is, C [] is) - (H1 : ∀ t ts is, C ts (t :: is) → C is [] → C (t :: ts) is) : ∀ l₁ l₂, C l₁ l₂ - | [], is => H0 is - | t :: ts, is => - H1 t ts is (permutationsAux.rec' H0 H1 ts (t :: is)) (permutationsAux.rec' H0 H1 is []) - termination_by ts is => (length ts + length is, length ts) - decreasing_by all_goals simp_wf; omega - -example {x y w z : Nat} (h : Prod.Lex (· < ·) (· < ·) (x + 1, y + 1) (w, z)) : - Prod.Lex (· < ·) (· < ·) (x, y) (w, z) := by omega - --- Verify that we can handle `iff` statements in hypotheses: -example (a b : Int) (h : a < 0 ↔ b < 0) (w : b > 3) : a ≥ 0 := by omega - --- Verify that we can prove `iff` goals: -example (a b : Int) (h : a > 7) (w : b > 2) : a > 0 ↔ b > 0 := by omega - --- Verify that we can prove implications: -example (a : Int) : a > 0 → a > -1 := by omega - --- Verify that we can introduce multiple arguments: -example (x y : Int) : x + 1 ≤ y → ¬ y + 1 ≤ x := by omega - --- Verify that we can handle double negation: -example (x y : Int) (_ : x < y) (_ : ¬ ¬ y < x) : False := by omega - --- Verify that we don't treat function goals as implications. -example (a : Nat) (h : a < 0) : Nat → Nat := by omega - --- Example from Cedar: -example {a₁ a₂ p₁ p₂ : Nat} - (h₁ : a₁ = a₂ → ¬p₁ = p₂) : - (a₁ < a₂ ∨ a₁ = a₂ ∧ p₁ < p₂) ∨ a₂ < a₁ ∨ a₂ = a₁ ∧ p₂ < p₁ := by omega - --- From https://github.com/leanprover/std4/issues/562 -example {i : Nat} (h1 : i < 330) (_h2 : 7 ∣ (660 + i) * (1319 - i)) : 1319 - i < 1979 := by - omega - -example {a : Int} (_ : a < min a b) : False := by omega (config := { splitMinMax := false }) -example {a : Int} (_ : max a b < b) : False := by omega (config := { splitMinMax := false }) -example {a : Nat} (_ : a < min a b) : False := by omega (config := { splitMinMax := false }) -example {a : Nat} (_ : max a b < b) : False := by omega (config := { splitMinMax := false }) - -example {a b : Nat} (_ : a = 7) (_ : b = 3) : min a b = 3 := by - fail_if_success omega (config := { splitMinMax := false }) - omega - -example {a b : Nat} (_ : a + b = 9) : (min a b) % 2 + (max a b) % 2 = 1 := by - fail_if_success omega (config := { splitMinMax := false }) - omega - -example {a : Int} (_ : a < if a ≤ b then a else b) : False := by omega -example {a b : Int} : (if a < b then a else b - 1) ≤ b := by omega - --- Check that we use local values. -example (i j : Nat) (p : i ≥ j) : True := by - let l := j - 1 - have _ : i ≥ l := by omega - trivial - -example (i j : Nat) (p : i ≥ j) : True := by - let l := j - 1 - let k := l - have _ : i ≥ k := by omega - trivial - -example (i : Fin 7) : (i : Nat) < 8 := by omega - -example (x y z i : Nat) (hz : z ≤ 1) : x % 2 ^ i + y % 2 ^ i + z < 2 * 2^ i := by omega diff --git a/test/rcases.lean b/test/rcases.lean deleted file mode 100644 index 39c728a9cc..0000000000 --- a/test/rcases.lean +++ /dev/null @@ -1,211 +0,0 @@ -import Std.Tactic.Basic - -set_option linter.missingDocs false - -example (x : α × β × γ) : True := by - rcases x with ⟨a, b, c⟩ - guard_hyp a : α - guard_hyp b : β - guard_hyp c : γ - trivial - -example (x : α × β × γ) : True := by - rcases x with ⟨(a : α) : id α, -, c : id γ⟩ - guard_hyp a : α - fail_if_success have : β := by assumption - guard_hyp c : id γ - trivial - -example (x : (α × β) × γ) : True := by - fail_if_success rcases x with ⟨_a, b, c⟩ - fail_if_success rcases x with ⟨⟨a:β, b⟩, c⟩ - rcases x with ⟨⟨a:α, b⟩, c⟩ - guard_hyp a : α - guard_hyp b : β - guard_hyp c : γ - trivial - -example : @Inhabited.{1} α × Option β ⊕ γ → True := by - rintro (⟨⟨a⟩, _ | b⟩ | c) - · guard_hyp a : α; trivial - · guard_hyp a : α; guard_hyp b : β; trivial - · guard_hyp c : γ; trivial - -example : cond false Nat Int → cond true Int Nat → Nat ⊕ Unit → True := by - rintro (x y : Int) (z | u) - · guard_hyp x : Int; guard_hyp y : Int; guard_hyp z : Nat; trivial - · guard_hyp x : Int; guard_hyp y : Int; guard_hyp u : Unit; trivial - -example (x y : Nat) (h : x = y) : True := by - rcases x with _|⟨⟩|z - · guard_hyp h : Nat.zero = y; trivial - · guard_hyp h : Nat.succ Nat.zero = y; trivial - · guard_hyp z : Nat - guard_hyp h : Nat.succ (Nat.succ z) = y; trivial - -example (h : x = 3) (h₂ : x < 4) : x < 4 := by - rcases h with ⟨⟩ - guard_hyp h₂ : 3 < 4; guard_target = 3 < 4; exact h₂ - -example (h : x = 3) (h₂ : x < 4) : x < 4 := by - rcases h with rfl - guard_hyp h₂ : 3 < 4; guard_target = 3 < 4; exact h₂ - -example (h : 3 = x) (h₂ : x < 4) : x < 4 := by - rcases h with ⟨⟩ - guard_hyp h₂ : 3 < 4; guard_target = 3 < 4; exact h₂ - -example (h : 3 = x) (h₂ : x < 4) : x < 4 := by - rcases h with rfl - guard_hyp h₂ : 3 < 4; guard_target = 3 < 4; exact h₂ - -example (s : α ⊕ Empty) : True := by - rcases s with s|⟨⟨⟩⟩ - guard_hyp s : α; trivial - -example : True := by - obtain ⟨n : Nat, _h : n = n, -⟩ : ∃ n : Nat, n = n ∧ True - · exact ⟨0, rfl, trivial⟩ - trivial - -example : True := by - obtain (h : True) | ⟨⟨⟩⟩ : True ∨ False - · exact Or.inl trivial - guard_hyp h : True; trivial - -example : True := by - obtain h | ⟨⟨⟩⟩ : True ∨ False := Or.inl trivial - guard_hyp h : True; trivial - -example : True := by - obtain ⟨h, h2⟩ := And.intro trivial trivial - guard_hyp h : True; guard_hyp h2 : True; trivial - -example : True := by - fail_if_success obtain ⟨h, h2⟩ - trivial - -example (x y : α × β) : True := by - rcases x, y with ⟨⟨a, b⟩, c, d⟩ - guard_hyp a : α; guard_hyp b : β - guard_hyp c : α; guard_hyp d : β - trivial - -example (x y : α ⊕ β) : True := by - rcases x, y with ⟨a|b, c|d⟩ - · guard_hyp a : α; guard_hyp c : α; trivial - · guard_hyp a : α; guard_hyp d : β; trivial - · guard_hyp b : β; guard_hyp c : α; trivial - · guard_hyp b : β; guard_hyp d : β; trivial - -example (i j : Nat) : (Σ' x, i ≤ x ∧ x ≤ j) → i ≤ j := by - intro h - rcases h' : h with ⟨x, h₀, h₁⟩ - guard_hyp h' : h = ⟨x, h₀, h₁⟩ - apply Nat.le_trans h₀ h₁ - -example (x : Quot fun _ _ : α => True) (h : x = x): x = x := by - rcases x with ⟨z⟩ - guard_hyp z : α - guard_hyp h : Quot.mk (fun _ _ => True) z = Quot.mk (fun _ _ => True) z - guard_target = Quot.mk (fun _ _ => True) z = Quot.mk (fun _ _ => True) z - exact h - -example (n : Nat) : True := by - obtain _one_lt_n | _n_le_one : 1 < n + 1 ∨ n + 1 ≤ 1 := Nat.lt_or_ge 1 (n + 1) - {trivial}; trivial - -example (n : Nat) : True := by - obtain _one_lt_n | (_n_le_one : n + 1 ≤ 1) := Nat.lt_or_ge 1 (n + 1) - {trivial}; trivial - -open Lean Elab Tactic in -/-- Asserts that the goal has `n` hypotheses. Used for testing. -/ -elab "check_num_hyps " n:num : tactic => liftMetaMAtMain fun _ => do - -- +1 because the _example recursion decl is in the list - guard $ (← getLCtx).foldl (fun i _ => i+1) 0 = n.1.toNat + 1 - -example (h : ∃ x : Nat, x = x ∧ 1 = 1) : True := by - rcases h with ⟨-, _⟩ - check_num_hyps 0 - trivial - -example (h : ∃ x : Nat, x = x ∧ 1 = 1) : True := by - rcases h with ⟨-, _, h⟩ - check_num_hyps 1 - guard_hyp h : 1 = 1 - trivial - -example (h : True ∨ True ∨ True) : True := by - rcases h with - | - | - - iterate 3 · check_num_hyps 0; trivial - -example (h : True ∨ True ∨ True) : True := by - rcases h with -|-|- - iterate 3 · check_num_hyps 0; trivial - -example : Bool → False → True -| false => by rintro ⟨⟩ -| true => by rintro ⟨⟩ - -example : (b : Bool) → cond b False False → True := by - rintro ⟨⟩ ⟨⟩ - -structure Baz {α : Type _} (f : α → α) : Prop where - [inst : Nonempty α] - h : f ∘ f = id - -example {α} (f : α → α) (h : Baz f) : True := by rcases h with ⟨_⟩; trivial - -example {α} (f : α → α) (h : Baz f) : True := by rcases h with @⟨_, _⟩; trivial - -inductive Test : Nat → Prop - | a (n) : Test (2 + n) - | b {n} : n > 5 → Test (n * n) - -example {n} (h : Test n) : n = n := by - have : True := by - rcases h with (a | b) - · guard_hyp a : Nat - trivial - · guard_hyp b : ‹Nat› > 5 - trivial - · rcases h with (a | @⟨n, b⟩) - · guard_hyp a : Nat - trivial - · guard_hyp b : n > 5 - trivial - -example (h : a ≤ 2 ∨ 2 < a) : True := by - obtain ha1 | ha2 : a ≤ 2 ∨ 3 ≤ a := h - · guard_hyp ha1 : a ≤ 2; trivial - · guard_hyp ha2 : 3 ≤ a; trivial - -example (h : a ≤ 2 ∨ 2 < a) : True := by - obtain ha1 | ha2 : a ≤ 2 ∨ 3 ≤ a := id h - · guard_hyp ha1 : a ≤ 2; trivial - · guard_hyp ha2 : 3 ≤ a; trivial - -example (a : Nat) : True := by - rcases h : a with _ | n - · guard_hyp h : a = 0; trivial - · guard_hyp h : a = n + 1; trivial - -inductive BaseType : Type where - | one - -inductive BaseTypeHom : BaseType → BaseType → Type where - | loop : BaseTypeHom one one - | id (X : BaseType) : BaseTypeHom X X - -example : BaseTypeHom one one → Unit := by rintro ⟨_⟩ <;> constructor - -axiom test_sorry {α} : α -example (b c : Nat) : True := by - obtain rfl : b = c ^ 2 := test_sorry - trivial - -example (b c : Nat) : True := by - obtain h : b = c ^ 2 := test_sorry - subst h - trivial diff --git a/test/repeat.lean b/test/repeat.lean deleted file mode 100644 index 276e283f8f..0000000000 --- a/test/repeat.lean +++ /dev/null @@ -1,12 +0,0 @@ -import Std.Tactic.Basic - -open Lean Elab Tactic Meta - -elab "foo" : tactic => liftMetaTactic fun g => do - g.assign (← mkFreshExprMVar (← g.getType)) - throwError "" - -#guard_msgs in -example : True := by - repeat' foo - trivial diff --git a/test/replace.lean b/test/replace.lean deleted file mode 100644 index 99cfd227fe..0000000000 --- a/test/replace.lean +++ /dev/null @@ -1,50 +0,0 @@ -/- -Copyright (c) 2022 Arthur Paulino. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Arthur Paulino --/ - -set_option linter.unusedVariables false - --- tests with an explicitly named hypothesis - -example (h : Int) : Nat := by - replace h : Nat := 0 - exact h - -example (h : Nat) : Nat := by - have h : Int := 0 - assumption -- original `h` is not absent but... - -example (h : Nat) : Nat := by - replace h : Int := 0 - fail_if_success assumption -- original `h` is absent now - replace h : Nat := 0 - exact h - --- tests with `this` - -example : Nat := by - have : Int := 0 - replace : Nat := 0 - assumption - -example : Nat := by - have : Nat := 0 - have : Int := 0 - assumption -- original `this` is not absent but... - -example : Nat := by - have : Nat := 0 - replace : Int := 0 - fail_if_success assumption -- original `this` is absent now - replace : Nat := 0 - assumption - --- trying to replace the type of a variable when the goal depends on it - -example {a : Nat} : a = a := by - replace a : Int := 0 - have : Nat := by assumption -- old `a` is not gone - have : Int := by exact a -- new `a` is of type `Int` - simp diff --git a/test/run_cmd.lean b/test/run_cmd.lean deleted file mode 100644 index a3b649e5e0..0000000000 --- a/test/run_cmd.lean +++ /dev/null @@ -1,15 +0,0 @@ -import Lean.Elab.Tactic.ElabTerm -import Lean.Elab.Command - -open Lean Elab Tactic - -/-- info: hello world -/ -#guard_msgs in -run_cmd logInfo m!"hello world" - -example : True := by - run_tac - evalApplyLikeTactic MVarId.apply (← `(True.intro)) - -example : True := by_elab - Term.elabTerm (← `(True.intro)) none diff --git a/test/show_term.lean b/test/show_term.lean index 922e034238..8557e8229b 100644 --- a/test/show_term.lean +++ b/test/show_term.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import Std.Tactic.ShowTerm /-- info: Try this: exact (n, 37) -/ #guard_msgs in example (n : Nat) : Nat × Nat := by diff --git a/test/simpa.lean b/test/simpa.lean index 065e3b8328..0c2d7c6aea 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Arthur Paulino. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Gabriel Ebner -/ -import Std.Tactic.ShowTerm set_option linter.missingDocs false diff --git a/test/solve_by_elim.lean b/test/solve_by_elim.lean index fbe6abba90..2da0eb6c05 100644 --- a/test/solve_by_elim.lean +++ b/test/solve_by_elim.lean @@ -11,90 +11,6 @@ import Lean.Elab.Tactic.SolveByElim -- FIXME we need to make SolveByElimConfig b set_option autoImplicit true -example (h : Nat) : Nat := by solve_by_elim -example {α β : Type} (f : α → β) (a : α) : β := by solve_by_elim -example {α β : Type} (f : α → α → β) (a : α) : β := by solve_by_elim -example {α β γ : Type} (f : α → β) (g : β → γ) (a : α) : γ := by solve_by_elim -example {α β γ : Type} (_f : α → β) (g : β → γ) (b : β) : γ := by solve_by_elim -example {α : Nat → Type} (f : (n : Nat) → α n → α (n+1)) (a : α 0) : α 4 := by solve_by_elim - -example (h : Nat) : Nat := by solve_by_elim [] -example {α β : Type} (f : α → β) (a : α) : β := by solve_by_elim [] -example {α β : Type} (f : α → α → β) (a : α) : β := by solve_by_elim [] -example {α β γ : Type} (f : α → β) (g : β → γ) (a : α) : γ := by solve_by_elim [] -example {α β γ : Type} (_f : α → β) (g : β → γ) (b : β) : γ := by solve_by_elim [] -example {α : Nat → Type} (f : (n : Nat) → α n → α (n+1)) (a : α 0) : α 4 := by solve_by_elim [] - -example {α β : Type} (f : α → β) (a : α) : β := by - fail_if_success solve_by_elim [-f] - fail_if_success solve_by_elim [-a] - fail_if_success solve_by_elim only [f] - solve_by_elim - -example {α β γ : Type} (f : α → β) (g : β → γ) (b : β) : γ := by - fail_if_success solve_by_elim [-g] - solve_by_elim [-f] - -example (h : Nat) : Nat := by solve_by_elim only [h] -example {α β : Type} (f : α → β) (a : α) : β := by solve_by_elim only [f, a] -example {α β : Type} (f : α → α → β) (a : α) : β := by solve_by_elim only [f, a] -example {α β γ : Type} (f : α → β) (g : β → γ) (a : α) : γ := by solve_by_elim only [f, g, a] -example {α β γ : Type} (_f : α → β) (g : β → γ) (b : β) : γ := by solve_by_elim only [g, b] -example {α : Nat → Type} (f : (n : Nat) → α n → α (n+1)) (a : α 0) : α 4 := by - solve_by_elim only [f, a] - -set_option linter.unusedVariables false in -example (h₁ h₂ : False) : True := by - -- 'It doesn't make sense to remove local hypotheses when using `only` without `*`.' - fail_if_success solve_by_elim only [-h₁] - -- 'It does make sense to use `*` without `only`.' - fail_if_success solve_by_elim [*, -h₁] - solve_by_elim only [*, -h₁] - --- Verify that already assigned metavariables are skipped. -example (P₁ P₂ : α → Prop) (f : ∀ (a : α), P₁ a → P₂ a → β) - (a : α) (ha₁ : P₁ a) (ha₂ : P₂ a) : β := by - solve_by_elim - -example {X : Type} (x : X) : x = x := by - fail_if_success solve_by_elim (config := {constructor := false}) only -- needs the `rfl` lemma - solve_by_elim - --- Needs to apply `rfl` twice, with different implicit arguments each time. --- A naive implementation of solve_by_elim would get stuck. -example {X : Type} (x y : X) (p : Prop) (h : x = x → y = y → p) : p := by solve_by_elim - -example : True := by - fail_if_success solve_by_elim (config := {constructor := false}) only -- needs the `trivial` lemma - solve_by_elim - --- Requires backtracking. -example (P₁ P₂ : α → Prop) (f : ∀ (a: α), P₁ a → P₂ a → β) - (a : α) (_ha₁ : P₁ a) - (a' : α) (ha'₁ : P₁ a') (ha'₂ : P₂ a') : β := by - fail_if_success solve_by_elim (config := .noBackTracking) - solve_by_elim - -attribute [symm] Eq.symm in -example {α : Type} {a b : α → Prop} (h₀ : b = a) (y : α) : a y = b y := by - fail_if_success solve_by_elim (config := {symm := false}) - solve_by_elim - -example (P : True → False) : 3 = 7 := by - fail_if_success solve_by_elim (config := {exfalso := false}) - solve_by_elim - --- Verifying that `solve_by_elim` acts only on the main goal. -example (n : Nat) : Nat × Nat := by - constructor - solve_by_elim - solve_by_elim - --- Verifying that `solve_by_elim*` acts on all remaining goals. -example (n : Nat) : Nat × Nat := by - constructor - solve_by_elim* - open Lean Elab Tactic in /-- `fconstructor` is like `constructor` @@ -106,21 +22,6 @@ elab "fconstructor" : tactic => withMainContext do Term.synthesizeSyntheticMVarsNoPostponing replaceMainGoal mvarIds' --- Verifying that `solve_by_elim*` backtracks when given multiple goals. -example (n m : Nat) (f : Nat → Nat → Prop) (h : f n m) : ∃ p : Nat × Nat, f p.1 p.2 := by - fconstructor - fconstructor - solve_by_elim* - --- test that metavariables created for implicit arguments don't get stuck -example (P : Nat → Type) (f : {n : Nat} → P n) : P 2 × P 3 := by - fconstructor - solve_by_elim* only [f] - -example : 6 = 6 ∧ [7] = [7] := by - fconstructor - solve_by_elim* only [@rfl _] - -- Test that `solve_by_elim*`, which works on multiple goals, -- successfully uses the relevant local hypotheses for each goal. example (f g : Nat → Prop) : (∃ k : Nat, f k) ∨ (∃ k : Nat, g k) ↔ ∃ k : Nat, f k ∨ g k := by @@ -129,32 +30,6 @@ example (f g : Nat → Prop) : (∃ k : Nat, f k) ∨ (∃ k : Nat, g k) ↔ ∃ on_goal 3 => rintro ⟨n, hf | hg⟩ solve_by_elim* (config := {maxDepth := 13}) [Or.inl, Or.inr, Exists.intro] --- Test that `Config.intros` causes `solve_by_elim` to call `intro` on intermediate goals. -example (P : Prop) : P → P := by - fail_if_success solve_by_elim (config := {intros := false}) - solve_by_elim - --- This worked in mathlib3 without the `@`, but now goes into a loop. --- If someone wants to diagnose this, please do! -example (P Q : Prop) : P ∧ Q → P ∧ Q := by - solve_by_elim [And.imp, @id] - -section apply_assumption - -example {a b : Type} (h₀ : a → b) (h₁ : a) : b := by - apply_assumption - apply_assumption - -example {α : Type} {p : α → Prop} (h₀ : ∀ x, p x) (y : α) : p y := by - apply_assumption - --- Check that `apply_assumption` uses `exfalso`. -example {P Q : Prop} (p : P) (q : Q) (h : P → ¬ Q) : Nat := by - fail_if_success apply_assumption (config := {exfalso := false}) - apply_assumption <;> assumption - -end apply_assumption - section «using» /-- -/ @@ -184,8 +59,3 @@ example : 5 ≤ 7 := by exact mySorry end issue1581 - -example (x : (α × (β × γ))) : (α × β) × γ := by - rcases x with ⟨a, b, c⟩ - fail_if_success solve_by_elim (config := {constructor := false}) - solve_by_elim diff --git a/test/symm.lean b/test/symm.lean deleted file mode 100644 index 33f2146617..0000000000 --- a/test/symm.lean +++ /dev/null @@ -1,27 +0,0 @@ -import Init.Tactics - -set_option autoImplicit true -set_option linter.missingDocs false - --- testing that the attribute is recognized -@[symm] def eq_symm {α : Type} (a b : α) : a = b → b = a := Eq.symm - -example (a b : Nat) : a = b → b = a := by intros; symm; assumption -example (a b : Nat) : a = b → True → b = a := by intro h _; symm at h; assumption - -def sameParity : Nat → Nat → Prop - | n, m => n % 2 = m % 2 - -@[symm] def sameParity_symm (n m : Nat) : sameParity n m → sameParity m n := Eq.symm - -example (a b : Nat) : sameParity a b → sameParity b a := by intros; symm; assumption - -def MyEq (n m : Nat) := ∃ k, n + k = m ∧ m + k = n - -@[symm] theorem MyEq.symm {n m : Nat} (h : MyEq n m) : MyEq m n := by - rcases h with ⟨k, h1, h2⟩ - exact ⟨k, h2, h1⟩ - -example {n m : Nat} (h : MyEq n m) : MyEq m n := by - symm - assumption From 1fc6571cadc971377eb80ed94cd3a76bb1d93052 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 4 Mar 2024 03:32:21 +0000 Subject: [PATCH 117/213] Update lean-toolchain for testing https://github.com/leanprover/lean4/pull/3579 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 6f6f75939e..56af9a5bd2 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-02 +leanprover/lean4-pr-releases:pr-release-3579 From 86c0e096a1e67f46ed3eaef6a006c87064a5e8fd Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 4 Mar 2024 15:11:09 +1100 Subject: [PATCH 118/213] fixes --- Std/Data/Int/DivMod.lean | 2 +- Std/Data/List/Lemmas.lean | 4 ++-- Std/Data/Rat/Lemmas.lean | 8 ++++++-- Std/Data/UInt.lean | 2 +- 4 files changed, 10 insertions(+), 6 deletions(-) diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 4ba5091ade..62fc3ec8e1 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -96,7 +96,7 @@ theorem ediv_neg' {a b : Int} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 := @[simp] protected theorem div_one : ∀ a : Int, a.div 1 = a | (n:Nat) => congrArg ofNat (Nat.div_one _) - | -[n+1] => by simp [Int.div, neg_ofNat_succ] + | -[n+1] => by simp [Int.div, Nat.div_one]; rfl @[simp] theorem fdiv_one : ∀ a : Int, a.fdiv 1 = a | 0 => rfl diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 137c2e3124..d9c22cb094 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -222,7 +222,7 @@ theorem forall_mem_map_iff {f : α → β} {l : List α} {P : β → Prop} : @[simp] theorem length_zipWith (f : α → β → γ) (l₁ l₂) : length (zipWith f l₁ l₂) = min (length l₁) (length l₂) := by induction l₁ generalizing l₂ <;> cases l₂ <;> - simp_all [add_one, succ_min_succ, Nat.zero_min, Nat.min_zero] + simp_all [succ_min_succ, Nat.zero_min, Nat.min_zero] @[simp] theorem zipWith_map {μ} (f : γ → δ → μ) (g : α → γ) (h : β → δ) (l₁ : List α) (l₂ : List β) : @@ -846,7 +846,7 @@ theorem get!_of_get? [Inhabited α] : ∀ {l : List α} {n}, get? l n = some a @[simp] theorem length_take : ∀ (i : Nat) (l : List α), length (take i l) = min i (length l) | 0, l => by simp [Nat.zero_min] | succ n, [] => by simp [Nat.min_zero] - | succ n, _ :: l => by simp [Nat.succ_min_succ, add_one, length_take] + | succ n, _ :: l => by simp [Nat.succ_min_succ, length_take] theorem length_take_le (n) (l : List α) : length (take n l) ≤ n := by simp [Nat.min_le_left] diff --git a/Std/Data/Rat/Lemmas.lean b/Std/Data/Rat/Lemmas.lean index ced2a09c08..8d2bb130dd 100644 --- a/Std/Data/Rat/Lemmas.lean +++ b/Std/Data/Rat/Lemmas.lean @@ -143,9 +143,13 @@ theorem divInt_self (a : Rat) : a.num /. a.den = a := by rw [divInt_ofNat, mkRat theorem neg_divInt_neg (num den) : -num /. -den = num /. den := by match den with - | Nat.succ n => simp [divInt, Int.neg_ofNat_succ, normalize_eq_mkRat, Int.neg_neg] + | Nat.succ n => + simp only [divInt, Int.neg_ofNat_succ] + simp [normalize_eq_mkRat, Int.neg_neg] | 0 => rfl - | Int.negSucc n => simp [divInt, Int.neg_negSucc, normalize_eq_mkRat, Int.neg_neg] + | Int.negSucc n => + simp only [divInt, Int.neg_negSucc] + simp [normalize_eq_mkRat, Int.neg_neg] theorem divInt_neg' (num den) : num /. -den = -num /. den := by rw [← neg_divInt_neg, Int.neg_neg] diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index 04929fa84e..d94c11ae26 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -79,7 +79,7 @@ theorem UInt64.toNat_lt (x : UInt64) : x.toNat < 2 ^ 64 := x.val.isLt theorem USize.size_eq : USize.size = 2 ^ System.Platform.numBits := by have : 1 ≤ 2 ^ System.Platform.numBits := Nat.succ_le_of_lt (Nat.two_pow_pos _) - rw [USize.size, Nat.succ_eq_add_one, Nat.sub_eq, Nat.sub_add_cancel this] + rw [USize.size, Nat.sub_add_cancel this] theorem USize.le_size : 2 ^ 32 ≤ USize.size := by rw [size_eq] From f495a4a128a00dcf5beb5df25f33afed1dec6449 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 4 Mar 2024 04:18:56 +0000 Subject: [PATCH 119/213] Trigger CI for https://github.com/leanprover/lean4/pull/3579 From 354e6813fd274915417d29bbb1e04c8bbad68684 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 4 Mar 2024 15:19:50 +1100 Subject: [PATCH 120/213] fixes --- Std/Data/List/Count.lean | 2 +- Std/Data/List/Perm.lean | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Std/Data/List/Count.lean b/Std/Data/List/Count.lean index 0087e86007..4458c457dc 100644 --- a/Std/Data/List/Count.lean +++ b/Std/Data/List/Count.lean @@ -115,7 +115,7 @@ theorem countP_mono_left (h : ∀ x ∈ l, p x → q x) : countP p l ≤ countP . simp apply Nat.le_trans ?_ (Nat.le_add_right _ _) apply ihl hl - . simp [ha h, Nat.add_one] + . simp [ha h] apply Nat.succ_le_succ apply ihl hl diff --git a/Std/Data/List/Perm.lean b/Std/Data/List/Perm.lean index 75f36a09f8..181859063e 100644 --- a/Std/Data/List/Perm.lean +++ b/Std/Data/List/Perm.lean @@ -548,7 +548,7 @@ theorem perm_iff_count {l₁ l₂ : List α} : l₁ ~ l₂ ↔ ∀ a, count a l | nil => rfl | cons b l₂ => specialize H b - simp at H; cases H + simp at H | cons a l₁ IH => have : a ∈ l₂ := count_pos_iff_mem.mp (by rw [← H]; simp) refine ((IH fun b => ?_).cons a).trans (perm_cons_erase this).symm From fef68516deda6fec5787dbcac365eb221dacc339 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 4 Mar 2024 05:12:21 +0000 Subject: [PATCH 121/213] Trigger CI for https://github.com/leanprover/lean4/pull/3579 From 05944987fa4e11993d077a2d98051da5879754ec Mon Sep 17 00:00:00 2001 From: Ruben Van de Velde <65514131+Ruben-VandeVelde@users.noreply.github.com> Date: Mon, 4 Mar 2024 11:56:47 +0100 Subject: [PATCH 122/213] fix (#680) --- Std/Data/List/Lemmas.lean | 8 ++++---- lean-toolchain | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 137c2e3124..98f0624672 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -905,11 +905,11 @@ theorem get?_modifyNth (f : α → α) : ∀ n (l : List α) m, (modifyNth f n l).get? m = (fun a => if n = m then f a else a) <$> l.get? m | n, l, 0 => by cases l <;> cases n <;> rfl | n, [], _+1 => by cases n <;> rfl - | 0, _ :: l, m+1 => by cases l.get? m <;> rfl + | 0, _ :: l, m+1 => by cases h : l.get? m <;> simp [h, modifyNth, m.succ_ne_zero.symm] | n+1, a :: l, m+1 => (get?_modifyNth f n l m).trans <| by - cases l.get? m <;> by_cases h : n = m <;> - simp only [h, if_pos, if_neg, Option.map, mt Nat.succ.inj, not_false_iff] + cases h' : l.get? m <;> by_cases h : n = m <;> + simp [h, if_pos, if_neg, Option.map, mt Nat.succ.inj, not_false_iff, h'] theorem modifyNthTail_length (f : List α → List α) (H : ∀ l, length (f l) = length l) : ∀ n l, length (modifyNthTail f n l) = length l @@ -956,7 +956,7 @@ theorem modifyNth_eq_set_get? (f : α → α) : | 0, l => by cases l <;> rfl | n+1, [] => rfl | n+1, b :: l => - (congrArg (cons _) (modifyNth_eq_set_get? ..)).trans <| by cases l.get? n <;> rfl + (congrArg (cons _) (modifyNth_eq_set_get? ..)).trans <| by cases h : l.get? n <;> simp [h] theorem modifyNth_eq_set_get (f : α → α) {n} {l : List α} (h) : l.modifyNth f n = l.set n (f (l.get ⟨n, h⟩)) := by diff --git a/lean-toolchain b/lean-toolchain index 6f6f75939e..f93d100b90 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-02 +leanprover/lean4:nightly-2024-03-04 From 253a28756d2188d67c1eea11ee43df6dcf774e85 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 4 Mar 2024 21:57:09 +1100 Subject: [PATCH 123/213] toolchain --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 6f6f75939e..f93d100b90 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-02 +leanprover/lean4:nightly-2024-03-04 From 9baecd636869f560e79949d51c8936625f1e7213 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 4 Mar 2024 11:08:38 +0000 Subject: [PATCH 124/213] Update lean-toolchain for testing https://github.com/leanprover/lean4/pull/3589 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index f93d100b90..258be16bc8 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-04 +leanprover/lean4-pr-releases:pr-release-3589 From e53c25982b24be064a8372fa81c01f2dba973114 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Tue, 5 Mar 2024 09:14:34 +0000 Subject: [PATCH 125/213] chore: bump to nightly-2024-03-05 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 6b26dd51ef..f483baaeec 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.7.0-rc1 +leanprover/lean4:nightly-2024-03-05 From d9e573b8a97a970301b18a25402c2a8a906f4986 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 5 Mar 2024 23:23:46 +1100 Subject: [PATCH 126/213] upstream lemmas --- Std/Classes/BEq.lean | 5 ----- Std/Logic.lean | 10 ---------- 2 files changed, 15 deletions(-) diff --git a/Std/Classes/BEq.lean b/Std/Classes/BEq.lean index c27aa35d0e..98318f97c9 100644 --- a/Std/Classes/BEq.lean +++ b/Std/Classes/BEq.lean @@ -16,8 +16,3 @@ class PartialEquivBEq (α) [BEq α] : Prop where symm : (a : α) == b → b == a /-- Transitivity for `BEq`. If `a == b` and `b == c` then `a == c`. -/ trans : (a : α) == b → b == c → a == c - -@[simp] theorem beq_eq_false_iff_ne [BEq α] [LawfulBEq α] - (a b : α) : (a == b) = false ↔ a ≠ b := by - rw [ne_eq, ← beq_iff_eq a b] - cases a == b <;> decide diff --git a/Std/Logic.lean b/Std/Logic.lean index 43a9b31f66..e7703371ff 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -75,16 +75,6 @@ alias congr_fun := congrFun alias congr_fun₂ := congrFun₂ alias congr_fun₃ := congrFun₃ -theorem eq_mp_eq_cast (h : α = β) : Eq.mp h = cast h := - rfl - -theorem eq_mpr_eq_cast (h : α = β) : Eq.mpr h = cast h.symm := - rfl - -@[simp] theorem cast_cast : ∀ (ha : α = β) (hb : β = γ) (a : α), - cast hb (cast ha a) = cast (ha.trans hb) a - | rfl, rfl, _ => rfl - theorem heq_of_cast_eq : ∀ (e : α = β) (_ : cast e a = a'), HEq a a' | rfl, rfl => .rfl From 1501a2eb786baea6d7b45cf22ead75640a4f0528 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 5 Mar 2024 23:25:07 +1100 Subject: [PATCH 127/213] changes to simp normal form --- Std/Data/List/Lemmas.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 98f0624672..e02af632ed 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -1040,10 +1040,10 @@ theorem contains_eq_any_beq [BEq α] (l : List α) (a : α) : l.contains a = l.a induction l with simp | cons b l => cases a == b <;> simp [*] theorem not_all_eq_any_not (l : List α) (p : α → Bool) : (!l.all p) = l.any fun a => !p a := by - induction l with simp | cons _ _ ih => rw [Bool.not_and, ih] + induction l with simp | cons _ _ ih => rw [ih] theorem not_any_eq_all_not (l : List α) (p : α → Bool) : (!l.any p) = l.all fun a => !p a := by - induction l with simp | cons _ _ ih => rw [Bool.not_or, ih] + induction l with simp | cons _ _ ih => rw [ih] theorem or_all_distrib_left (l : List α) (p : α → Bool) (q : Bool) : (q || l.all p) = l.all fun a => q || p a := by From bd2ee35b16ffab06eda8906152d7df6ef5da6680 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 5 Mar 2024 23:25:40 +1100 Subject: [PATCH 128/213] changes to simp --- Std/Data/List/Lemmas.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index e02af632ed..fdf32ff89e 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -163,7 +163,7 @@ theorem cons_eq_append : theorem append_eq_append_iff {a b c d : List α} : a ++ b = c ++ d ↔ (∃ a', c = a ++ a' ∧ b = a' ++ d) ∨ ∃ c', a = c ++ c' ∧ d = c' ++ b := by induction a generalizing c with - | nil => simp; exact (or_iff_left_of_imp fun ⟨_, ⟨e, rfl⟩, h⟩ => e ▸ h.symm).symm + | nil => simp_all | cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left] @[simp] theorem mem_append {a : α} {s t : List α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by From 204abb9b75191324f6dda81a1bf805d3362fe181 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Thu, 7 Mar 2024 09:13:15 +0000 Subject: [PATCH 129/213] chore: bump to nightly-2024-03-07 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index f483baaeec..cefd860968 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-05 +leanprover/lean4:nightly-2024-03-07 From b1e4f9f26db34af909784563e45163f0fa411342 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 7 Mar 2024 21:06:19 +1100 Subject: [PATCH 130/213] fix --- Std/Data/List/Perm.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Data/List/Perm.lean b/Std/Data/List/Perm.lean index ec36d6b15c..eff8f8ff0e 100644 --- a/Std/Data/List/Perm.lean +++ b/Std/Data/List/Perm.lean @@ -548,7 +548,7 @@ theorem perm_iff_count {l₁ l₂ : List α} : l₁ ~ l₂ ↔ ∀ a, count a l | nil => rfl | cons b l₂ => specialize H b - simp at H; cases H + simp at H | cons a l₁ IH => have : a ∈ l₂ := count_pos_iff_mem.mp (by rw [← H]; simp) refine ((IH fun b => ?_).cons a).trans (perm_cons_erase this).symm From 22c99b70565a55f8774ef21982178632453e0244 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 8 Mar 2024 09:14:39 +0000 Subject: [PATCH 131/213] chore: bump to nightly-2024-03-08 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index cefd860968..60d4af9909 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-07 +leanprover/lean4:nightly-2024-03-08 From 9fa231045c96ce5f0deaa6a4bb56db5ca1d056b5 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 9 Mar 2024 09:17:03 +0000 Subject: [PATCH 132/213] chore: bump to nightly-2024-03-09 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 60d4af9909..be92c8cfc8 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-08 +leanprover/lean4:nightly-2024-03-09 From dd225d4146b9479ce266c569d8f781e0985036fa Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Thu, 7 Mar 2024 14:17:04 -0800 Subject: [PATCH 133/213] chore: fixes --- Std/Data/Nat/Basic.lean | 3 - Std/Data/Nat/Gcd.lean | 227 +-------------------------------------- Std/Data/Nat/Lemmas.lean | 76 +------------ 3 files changed, 5 insertions(+), 301 deletions(-) diff --git a/Std/Data/Nat/Basic.lean b/Std/Data/Nat/Basic.lean index aaa4e6bfed..11b8b3621e 100644 --- a/Std/Data/Nat/Basic.lean +++ b/Std/Data/Nat/Basic.lean @@ -100,9 +100,6 @@ protected def casesDiagOn {motive : Nat → Nat → Sort _} (m n : Nat) Nat.recDiag zero_zero (fun _ _ => zero_succ _) (fun _ _ => succ_zero _) (fun _ _ _ => succ_succ _ _) m n -/-- The least common multiple of `m` and `n`, defined using `gcd`. -/ -def lcm (m n : Nat) : Nat := m * n / gcd m n - /-- Sum of a list of natural numbers. -/ protected def sum (l : List Nat) : Nat := l.foldr (·+·) 0 diff --git a/Std/Data/Nat/Gcd.lean b/Std/Data/Nat/Gcd.lean index 27842c51ad..3fd0108927 100644 --- a/Std/Data/Nat/Gcd.lean +++ b/Std/Data/Nat/Gcd.lean @@ -3,218 +3,22 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro -/ -import Std.Data.Nat.Lemmas /-! -# Definitions and properties of `gcd`, `lcm`, and `coprime` - +# Definitions and properties of `coprime` -/ namespace Nat -/-- `m` and `n` are coprime, or relatively prime, if their `gcd` is 1. -/ -@[reducible] def Coprime (m n : Nat) : Prop := gcd m n = 1 - ---- - -theorem dvd_gcd_iff : k ∣ gcd m n ↔ k ∣ m ∧ k ∣ n := - ⟨fun h => let ⟨h₁, h₂⟩ := gcd_dvd m n; ⟨Nat.dvd_trans h h₁, Nat.dvd_trans h h₂⟩, - fun ⟨h₁, h₂⟩ => dvd_gcd h₁ h₂⟩ - -theorem gcd_comm (m n : Nat) : gcd m n = gcd n m := - Nat.dvd_antisymm - (dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n)) - (dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m)) - -theorem gcd_eq_left_iff_dvd : m ∣ n ↔ gcd m n = m := - ⟨fun h => by rw [gcd_rec, mod_eq_zero_of_dvd h, gcd_zero_left], - fun h => h ▸ gcd_dvd_right m n⟩ - -theorem gcd_eq_right_iff_dvd : m ∣ n ↔ gcd n m = m := by - rw [gcd_comm]; exact gcd_eq_left_iff_dvd - -theorem gcd_assoc (m n k : Nat) : gcd (gcd m n) k = gcd m (gcd n k) := - Nat.dvd_antisymm - (dvd_gcd - (Nat.dvd_trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_left m n)) - (dvd_gcd (Nat.dvd_trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_right m n)) - (gcd_dvd_right (gcd m n) k))) - (dvd_gcd - (dvd_gcd (gcd_dvd_left m (gcd n k)) - (Nat.dvd_trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_left n k))) - (Nat.dvd_trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_right n k))) - -@[simp] theorem gcd_one_right (n : Nat) : gcd n 1 = 1 := (gcd_comm n 1).trans (gcd_one_left n) - -theorem gcd_mul_left (m n k : Nat) : gcd (m * n) (m * k) = m * gcd n k := by - induction n, k using gcd.induction with - | H0 k => simp - | H1 n k _ IH => rwa [← mul_mod_mul_left, ← gcd_rec, ← gcd_rec] at IH - -theorem gcd_mul_right (m n k : Nat) : gcd (m * n) (k * n) = gcd m k * n := by - rw [Nat.mul_comm m n, Nat.mul_comm k n, Nat.mul_comm (gcd m k) n, gcd_mul_left] - -theorem gcd_pos_of_pos_left {m : Nat} (n : Nat) (mpos : 0 < m) : 0 < gcd m n := - pos_of_dvd_of_pos (gcd_dvd_left m n) mpos - -theorem gcd_pos_of_pos_right (m : Nat) {n : Nat} (npos : 0 < n) : 0 < gcd m n := - pos_of_dvd_of_pos (gcd_dvd_right m n) npos - -theorem div_gcd_pos_of_pos_left (b : Nat) (h : 0 < a) : 0 < a / a.gcd b := - (Nat.le_div_iff_mul_le <| Nat.gcd_pos_of_pos_left _ h).2 (Nat.one_mul _ ▸ Nat.gcd_le_left _ h) - -theorem div_gcd_pos_of_pos_right (a : Nat) (h : 0 < b) : 0 < b / a.gcd b := - (Nat.le_div_iff_mul_le <| Nat.gcd_pos_of_pos_right _ h).2 (Nat.one_mul _ ▸ Nat.gcd_le_right _ h) - -theorem eq_zero_of_gcd_eq_zero_left {m n : Nat} (H : gcd m n = 0) : m = 0 := - match eq_zero_or_pos m with - | .inl H0 => H0 - | .inr H1 => absurd (Eq.symm H) (ne_of_lt (gcd_pos_of_pos_left _ H1)) - -theorem eq_zero_of_gcd_eq_zero_right {m n : Nat} (H : gcd m n = 0) : n = 0 := by - rw [gcd_comm] at H - exact eq_zero_of_gcd_eq_zero_left H - -theorem gcd_ne_zero_left : m ≠ 0 → gcd m n ≠ 0 := mt eq_zero_of_gcd_eq_zero_left - -theorem gcd_ne_zero_right : n ≠ 0 → gcd m n ≠ 0 := mt eq_zero_of_gcd_eq_zero_right - -theorem gcd_div {m n k : Nat} (H1 : k ∣ m) (H2 : k ∣ n) : - gcd (m / k) (n / k) = gcd m n / k := - match eq_zero_or_pos k with - | .inl H0 => by simp [H0] - | .inr H3 => by - apply Nat.eq_of_mul_eq_mul_right H3 - rw [Nat.div_mul_cancel (dvd_gcd H1 H2), ← gcd_mul_right, - Nat.div_mul_cancel H1, Nat.div_mul_cancel H2] - -theorem gcd_dvd_gcd_of_dvd_left {m k : Nat} (n : Nat) (H : m ∣ k) : gcd m n ∣ gcd k n := - dvd_gcd (Nat.dvd_trans (gcd_dvd_left m n) H) (gcd_dvd_right m n) - -theorem gcd_dvd_gcd_of_dvd_right {m k : Nat} (n : Nat) (H : m ∣ k) : gcd n m ∣ gcd n k := - dvd_gcd (gcd_dvd_left n m) (Nat.dvd_trans (gcd_dvd_right n m) H) - -theorem gcd_dvd_gcd_mul_left (m n k : Nat) : gcd m n ∣ gcd (k * m) n := - gcd_dvd_gcd_of_dvd_left _ (Nat.dvd_mul_left _ _) - -theorem gcd_dvd_gcd_mul_right (m n k : Nat) : gcd m n ∣ gcd (m * k) n := - gcd_dvd_gcd_of_dvd_left _ (Nat.dvd_mul_right _ _) - -theorem gcd_dvd_gcd_mul_left_right (m n k : Nat) : gcd m n ∣ gcd m (k * n) := - gcd_dvd_gcd_of_dvd_right _ (Nat.dvd_mul_left _ _) - -theorem gcd_dvd_gcd_mul_right_right (m n k : Nat) : gcd m n ∣ gcd m (n * k) := - gcd_dvd_gcd_of_dvd_right _ (Nat.dvd_mul_right _ _) - -theorem gcd_eq_left {m n : Nat} (H : m ∣ n) : gcd m n = m := - Nat.dvd_antisymm (gcd_dvd_left _ _) (dvd_gcd (Nat.dvd_refl _) H) - -theorem gcd_eq_right {m n : Nat} (H : n ∣ m) : gcd m n = n := by - rw [gcd_comm, gcd_eq_left H] - -@[simp] theorem gcd_mul_left_left (m n : Nat) : gcd (m * n) n = n := - Nat.dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (Nat.dvd_mul_left _ _) (Nat.dvd_refl _)) - -@[simp] theorem gcd_mul_left_right (m n : Nat) : gcd n (m * n) = n := by - rw [gcd_comm, gcd_mul_left_left] - -@[simp] theorem gcd_mul_right_left (m n : Nat) : gcd (n * m) n = n := by - rw [Nat.mul_comm, gcd_mul_left_left] - -@[simp] theorem gcd_mul_right_right (m n : Nat) : gcd n (n * m) = n := by - rw [gcd_comm, gcd_mul_right_left] - -@[simp] theorem gcd_gcd_self_right_left (m n : Nat) : gcd m (gcd m n) = gcd m n := - Nat.dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (gcd_dvd_left _ _) (Nat.dvd_refl _)) - -@[simp] theorem gcd_gcd_self_right_right (m n : Nat) : gcd m (gcd n m) = gcd n m := by - rw [gcd_comm n m, gcd_gcd_self_right_left] - -@[simp] theorem gcd_gcd_self_left_right (m n : Nat) : gcd (gcd n m) m = gcd n m := by - rw [gcd_comm, gcd_gcd_self_right_right] - -@[simp] theorem gcd_gcd_self_left_left (m n : Nat) : gcd (gcd m n) m = gcd m n := by - rw [gcd_comm m n, gcd_gcd_self_left_right] - -theorem gcd_add_mul_self (m n k : Nat) : gcd m (n + k * m) = gcd m n := by - simp [gcd_rec m (n + k * m), gcd_rec m n] - -theorem gcd_eq_zero_iff {i j : Nat} : gcd i j = 0 ↔ i = 0 ∧ j = 0 := - ⟨fun h => ⟨eq_zero_of_gcd_eq_zero_left h, eq_zero_of_gcd_eq_zero_right h⟩, - fun h => by simp [h]⟩ - -/-- Characterization of the value of `Nat.gcd`. -/ -theorem gcd_eq_iff (a b : Nat) : - gcd a b = g ↔ g ∣ a ∧ g ∣ b ∧ (∀ c, c ∣ a → c ∣ b → c ∣ g) := by - constructor - · rintro rfl - exact ⟨gcd_dvd_left _ _, gcd_dvd_right _ _, fun _ => Nat.dvd_gcd⟩ - · rintro ⟨ha, hb, hc⟩ - apply Nat.dvd_antisymm - · apply hc - · exact gcd_dvd_left a b - · exact gcd_dvd_right a b - · exact Nat.dvd_gcd ha hb - -/-! ### `lcm` -/ - -theorem lcm_comm (m n : Nat) : lcm m n = lcm n m := by - rw [lcm, lcm, Nat.mul_comm n m, gcd_comm n m] - -@[simp] theorem lcm_zero_left (m : Nat) : lcm 0 m = 0 := by simp [lcm] - -@[simp] theorem lcm_zero_right (m : Nat) : lcm m 0 = 0 := by simp [lcm] - -@[simp] theorem lcm_one_left (m : Nat) : lcm 1 m = m := by simp [lcm] - -@[simp] theorem lcm_one_right (m : Nat) : lcm m 1 = m := by simp [lcm] - -@[simp] theorem lcm_self (m : Nat) : lcm m m = m := by - match eq_zero_or_pos m with - | .inl h => rw [h, lcm_zero_left] - | .inr h => simp [lcm, Nat.mul_div_cancel _ h] - -theorem dvd_lcm_left (m n : Nat) : m ∣ lcm m n := - ⟨n / gcd m n, by rw [← Nat.mul_div_assoc m (Nat.gcd_dvd_right m n)]; rfl⟩ - -theorem dvd_lcm_right (m n : Nat) : n ∣ lcm m n := lcm_comm n m ▸ dvd_lcm_left n m - -theorem gcd_mul_lcm (m n : Nat) : gcd m n * lcm m n = m * n := by - rw [lcm, Nat.mul_div_cancel' (Nat.dvd_trans (gcd_dvd_left m n) (Nat.dvd_mul_right m n))] - -theorem lcm_dvd {m n k : Nat} (H1 : m ∣ k) (H2 : n ∣ k) : lcm m n ∣ k := by - match eq_zero_or_pos k with - | .inl h => rw [h]; exact Nat.dvd_zero _ - | .inr kpos => - apply Nat.dvd_of_mul_dvd_mul_left (gcd_pos_of_pos_left n (pos_of_dvd_of_pos H1 kpos)) - rw [gcd_mul_lcm, ← gcd_mul_right, Nat.mul_comm n k] - exact dvd_gcd (Nat.mul_dvd_mul_left _ H2) (Nat.mul_dvd_mul_right H1 _) - -theorem lcm_assoc (m n k : Nat) : lcm (lcm m n) k = lcm m (lcm n k) := -Nat.dvd_antisymm - (lcm_dvd - (lcm_dvd (dvd_lcm_left m (lcm n k)) - (Nat.dvd_trans (dvd_lcm_left n k) (dvd_lcm_right m (lcm n k)))) - (Nat.dvd_trans (dvd_lcm_right n k) (dvd_lcm_right m (lcm n k)))) - (lcm_dvd - (Nat.dvd_trans (dvd_lcm_left m n) (dvd_lcm_left (lcm m n) k)) - (lcm_dvd (Nat.dvd_trans (dvd_lcm_right m n) (dvd_lcm_left (lcm m n) k)) - (dvd_lcm_right (lcm m n) k))) - -theorem lcm_ne_zero (hm : m ≠ 0) (hn : n ≠ 0) : lcm m n ≠ 0 := by - intro h - have h1 := gcd_mul_lcm m n - rw [h, Nat.mul_zero] at h1 - match mul_eq_zero.1 h1.symm with - | .inl hm1 => exact hm hm1 - | .inr hn1 => exact hn hn1 - /-! ### `coprime` See also `nat.coprime_of_dvd` and `nat.coprime_of_dvd'` to prove `nat.Coprime m n`. -/ +/-- `m` and `n` are coprime, or relatively prime, if their `gcd` is 1. -/ +@[reducible] def Coprime (m n : Nat) : Prop := gcd m n = 1 + instance (m n : Nat) : Decidable (Coprime m n) := inferInstanceAs (Decidable (_ = 1)) theorem coprime_iff_gcd_eq_one : Coprime m n ↔ gcd m n = 1 := .rfl @@ -358,29 +162,6 @@ theorem Coprime.pow {k l : Nat} (m n : Nat) (H1 : Coprime k l) : Coprime (k ^ m) theorem Coprime.eq_one_of_dvd {k m : Nat} (H : Coprime k m) (d : k ∣ m) : k = 1 := by rw [← H.gcd_eq_one, gcd_eq_left d] -/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`. -/ -def prod_dvd_and_dvd_of_dvd_prod {k m n : Nat} (H : k ∣ m * n) : - {d : {m' // m' ∣ m} × {n' // n' ∣ n} // k = d.1.val * d.2.val} := - if h0 : gcd k m = 0 then - ⟨⟨⟨0, eq_zero_of_gcd_eq_zero_right h0 ▸ Nat.dvd_refl 0⟩, - ⟨n, Nat.dvd_refl n⟩⟩, - eq_zero_of_gcd_eq_zero_left h0 ▸ (Nat.zero_mul n).symm⟩ - else by - have hd : gcd k m * (k / gcd k m) = k := Nat.mul_div_cancel' (gcd_dvd_left k m) - refine ⟨⟨⟨gcd k m, gcd_dvd_right k m⟩, ⟨k / gcd k m, ?_⟩⟩, hd.symm⟩ - apply Nat.dvd_of_mul_dvd_mul_left (Nat.pos_of_ne_zero h0) - rw [hd, ← gcd_mul_right] - exact Nat.dvd_gcd (Nat.dvd_mul_right _ _) H - -theorem gcd_mul_dvd_mul_gcd (k m n : Nat) : gcd k (m * n) ∣ gcd k m * gcd k n := by - let ⟨⟨⟨m', hm'⟩, ⟨n', hn'⟩⟩, (h : gcd k (m * n) = m' * n')⟩ := - prod_dvd_and_dvd_of_dvd_prod <| gcd_dvd_right k (m * n) - rw [h] - have h' : m' * n' ∣ k := h ▸ gcd_dvd_left .. - exact Nat.mul_dvd_mul - (dvd_gcd (Nat.dvd_trans (Nat.dvd_mul_right m' n') h') hm') - (dvd_gcd (Nat.dvd_trans (Nat.dvd_mul_left n' m') h') hn') - theorem Coprime.gcd_mul (k : Nat) (h : Coprime m n) : gcd k (m * n) = gcd k m * gcd k n := Nat.dvd_antisymm (gcd_mul_dvd_mul_gcd k m n) diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index a0c16adb9d..96037949de 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -137,47 +137,7 @@ theorem recDiagOn_succ_succ {motive : Nat → Nat → Sort _} (zero_zero : motiv (succ_succ : ∀ m n, motive (m+1) (n+1)) (m n) : Nat.casesDiagOn (m+1) (n+1) zero_zero zero_succ succ_zero succ_succ = succ_succ m n := rfl -/-! ## compare -/ - -theorem compare_def_lt (a b : Nat) : - compare a b = if a < b then .lt else if b < a then .gt else .eq := by - simp only [compare, compareOfLessAndEq] - split - · rfl - · next h => - match Nat.lt_or_eq_of_le (Nat.not_lt.1 h) with - | .inl h => simp [h, Nat.ne_of_gt h] - | .inr rfl => simp - -theorem compare_def_le (a b : Nat) : - compare a b = if a ≤ b then if b ≤ a then .eq else .lt else .gt := by - rw [compare_def_lt] - split - · next hlt => simp [Nat.le_of_lt hlt, Nat.not_le.2 hlt] - · next hge => - split - · next hgt => simp [Nat.le_of_lt hgt, Nat.not_le.2 hgt] - · next hle => simp [Nat.not_lt.1 hge, Nat.not_lt.1 hle] - -protected theorem compare_swap (a b : Nat) : (compare a b).swap = compare b a := by - simp only [compare_def_le]; (repeat' split) <;> try rfl - next h1 h2 => cases h1 (Nat.le_of_not_le h2) - -protected theorem compare_eq_eq {a b : Nat} : compare a b = .eq ↔ a = b := by - rw [compare_def_lt]; (repeat' split) <;> simp [Nat.ne_of_lt, Nat.ne_of_gt, *] - next hlt hgt => exact Nat.le_antisymm (Nat.not_lt.1 hgt) (Nat.not_lt.1 hlt) - -protected theorem compare_eq_lt {a b : Nat} : compare a b = .lt ↔ a < b := by - rw [compare_def_lt]; (repeat' split) <;> simp [*] - -protected theorem compare_eq_gt {a b : Nat} : compare a b = .gt ↔ b < a := by - rw [compare_def_lt]; (repeat' split) <;> simp [Nat.le_of_lt, *] - -protected theorem compare_ne_gt {a b : Nat} : compare a b ≠ .gt ↔ a ≤ b := by - rw [compare_def_le]; (repeat' split) <;> simp [*] - -protected theorem compare_ne_lt {a b : Nat} : compare a b ≠ .lt ↔ b ≤ a := by - rw [compare_def_le]; (repeat' split) <;> simp [Nat.le_of_not_le, *] +/-! ## strong case -/ /-- Strong case analysis on `a < b ∨ b ≤ a` -/ protected def lt_sum_ge (a b : Nat) : a < b ⊕' b ≤ a := @@ -200,40 +160,6 @@ protected def sum_trichotomy (a b : Nat) : a < b ⊕' a = b ⊕' b < a := @[deprecated] protected alias le_of_le_of_sub_le_sub_left := Nat.le_of_sub_le_sub_left -/-! ### min/max -/ - -protected theorem sub_min_sub_left (a b c : Nat) : min (a - b) (a - c) = a - max b c := by - induction b, c using Nat.recDiagAux with - | zero_left => rw [Nat.sub_zero, Nat.zero_max]; exact Nat.min_eq_right (Nat.sub_le ..) - | zero_right => rw [Nat.sub_zero, Nat.max_zero]; exact Nat.min_eq_left (Nat.sub_le ..) - | succ_succ _ _ ih => simp only [Nat.sub_succ, Nat.succ_max_succ, Nat.pred_min_pred, ih] - -protected theorem sub_max_sub_left (a b c : Nat) : max (a - b) (a - c) = a - min b c := by - induction b, c using Nat.recDiagAux with - | zero_left => rw [Nat.sub_zero, Nat.zero_min]; exact Nat.max_eq_left (Nat.sub_le ..) - | zero_right => rw [Nat.sub_zero, Nat.min_zero]; exact Nat.max_eq_right (Nat.sub_le ..) - | succ_succ _ _ ih => simp only [Nat.sub_succ, Nat.succ_min_succ, Nat.pred_max_pred, ih] - -protected theorem mul_max_mul_right (a b c : Nat) : max (a * c) (b * c) = max a b * c := by - induction a, b using Nat.recDiagAux with - | zero_left => simp only [Nat.zero_mul, Nat.zero_max] - | zero_right => simp only [Nat.zero_mul, Nat.max_zero] - | succ_succ _ _ ih => simp only [Nat.succ_mul, Nat.add_max_add_right, ih] - -protected theorem mul_min_mul_right (a b c : Nat) : min (a * c) (b * c) = min a b * c := by - induction a, b using Nat.recDiagAux with - | zero_left => simp only [Nat.zero_mul, Nat.zero_min] - | zero_right => simp only [Nat.zero_mul, Nat.min_zero] - | succ_succ _ _ ih => simp only [Nat.succ_mul, Nat.add_min_add_right, ih] - -protected theorem mul_max_mul_left (a b c : Nat) : max (a * b) (a * c) = a * max b c := by - repeat rw [Nat.mul_comm a] - exact Nat.mul_max_mul_right .. - -protected theorem mul_min_mul_left (a b c : Nat) : min (a * b) (a * c) = a * min b c := by - repeat rw [Nat.mul_comm a] - exact Nat.mul_min_mul_right .. - /-! ### mul -/ @[deprecated] protected alias mul_lt_mul := Nat.mul_lt_mul_of_lt_of_le' From 004e8d1f4287b95daa6384bb78dabfadc1918cf9 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Thu, 7 Mar 2024 14:48:32 -0800 Subject: [PATCH 134/213] chore: reduce imports --- Std/Data/Array/Lemmas.lean | 1 - Std/Data/Array/Match.lean | 1 - Std/Data/Array/Merge.lean | 2 -- Std/Data/BinomialHeap/Basic.lean | 1 - Std/Data/BitVec/Lemmas.lean | 5 +---- Std/Data/HashMap/WF.lean | 2 +- Std/Data/Int/DivMod.lean | 1 - Std/Data/Int/Gcd.lean | 1 - Std/Data/Int/Order.lean | 9 +++++---- Std/Data/List/Lemmas.lean | 7 ++----- Std/Data/List/Perm.lean | 5 ++--- Std/Data/Nat/Lemmas.lean | 1 - Std/Data/RBMap/Lemmas.lean | 1 - Std/Data/String/Basic.lean | 1 - Std/Data/String/Lemmas.lean | 1 - Std/Lean/Meta/UnusedNames.lean | 1 + 16 files changed, 12 insertions(+), 28 deletions(-) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 555598b53c..b28aca375f 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Gabriel Ebner -/ -import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.Array.Init.Lemmas import Std.Data.Array.Basic diff --git a/Std/Data/Array/Match.lean b/Std/Data/Array/Match.lean index 282846f956..46b2239f6f 100644 --- a/Std/Data/Array/Match.lean +++ b/Std/Data/Array/Match.lean @@ -3,7 +3,6 @@ Copyright (c) 2023 F. G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: F. G. Dorais -/ -import Std.Data.Nat.Lemmas namespace Array diff --git a/Std/Data/Array/Merge.lean b/Std/Data/Array/Merge.lean index 35c5f4b4b0..fbda9fbe3c 100644 --- a/Std/Data/Array/Merge.lean +++ b/Std/Data/Array/Merge.lean @@ -4,8 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ -import Std.Data.Nat.Lemmas - namespace Array /-- diff --git a/Std/Data/BinomialHeap/Basic.lean b/Std/Data/BinomialHeap/Basic.lean index 1756167cf8..c14eb7f083 100644 --- a/Std/Data/BinomialHeap/Basic.lean +++ b/Std/Data/BinomialHeap/Basic.lean @@ -5,7 +5,6 @@ Authors: Leonardo de Moura, Jannis Limperg, Mario Carneiro -/ import Std.Classes.Order import Std.Control.ForInStep.Basic -import Std.Data.Nat.Lemmas namespace Std namespace BinomialHeap diff --git a/Std/Data/BitVec/Lemmas.lean b/Std/Data/BitVec/Lemmas.lean index 437ab0358e..3316865e45 100644 --- a/Std/Data/BitVec/Lemmas.lean +++ b/Std/Data/BitVec/Lemmas.lean @@ -3,10 +3,7 @@ Copyright (c) 2023 Lean FRO, LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joe Hendrix -/ -import Std.Data.Bool -import Std.Data.Fin.Lemmas -import Std.Data.Nat.Lemmas -import Std.Util.ProofWanted +import Std.Tactic.Alias namespace BitVec diff --git a/Std/Data/HashMap/WF.lean b/Std/Data/HashMap/WF.lean index 025f31252b..25075d4dd4 100644 --- a/Std/Data/HashMap/WF.lean +++ b/Std/Data/HashMap/WF.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.HashMap.Basic -import Std.Data.List.Lemmas import Std.Data.Array.Lemmas +import Std.Data.Nat.Lemmas namespace Std.HashMap namespace Imp diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 4ba5091ade..6428f85963 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -3,7 +3,6 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ -import Std.Data.Nat.Lemmas import Std.Data.Int.Order /-! diff --git a/Std/Data/Int/Gcd.lean b/Std/Data/Int/Gcd.lean index a825845693..02506a13a4 100644 --- a/Std/Data/Int/Gcd.lean +++ b/Std/Data/Int/Gcd.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import Std.Data.Int.DivMod -import Std.Data.Nat.Gcd /-! # Results about `Int.gcd`. diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 3efb3be5ea..2763b0bb7c 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -3,7 +3,7 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ -import Std.Data.Nat.Lemmas +import Std.Tactic.Alias /-! # Results about the order properties of the integers, and the integers as an ordered ring. @@ -15,7 +15,8 @@ namespace Int /-! ## Order properties of the integers -/ -protected alias ⟨lt_of_not_ge, not_le_of_gt⟩ := Int.not_le +protected theorem lt_of_not_ge {a b : Int} : ¬a ≤ b → b < a := Int.not_le.mp +protected theorem not_le_of_gt {a b : Int} : b < a → ¬a ≤ b := Int.not_le.mpr protected theorem le_of_not_le {a b : Int} : ¬ a ≤ b → b ≤ a := (Int.le_total a b).resolve_left @@ -489,8 +490,6 @@ theorem natAbs_mul_natAbs_eq {a b : Int} {c : Nat} theorem natAbs_eq_iff {a : Int} {n : Nat} : a.natAbs = n ↔ a = n ∨ a = -↑n := by rw [← Int.natAbs_eq_natAbs_iff, Int.natAbs_ofNat] -@[deprecated] alias ofNat_natAbs_eq_of_nonneg := natAbs_of_nonneg - theorem natAbs_add_le (a b : Int) : natAbs (a + b) ≤ natAbs a + natAbs b := by suffices ∀ a b : Nat, natAbs (subNatNat a b.succ) ≤ (a + b).succ by match a, b with @@ -527,3 +526,5 @@ theorem eq_natAbs_iff_mul_eq_zero : natAbs a = n ↔ (a - n) * (a + n) = 0 := by theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm | -[m+1], n => by constructor <;> nofun + +@[deprecated] alias ofNat_natAbs_eq_of_nonneg := natAbs_of_nonneg diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 236ea7666a..e69977f247 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -4,12 +4,9 @@ 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 -/ import Std.Control.ForInStep.Lemmas -import Std.Data.Bool -import Std.Data.Fin.Basic -import Std.Data.Nat.Lemmas +import Std.Data.Nat.Basic import Std.Data.List.Basic -import Std.Data.Option.Lemmas -import Std.Classes.BEq +import Std.Tactic.Init namespace List diff --git a/Std/Data/List/Perm.lean b/Std/Data/List/Perm.lean index eff8f8ff0e..aa382e3ad4 100644 --- a/Std/Data/List/Perm.lean +++ b/Std/Data/List/Perm.lean @@ -3,11 +3,10 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ +import Std.Tactic.Alias import Std.Tactic.Relation.Rfl -import Std.Data.List.Lemmas -import Std.Data.List.Count -import Std.Data.List.Pairwise import Std.Data.List.Init.Attach +import Std.Data.List.Pairwise /-! # List Permutations diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index 96037949de..ebcb8a37da 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import Std.Tactic.Alias -import Std.Tactic.Init import Std.Data.Nat.Basic /-! # Basic lemmas about natural numbers diff --git a/Std/Data/RBMap/Lemmas.lean b/Std/Data/RBMap/Lemmas.lean index 884472710e..64e26eb4a7 100644 --- a/Std/Data/RBMap/Lemmas.lean +++ b/Std/Data/RBMap/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.RBMap.Alter -import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas /-! diff --git a/Std/Data/String/Basic.lean b/Std/Data/String/Basic.lean index 072fbe0222..982c9560f4 100644 --- a/Std/Data/String/Basic.lean +++ b/Std/Data/String/Basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg, James Gallicchio, F. G. Dorais -/ -import Std.Data.Nat.Lemmas import Std.Data.Array.Match instance : Coe String Substring := ⟨String.toSubstring⟩ diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 11aee37ec7..f8131eeb14 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Bulhwi Cha, Mario Carneiro -/ import Std.Data.Char -import Std.Data.Nat.Lemmas import Std.Data.List.Lemmas import Std.Data.String.Basic import Std.Tactic.Lint.Misc diff --git a/Std/Lean/Meta/UnusedNames.lean b/Std/Lean/Meta/UnusedNames.lean index 76c13ef81c..9e7a9ab414 100644 --- a/Std/Lean/Meta/UnusedNames.lean +++ b/Std/Lean/Meta/UnusedNames.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ import Std.Data.String.Basic +import Lean.LocalContext open Lean Lean.Meta From a2a24795546fcef1a1890e90e5f71a1c02774540 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sun, 10 Mar 2024 09:15:22 +0000 Subject: [PATCH 135/213] chore: bump to nightly-2024-03-10 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index be92c8cfc8..38611e5a04 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-09 +leanprover/lean4:nightly-2024-03-10 From ea0bc70553dba22627b869c6f4519b19d0594d18 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 11 Mar 2024 09:16:27 +0000 Subject: [PATCH 136/213] chore: bump to nightly-2024-03-11 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 38611e5a04..8465e8d271 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-10 +leanprover/lean4:nightly-2024-03-11 From 2cd6bbf75ef4224fcba8a874c748a02100577ee3 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 12 Mar 2024 08:48:35 +1100 Subject: [PATCH 137/213] fix --- Std/Data/Int/DivMod.lean | 2 +- Std/Data/Nat/Basic.lean | 15 --------------- 2 files changed, 1 insertion(+), 16 deletions(-) diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 6428f85963..1d7371c7f9 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -152,7 +152,7 @@ theorem add_mul_ediv_left (a : Int) {b : Int} /-! ### mod -/ -theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by cases m <;> simp [fmod] +theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by cases m <;> simp [fmod, succ_eq_add_one] theorem negSucc_emod (m : Nat) {b : Int} (bpos : 0 < b) : -[m+1] % b = b - 1 - m % b := by rw [Int.sub_sub, Int.add_comm] diff --git a/Std/Data/Nat/Basic.lean b/Std/Data/Nat/Basic.lean index 11b8b3621e..9f7c7d8f36 100644 --- a/Std/Data/Nat/Basic.lean +++ b/Std/Data/Nat/Basic.lean @@ -6,14 +6,6 @@ Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro namespace Nat -/-- - Recursor identical to `Nat.rec` but uses notations `0` for `Nat.zero` and `·+1` for `Nat.succ` --/ -@[elab_as_elim] -protected def recAux {motive : Nat → Sort _} - (zero : motive 0) (succ : ∀ n, motive n → motive (n+1)) : (t : Nat) → motive t - | 0 => zero - | _+1 => succ _ (Nat.recAux zero succ _) /-- Recursor identical to `Nat.recOn` but uses notations `0` for `Nat.zero` and `·+1` for `Nat.succ` @@ -22,13 +14,6 @@ protected def recAux {motive : Nat → Sort _} protected def recAuxOn {motive : Nat → Sort _} (t : Nat) (zero : motive 0) (succ : ∀ n, motive n → motive (n+1)) : motive t := Nat.recAux zero succ t -/-- - Recursor identical to `Nat.casesOn` but uses notations `0` for `Nat.zero` and `·+1` for `Nat.succ` --/ -@[elab_as_elim] -protected def casesAuxOn {motive : Nat → Sort _} (t : Nat) (zero : motive 0) - (succ : ∀ n, motive (n+1)) : motive t := Nat.recAux zero (fun n _ => succ n) t - /-- Strong recursor for `Nat` -/ From dafa107b79de933c9e86ee80b29dbef225a05349 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 12 Mar 2024 13:39:35 +1100 Subject: [PATCH 138/213] fix tests --- test/alias.lean | 4 ++-- test/case.lean | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/alias.lean b/test/alias.lean index 0b8e125329..b28d09921b 100644 --- a/test/alias.lean +++ b/test/alias.lean @@ -86,9 +86,9 @@ unsafe alias barbaz3 := id @[deprecated] alias ⟨mpId, mprId⟩ := Iff.rfl -/-- info: A.mpId {a : Prop} (a✝ : a) : a -/ +/-- info: A.mpId {a : Prop} : a → a -/ #guard_msgs in #check mpId -/-- info: A.mprId {a : Prop} (a✝ : a) : a -/ +/-- info: A.mprId {a : Prop} : a → a -/ #guard_msgs in #check mprId /-- diff --git a/test/case.lean b/test/case.lean index f0bb9d9b5e..ab0b664218 100644 --- a/test/case.lean +++ b/test/case.lean @@ -221,6 +221,6 @@ example (n : Nat) : 0 ≤ n := by case _ : 0 ≤ 0 | succ n ih · guard_target =ₛ 0 ≤ 0 constructor - · guard_target =ₛ 0 ≤ Nat.succ n + · guard_target =ₛ 0 ≤ n + 1 guard_hyp ih : 0 ≤ n simp From 0936d27dd7e7000add5deb5777cc661090303c06 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 12 Mar 2024 13:43:03 +1100 Subject: [PATCH 139/213] fixes --- Std/Data/Nat/Lemmas.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Data/Nat/Lemmas.lean b/Std/Data/Nat/Lemmas.lean index ebcb8a37da..aea9678b6d 100644 --- a/Std/Data/Nat/Lemmas.lean +++ b/Std/Data/Nat/Lemmas.lean @@ -37,7 +37,7 @@ theorem recAuxOn_succ {motive : Nat → Sort _} (zero : motive 0) (succ : ∀ n, motive (n+1)) : Nat.casesAuxOn 0 zero succ = zero := rfl -@[simp] theorem casesAuxOn_succ {motive : Nat → Sort _} (zero : motive 0) +theorem casesAuxOn_succ {motive : Nat → Sort _} (zero : motive 0) (succ : ∀ n, motive (n+1)) (n) : Nat.casesAuxOn (n+1) zero succ = succ n := rfl From 0ef13c5c8fade0b7be276f0f74cbf4935e20ba5f Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 12 Mar 2024 19:11:42 +1100 Subject: [PATCH 140/213] chore: adaptations for nightly-2024-03-12 --- Std/Data/Int.lean | 1 - Std/Data/Int/DivMod.lean | 793 ----------------------------------- Std/Data/Int/Gcd.lean | 43 -- Std/Data/Int/Lemmas.lean | 1 - Std/Data/Int/Order.lean | 520 ----------------------- Std/Tactic/SqueezeScope.lean | 4 +- lean-toolchain | 2 +- 7 files changed, 3 insertions(+), 1361 deletions(-) delete mode 100644 Std/Data/Int/Gcd.lean diff --git a/Std/Data/Int.lean b/Std/Data/Int.lean index 9f2f799da1..685988478a 100644 --- a/Std/Data/Int.lean +++ b/Std/Data/Int.lean @@ -1,4 +1,3 @@ import Std.Data.Int.DivMod -import Std.Data.Int.Gcd import Std.Data.Int.Lemmas import Std.Data.Int.Order diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 1d7371c7f9..ed93565328 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -14,799 +14,6 @@ open Nat namespace Int -/-! ### `/` -/ - -theorem ofNat_div (m n : Nat) : ↑(m / n) = div ↑m ↑n := rfl - -theorem ofNat_fdiv : ∀ m n : Nat, ↑(m / n) = fdiv ↑m ↑n - | 0, _ => by simp [fdiv] - | succ _, _ => rfl - -theorem negSucc_ediv (m : Nat) {b : Int} (H : 0 < b) : -[m+1] / b = -(div m b + 1) := - match b, eq_succ_of_zero_lt H with - | _, ⟨_, rfl⟩ => rfl - -@[simp] protected theorem zero_div : ∀ b : Int, div 0 b = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => show -ofNat _ = _ by simp - -@[simp] theorem zero_fdiv (b : Int) : fdiv 0 b = 0 := by cases b <;> rfl - -@[simp] protected theorem div_zero : ∀ a : Int, div a 0 = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => rfl - -@[simp] protected theorem fdiv_zero : ∀ a : Int, fdiv a 0 = 0 - | 0 => rfl - | succ _ => rfl - | -[_+1] => rfl - -theorem fdiv_eq_ediv : ∀ (a : Int) {b : Int}, 0 ≤ b → fdiv a b = a / b - | 0, _, _ | -[_+1], 0, _ => by simp - | succ _, ofNat _, _ | -[_+1], succ _, _ => rfl - -theorem div_eq_ediv : ∀ {a b : Int}, 0 ≤ a → 0 ≤ b → a.div b = a / b - | 0, _, _, _ | _, 0, _, _ => by simp - | succ _, succ _, _, _ => rfl - -theorem fdiv_eq_div {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = div a b := - div_eq_ediv Ha Hb ▸ fdiv_eq_ediv _ Hb - -@[simp] protected theorem div_neg : ∀ a b : Int, a.div (-b) = -(a.div b) - | ofNat m, 0 => show ofNat (m / 0) = -↑(m / 0) by rw [Nat.div_zero]; rfl - | ofNat m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm - | ofNat m, succ n | -[m+1], 0 | -[m+1], -[n+1] => rfl - -@[simp] protected theorem neg_div : ∀ a b : Int, (-a).div b = -(a.div b) - | 0, n => by simp [Int.neg_zero] - | succ m, (n:Nat) | -[m+1], 0 | -[m+1], -[n+1] => rfl - | succ m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm - -protected theorem neg_div_neg (a b : Int) : (-a).div (-b) = a.div b := by - simp [Int.div_neg, Int.neg_div, Int.neg_neg] - -protected theorem div_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.div b := - match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_zero_le _ - -theorem fdiv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.fdiv b := - match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_fdiv .. ▸ ofNat_zero_le _ - -theorem ediv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a / b := - match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_zero_le _ - -protected theorem div_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a.div b ≤ 0 := - Int.nonpos_of_neg_nonneg <| Int.div_neg .. ▸ Int.div_nonneg Ha (Int.neg_nonneg_of_nonpos Hb) - -theorem fdiv_nonpos : ∀ {a b : Int}, 0 ≤ a → b ≤ 0 → a.fdiv b ≤ 0 - | 0, 0, _, _ | 0, -[_+1], _, _ | succ _, 0, _, _ | succ _, -[_+1], _, _ => ⟨_⟩ - -theorem ediv_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a / b ≤ 0 := - Int.nonpos_of_neg_nonneg <| Int.ediv_neg .. ▸ Int.ediv_nonneg Ha (Int.neg_nonneg_of_nonpos Hb) - -theorem fdiv_neg' : ∀ {a b : Int}, a < 0 → 0 < b → a.fdiv b < 0 - | -[_+1], succ _, _, _ => negSucc_lt_zero _ - -theorem ediv_neg' {a b : Int} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 := - match a, b, eq_negSucc_of_lt_zero Ha, eq_succ_of_zero_lt Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => negSucc_lt_zero _ - -@[simp] protected theorem div_one : ∀ a : Int, a.div 1 = a - | (n:Nat) => congrArg ofNat (Nat.div_one _) - | -[n+1] => by simp [Int.div, neg_ofNat_succ] - -@[simp] theorem fdiv_one : ∀ a : Int, a.fdiv 1 = a - | 0 => rfl - | succ _ => congrArg Nat.cast (Nat.div_one _) - | -[_+1] => congrArg negSucc (Nat.div_one _) - -theorem div_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.div b = 0 := - match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2 - -theorem ediv_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a / b = 0 := - match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2 - -theorem add_mul_ediv_left (a : Int) {b : Int} - (c : Int) (H : b ≠ 0) : (a + b * c) / b = a / b + c := - Int.mul_comm .. ▸ Int.add_mul_ediv_right _ _ H - -@[simp] theorem mul_fdiv_cancel (a : Int) {b : Int} (H : b ≠ 0) : fdiv (a * b) b = a := - if b0 : 0 ≤ b then by - rw [fdiv_eq_ediv _ b0, mul_ediv_cancel _ H] - else - match a, b, Int.not_le.1 b0 with - | 0, _, _ => by simp [Int.zero_mul] - | succ a, -[b+1], _ => congrArg ofNat <| Nat.mul_div_cancel (succ a) b.succ_pos - | -[a+1], -[b+1], _ => congrArg negSucc <| Nat.div_eq_of_lt_le - (le_of_lt_succ <| Nat.mul_lt_mul_of_pos_right a.lt_succ_self b.succ_pos) - (lt_succ_self _) - -@[simp] protected theorem mul_div_cancel (a : Int) {b : Int} (H : b ≠ 0) : (a * b).div b = a := - have : ∀ {a b : Nat}, (b : Int) ≠ 0 → (div (a * b) b : Int) = a := fun H => by - rw [← ofNat_mul, ← ofNat_div, - Nat.mul_div_cancel _ <| Nat.pos_of_ne_zero <| Int.ofNat_ne_zero.1 H] - match a, b, a.eq_nat_or_neg, b.eq_nat_or_neg with - | _, _, ⟨a, .inl rfl⟩, ⟨b, .inl rfl⟩ => this H - | _, _, ⟨a, .inl rfl⟩, ⟨b, .inr rfl⟩ => by - rw [Int.mul_neg, Int.neg_div, Int.div_neg, Int.neg_neg, - this (Int.neg_ne_zero.1 H)] - | _, _, ⟨a, .inr rfl⟩, ⟨b, .inl rfl⟩ => by rw [Int.neg_mul, Int.neg_div, this H] - | _, _, ⟨a, .inr rfl⟩, ⟨b, .inr rfl⟩ => by - rw [Int.neg_mul_neg, Int.div_neg, this (Int.neg_ne_zero.1 H)] - -@[simp] protected theorem mul_div_cancel_left (b : Int) (H : a ≠ 0) : (a * b).div a = b := - Int.mul_comm .. ▸ Int.mul_div_cancel _ H - -@[simp] theorem mul_fdiv_cancel_left (b : Int) (H : a ≠ 0) : fdiv (a * b) a = b := - Int.mul_comm .. ▸ Int.mul_fdiv_cancel _ H - -@[simp] protected theorem div_self {a : Int} (H : a ≠ 0) : a.div a = 1 := by - have := Int.mul_div_cancel 1 H; rwa [Int.one_mul] at this - -@[simp] protected theorem fdiv_self {a : Int} (H : a ≠ 0) : a.fdiv a = 1 := by - have := Int.mul_fdiv_cancel 1 H; rwa [Int.one_mul] at this - -/-! ### mod -/ - -theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by cases m <;> simp [fmod, succ_eq_add_one] - -theorem negSucc_emod (m : Nat) {b : Int} (bpos : 0 < b) : -[m+1] % b = b - 1 - m % b := by - rw [Int.sub_sub, Int.add_comm] - match b, eq_succ_of_zero_lt bpos with - | _, ⟨n, rfl⟩ => rfl - -@[simp] theorem zero_mod (b : Int) : mod 0 b = 0 := by cases b <;> simp [mod] - -@[simp] theorem zero_fmod (b : Int) : fmod 0 b = 0 := by cases b <;> rfl - -@[simp] theorem mod_zero : ∀ a : Int, mod a 0 = a - | ofNat _ => congrArg ofNat <| Nat.mod_zero _ - | -[_+1] => rfl - -@[simp] theorem fmod_zero : ∀ a : Int, fmod a 0 = a - | 0 => rfl - | succ _ => congrArg ofNat <| Nat.mod_zero _ - | -[_+1] => congrArg negSucc <| Nat.mod_zero _ - -theorem mod_add_div : ∀ a b : Int, mod a b + b * (a.div b) = a - | ofNat _, ofNat _ => congrArg ofNat (Nat.mod_add_div ..) - | ofNat m, -[n+1] => by - show (m % succ n + -↑(succ n) * -↑(m / succ n) : Int) = m - rw [Int.neg_mul_neg]; exact congrArg ofNat (Nat.mod_add_div ..) - | -[_+1], 0 => rfl - | -[m+1], ofNat n => by - show -(↑((succ m) % n) : Int) + ↑n * -↑(succ m / n) = -↑(succ m) - rw [Int.mul_neg, ← Int.neg_add] - exact congrArg (-ofNat ·) (Nat.mod_add_div ..) - | -[m+1], -[n+1] => by - show -(↑(succ m % succ n) : Int) + -↑(succ n) * ↑(succ m / succ n) = -↑(succ m) - rw [Int.neg_mul, ← Int.neg_add] - exact congrArg (-ofNat ·) (Nat.mod_add_div ..) - -theorem fmod_add_fdiv : ∀ a b : Int, a.fmod b + b * a.fdiv b = a - | 0, ofNat _ | 0, -[_+1] => congrArg ofNat <| by simp - | succ m, ofNat n => congrArg ofNat <| Nat.mod_add_div .. - | succ m, -[n+1] => by - show subNatNat (m % succ n) n + (↑(succ n * (m / succ n)) + n + 1) = (m + 1) - rw [Int.add_comm _ n, ← Int.add_assoc, ← Int.add_assoc, - Int.subNatNat_eq_coe, Int.sub_add_cancel] - exact congrArg (ofNat · + 1) <| Nat.mod_add_div .. - | -[_+1], 0 => by rw [fmod_zero]; rfl - | -[m+1], succ n => by - show subNatNat .. - (↑(succ n * (m / succ n)) + ↑(succ n)) = -↑(succ m) - rw [Int.subNatNat_eq_coe, ← Int.sub_sub, ← Int.neg_sub, Int.sub_sub, Int.sub_sub_self] - exact congrArg (-ofNat ·) <| Nat.succ_add .. ▸ Nat.mod_add_div .. ▸ rfl - | -[m+1], -[n+1] => by - show -(↑(succ m % succ n) : Int) + -↑(succ n * (succ m / succ n)) = -↑(succ m) - rw [← Int.neg_add]; exact congrArg (-ofNat ·) <| Nat.mod_add_div .. - -theorem div_add_mod (a b : Int) : b * a.div b + mod a b = a := - (Int.add_comm ..).trans (mod_add_div ..) - -theorem fdiv_add_fmod (a b : Int) : b * a.fdiv b + a.fmod b = a := - (Int.add_comm ..).trans (fmod_add_fdiv ..) - -theorem mod_def (a b : Int) : mod a b = a - b * a.div b := by - rw [← Int.add_sub_cancel (mod a b), mod_add_div] - -theorem fmod_def (a b : Int) : a.fmod b = a - b * a.fdiv b := by - rw [← Int.add_sub_cancel (a.fmod b), fmod_add_fdiv] - -theorem fmod_eq_emod (a : Int) {b : Int} (hb : 0 ≤ b) : fmod a b = a % b := by - simp [fmod_def, emod_def, fdiv_eq_ediv _ hb] - -theorem mod_eq_emod {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : mod a b = a % b := by - simp [emod_def, mod_def, div_eq_ediv ha hb] - -theorem fmod_eq_mod {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fmod a b = mod a b := - mod_eq_emod Ha Hb ▸ fmod_eq_emod _ Hb - -@[simp] theorem mod_neg (a b : Int) : mod a (-b) = mod a b := by - rw [mod_def, mod_def, Int.div_neg, Int.neg_mul_neg] - -@[simp] theorem emod_neg (a b : Int) : a % -b = a % b := by - rw [emod_def, emod_def, Int.ediv_neg, Int.neg_mul_neg] - -@[simp] theorem mod_one (a : Int) : mod a 1 = 0 := by - simp [mod_def, Int.div_one, Int.one_mul, Int.sub_self] - -@[simp] theorem fmod_one (a : Int) : a.fmod 1 = 0 := by - simp [fmod_def, Int.one_mul, Int.sub_self] - -theorem emod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a % b = a := - have b0 := Int.le_trans H1 (Int.le_of_lt H2) - match a, b, eq_ofNat_of_zero_le H1, eq_ofNat_of_zero_le b0 with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg ofNat <| Nat.mod_eq_of_lt (Int.ofNat_lt.1 H2) - -@[simp] theorem emod_self_add_one {x : Int} (h : 0 ≤ x) : x % (x + 1) = x := - emod_eq_of_lt h (Int.lt_succ x) - -theorem mod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : mod a b = a := by - rw [mod_eq_emod H1 (Int.le_trans H1 (Int.le_of_lt H2)), emod_eq_of_lt H1 H2] - -theorem fmod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.fmod b = a := by - rw [fmod_eq_emod _ (Int.le_trans H1 (Int.le_of_lt H2)), emod_eq_of_lt H1 H2] - -theorem mod_nonneg : ∀ {a : Int} (b : Int), 0 ≤ a → 0 ≤ mod a b - | ofNat _, -[_+1], _ | ofNat _, ofNat _, _ => ofNat_nonneg _ - -theorem fmod_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a.fmod b := - fmod_eq_mod ha hb ▸ mod_nonneg _ ha - -theorem fmod_nonneg' (a : Int) {b : Int} (hb : 0 < b) : 0 ≤ a.fmod b := - fmod_eq_emod _ (Int.le_of_lt hb) ▸ emod_nonneg _ (Int.ne_of_lt hb).symm - -theorem mod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : mod a b < b := - match a, b, eq_succ_of_zero_lt H with - | ofNat _, _, ⟨n, rfl⟩ => ofNat_lt.2 <| Nat.mod_lt _ n.succ_pos - | -[_+1], _, ⟨n, rfl⟩ => Int.lt_of_le_of_lt - (Int.neg_nonpos_of_nonneg <| Int.ofNat_nonneg _) (ofNat_pos.2 n.succ_pos) - -theorem fmod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : a.fmod b < b := - fmod_eq_emod _ (Int.le_of_lt H) ▸ emod_lt_of_pos a H - -theorem emod_two_eq (x : Int) : x % 2 = 0 ∨ x % 2 = 1 := by - have h₁ : 0 ≤ x % 2 := Int.emod_nonneg x (by decide) - have h₂ : x % 2 < 2 := Int.emod_lt_of_pos x (by decide) - match x % 2, h₁, h₂ with - | 0, _, _ => simp - | 1, _, _ => simp - -theorem mod_add_div' (m k : Int) : mod m k + m.div k * k = m := by - rw [Int.mul_comm]; apply mod_add_div - -theorem div_add_mod' (m k : Int) : m.div k * k + mod m k = m := by - rw [Int.mul_comm]; apply div_add_mod - -theorem ediv_add_emod' (m k : Int) : m / k * k + m % k = m := by - rw [Int.mul_comm]; apply ediv_add_emod - -theorem add_emod_eq_add_emod_left {m n k : Int} (i : Int) - (H : m % n = k % n) : (i + m) % n = (i + k) % n := by - rw [Int.add_comm, add_emod_eq_add_emod_right _ H, Int.add_comm] - -theorem emod_add_cancel_left {m n k i : Int} : (i + m) % n = (i + k) % n ↔ m % n = k % n := by - rw [Int.add_comm, Int.add_comm i, emod_add_cancel_right] - -theorem emod_sub_cancel_right {m n k : Int} (i) : (m - i) % n = (k - i) % n ↔ m % n = k % n := - emod_add_cancel_right _ - -theorem emod_eq_emod_iff_emod_sub_eq_zero {m n k : Int} : m % n = k % n ↔ (m - k) % n = 0 := - (emod_sub_cancel_right k).symm.trans <| by simp [Int.sub_self] - -@[simp] theorem mul_mod_left (a b : Int) : (a * b).mod b = 0 := - if h : b = 0 then by simp [h, Int.mul_zero] else by - rw [Int.mod_def, Int.mul_div_cancel _ h, Int.mul_comm, Int.sub_self] - -@[simp] theorem mul_fmod_left (a b : Int) : (a * b).fmod b = 0 := - if h : b = 0 then by simp [h, Int.mul_zero] else by - rw [Int.fmod_def, Int.mul_fdiv_cancel _ h, Int.mul_comm, Int.sub_self] - -@[simp] theorem mul_mod_right (a b : Int) : (a * b).mod a = 0 := by - rw [Int.mul_comm, mul_mod_left] - -@[simp] theorem mul_fmod_right (a b : Int) : (a * b).fmod a = 0 := by - rw [Int.mul_comm, mul_fmod_left] - -@[simp] theorem mod_self {a : Int} : a.mod a = 0 := by - have := mul_mod_left 1 a; rwa [Int.one_mul] at this - -@[simp] theorem fmod_self {a : Int} : a.fmod a = 0 := by - have := mul_fmod_left 1 a; rwa [Int.one_mul] at this - -protected theorem ediv_emod_unique {a b r q : Int} (h : 0 < b) : - a / b = q ∧ a % b = r ↔ r + b * q = a ∧ 0 ≤ r ∧ r < b := by - constructor - · intro ⟨rfl, rfl⟩ - exact ⟨emod_add_ediv a b, emod_nonneg _ (Int.ne_of_gt h), emod_lt_of_pos _ h⟩ - · intro ⟨rfl, hz, hb⟩ - constructor - · rw [Int.add_mul_ediv_left r q (Int.ne_of_gt h), ediv_eq_zero_of_lt hz hb] - simp [Int.zero_add] - · rw [add_mul_emod_self_left, emod_eq_of_lt hz hb] - -/-! ### properties of `/` and `%` -/ - -@[simp] theorem mul_ediv_mul_of_pos {a : Int} - (b c : Int) (H : 0 < a) : (a * b) / (a * c) = b / c := - suffices ∀ (m k : Nat) (b : Int), (m.succ * b) / (m.succ * k) = b / k from - match a, eq_succ_of_zero_lt H, c, Int.eq_nat_or_neg c with - | _, ⟨m, rfl⟩, _, ⟨k, .inl rfl⟩ => this _ .. - | _, ⟨m, rfl⟩, _, ⟨k, .inr rfl⟩ => by - rw [Int.mul_neg, Int.ediv_neg, Int.ediv_neg]; apply congrArg Neg.neg; apply this - fun m k b => - match b, k with - | ofNat n, k => congrArg ofNat (Nat.mul_div_mul_left _ _ m.succ_pos) - | -[n+1], 0 => by - rw [Int.ofNat_zero, Int.mul_zero, Int.ediv_zero, Int.ediv_zero] - | -[n+1], succ k => congrArg negSucc <| - show (m.succ * n + m) / (m.succ * k.succ) = n / k.succ by - apply Nat.div_eq_of_lt_le - · refine Nat.le_trans ?_ (Nat.le_add_right _ _) - rw [← Nat.mul_div_mul_left _ _ m.succ_pos] - apply Nat.div_mul_le_self - · show m.succ * n.succ ≤ _ - rw [Nat.mul_left_comm] - apply Nat.mul_le_mul_left - apply (Nat.div_lt_iff_lt_mul k.succ_pos).1 - apply Nat.lt_succ_self - - -@[simp] theorem mul_ediv_mul_of_pos_left - (a : Int) {b : Int} (c : Int) (H : 0 < b) : (a * b) / (c * b) = a / c := by - rw [Int.mul_comm, Int.mul_comm c, mul_ediv_mul_of_pos _ _ H] - -@[simp] theorem mul_emod_mul_of_pos - {a : Int} (b c : Int) (H : 0 < a) : (a * b) % (a * c) = a * (b % c) := by - rw [emod_def, emod_def, mul_ediv_mul_of_pos _ _ H, Int.mul_sub, Int.mul_assoc] - -theorem lt_div_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a.div b + 1) * b := by - rw [Int.add_mul, Int.one_mul, Int.mul_comm] - exact Int.lt_add_of_sub_left_lt <| Int.mod_def .. ▸ mod_lt_of_pos _ H - -theorem lt_ediv_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a / b + 1) * b := by - rw [Int.add_mul, Int.one_mul, Int.mul_comm] - exact Int.lt_add_of_sub_left_lt <| Int.emod_def .. ▸ emod_lt_of_pos _ H - -theorem lt_fdiv_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a.fdiv b + 1) * b := - Int.fdiv_eq_ediv _ (Int.le_of_lt H) ▸ lt_ediv_add_one_mul_self a H - -@[simp] theorem natAbs_div (a b : Int) : natAbs (a.div b) = (natAbs a).div (natAbs b) := - match a, b, eq_nat_or_neg a, eq_nat_or_neg b with - | _, _, ⟨_, .inl rfl⟩, ⟨_, .inl rfl⟩ => rfl - | _, _, ⟨_, .inl rfl⟩, ⟨_, .inr rfl⟩ => by rw [Int.div_neg, natAbs_neg, natAbs_neg]; rfl - | _, _, ⟨_, .inr rfl⟩, ⟨_, .inl rfl⟩ => by rw [Int.neg_div, natAbs_neg, natAbs_neg]; rfl - | _, _, ⟨_, .inr rfl⟩, ⟨_, .inr rfl⟩ => by rw [Int.neg_div_neg, natAbs_neg, natAbs_neg]; rfl - -theorem natAbs_div_le_natAbs (a b : Int) : natAbs (a / b) ≤ natAbs a := - match b, eq_nat_or_neg b with - | _, ⟨n, .inl rfl⟩ => aux _ _ - | _, ⟨n, .inr rfl⟩ => by rw [Int.ediv_neg, natAbs_neg]; apply aux -where - aux : ∀ (a : Int) (n : Nat), natAbs (a / n) ≤ natAbs a - | ofNat _, _ => Nat.div_le_self .. - | -[_+1], 0 => Nat.zero_le _ - | -[_+1], succ _ => Nat.succ_le_succ (Nat.div_le_self _ _) - -theorem ediv_le_self {a : Int} (b : Int) (Ha : 0 ≤ a) : a / b ≤ a := by - have := Int.le_trans le_natAbs (ofNat_le.2 <| natAbs_div_le_natAbs a b) - rwa [natAbs_of_nonneg Ha] at this - -theorem mul_div_cancel_of_mod_eq_zero {a b : Int} (H : a.mod b = 0) : b * (a.div b) = a := by - have := mod_add_div a b; rwa [H, Int.zero_add] at this - -theorem div_mul_cancel_of_mod_eq_zero {a b : Int} (H : a.mod b = 0) : a.div b * b = a := by - rw [Int.mul_comm, mul_div_cancel_of_mod_eq_zero H] - -/-! ### dvd -/ - -protected theorem dvd_add_left {a b c : Int} (H : a ∣ c) : a ∣ b + c ↔ a ∣ b := - ⟨fun h => by have := Int.dvd_sub h H; rwa [Int.add_sub_cancel] at this, (Int.dvd_add · H)⟩ - -protected theorem dvd_add_right {a b c : Int} (H : a ∣ b) : a ∣ b + c ↔ a ∣ c := by - rw [Int.add_comm, Int.dvd_add_left H] - -protected theorem dvd_iff_dvd_of_dvd_sub {a b c : Int} (H : a ∣ b - c) : a ∣ b ↔ a ∣ c := - ⟨fun h => Int.sub_sub_self b c ▸ Int.dvd_sub h H, - fun h => Int.sub_add_cancel b c ▸ Int.dvd_add H h⟩ - -protected theorem dvd_iff_dvd_of_dvd_add {a b c : Int} (H : a ∣ b + c) : a ∣ b ↔ a ∣ c := by - rw [← Int.sub_neg] at H; rw [Int.dvd_iff_dvd_of_dvd_sub H, Int.dvd_neg] - -theorem natAbs_dvd {a b : Int} : (a.natAbs : Int) ∣ b ↔ a ∣ b := - match natAbs_eq a with - | .inl e => by rw [← e] - | .inr e => by rw [← Int.neg_dvd, ← e] - -theorem dvd_natAbs {a b : Int} : a ∣ b.natAbs ↔ a ∣ b := - match natAbs_eq b with - | .inl e => by rw [← e] - | .inr e => by rw [← Int.dvd_neg, ← e] - -theorem natAbs_dvd_self {a : Int} : (a.natAbs : Int) ∣ a := by - rw [Int.natAbs_dvd] - exact Int.dvd_refl a - -theorem dvd_natAbs_self {a : Int} : a ∣ (a.natAbs : Int) := by - rw [Int.dvd_natAbs] - exact Int.dvd_refl a - -theorem ofNat_dvd_right {n : Nat} {z : Int} : z ∣ (↑n : Int) ↔ z.natAbs ∣ n := by - rw [← natAbs_dvd_natAbs, natAbs_ofNat] - -theorem dvd_antisymm {a b : Int} (H1 : 0 ≤ a) (H2 : 0 ≤ b) : a ∣ b → b ∣ a → a = b := by - rw [← natAbs_of_nonneg H1, ← natAbs_of_nonneg H2] - rw [ofNat_dvd, ofNat_dvd, ofNat_inj] - apply Nat.dvd_antisymm - -theorem dvd_of_mod_eq_zero {a b : Int} (H : mod b a = 0) : a ∣ b := - ⟨b.div a, (mul_div_cancel_of_mod_eq_zero H).symm⟩ - -theorem mod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → mod b a = 0 - | _, _, ⟨_, rfl⟩ => mul_mod_right .. - -theorem dvd_iff_mod_eq_zero (a b : Int) : a ∣ b ↔ mod b a = 0 := - ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ - -/-- If `a % b = c` then `b` divides `a - c`. -/ -theorem dvd_sub_of_emod_eq {a b c : Int} (h : a % b = c) : b ∣ a - c := by - have hx : (a % b) % b = c % b := by - rw [h] - rw [Int.emod_emod, ← emod_sub_cancel_right c, Int.sub_self, zero_emod] at hx - exact dvd_of_emod_eq_zero hx - -protected theorem div_mul_cancel {a b : Int} (H : b ∣ a) : a.div b * b = a := - div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H) - -protected theorem mul_div_cancel' {a b : Int} (H : a ∣ b) : a * b.div a = b := by - rw [Int.mul_comm, Int.div_mul_cancel H] - -protected theorem mul_div_assoc (a : Int) : ∀ {b c : Int}, c ∣ b → (a * b).div c = a * (b.div c) - | _, c, ⟨d, rfl⟩ => - if cz : c = 0 then by simp [cz, Int.mul_zero] else by - rw [Int.mul_left_comm, Int.mul_div_cancel_left _ cz, Int.mul_div_cancel_left _ cz] - -protected theorem mul_div_assoc' (b : Int) {a c : Int} (h : c ∣ a) : - (a * b).div c = a.div c * b := by - rw [Int.mul_comm, Int.mul_div_assoc _ h, Int.mul_comm] - -theorem div_dvd_div : ∀ {a b c : Int}, a ∣ b → b ∣ c → b.div a ∣ c.div a - | a, _, _, ⟨b, rfl⟩, ⟨c, rfl⟩ => by - if az : a = 0 then simp [az] else - rw [Int.mul_div_cancel_left _ az, Int.mul_assoc, Int.mul_div_cancel_left _ az] - apply Int.dvd_mul_right - -protected theorem eq_mul_of_div_eq_right {a b c : Int} - (H1 : b ∣ a) (H2 : a.div b = c) : a = b * c := by rw [← H2, Int.mul_div_cancel' H1] - -protected theorem eq_mul_of_ediv_eq_right {a b c : Int} - (H1 : b ∣ a) (H2 : a / b = c) : a = b * c := by rw [← H2, Int.mul_ediv_cancel' H1] - -protected theorem div_eq_of_eq_mul_right {a b c : Int} - (H1 : b ≠ 0) (H2 : a = b * c) : a.div b = c := by rw [H2, Int.mul_div_cancel_left _ H1] - -protected theorem ediv_eq_of_eq_mul_right {a b c : Int} - (H1 : b ≠ 0) (H2 : a = b * c) : a / b = c := by rw [H2, Int.mul_ediv_cancel_left _ H1] - -protected theorem eq_div_of_mul_eq_right {a b c : Int} - (H1 : a ≠ 0) (H2 : a * b = c) : b = c.div a := - (Int.div_eq_of_eq_mul_right H1 H2.symm).symm - -protected theorem eq_ediv_of_mul_eq_right {a b c : Int} - (H1 : a ≠ 0) (H2 : a * b = c) : b = c / a := - (Int.ediv_eq_of_eq_mul_right H1 H2.symm).symm - -protected theorem div_eq_iff_eq_mul_right {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a.div b = c ↔ a = b * c := - ⟨Int.eq_mul_of_div_eq_right H', Int.div_eq_of_eq_mul_right H⟩ - -protected theorem ediv_eq_iff_eq_mul_right {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a / b = c ↔ a = b * c := - ⟨Int.eq_mul_of_ediv_eq_right H', Int.ediv_eq_of_eq_mul_right H⟩ - -protected theorem div_eq_iff_eq_mul_left {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a.div b = c ↔ a = c * b := by - rw [Int.mul_comm]; exact Int.div_eq_iff_eq_mul_right H H' - -protected theorem ediv_eq_iff_eq_mul_left {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a / b = c ↔ a = c * b := by - rw [Int.mul_comm]; exact Int.ediv_eq_iff_eq_mul_right H H' - -protected theorem eq_mul_of_div_eq_left {a b c : Int} - (H1 : b ∣ a) (H2 : a.div b = c) : a = c * b := by - rw [Int.mul_comm, Int.eq_mul_of_div_eq_right H1 H2] - -protected theorem eq_mul_of_ediv_eq_left {a b c : Int} - (H1 : b ∣ a) (H2 : a / b = c) : a = c * b := by - rw [Int.mul_comm, Int.eq_mul_of_ediv_eq_right H1 H2] - -protected theorem div_eq_of_eq_mul_left {a b c : Int} - (H1 : b ≠ 0) (H2 : a = c * b) : a.div b = c := - Int.div_eq_of_eq_mul_right H1 (by rw [Int.mul_comm, H2]) - -protected theorem ediv_eq_of_eq_mul_left {a b c : Int} - (H1 : b ≠ 0) (H2 : a = c * b) : a / b = c := - Int.ediv_eq_of_eq_mul_right H1 (by rw [Int.mul_comm, H2]) - -protected theorem eq_zero_of_div_eq_zero {d n : Int} (h : d ∣ n) (H : n.div d = 0) : n = 0 := by - rw [← Int.mul_div_cancel' h, H, Int.mul_zero] - -protected theorem eq_zero_of_ediv_eq_zero {d n : Int} (h : d ∣ n) (H : n / d = 0) : n = 0 := by - rw [← Int.mul_ediv_cancel' h, H, Int.mul_zero] - -theorem div_eq_ediv_of_dvd {a b : Int} (h : b ∣ a) : a.div b = a / b := by - if b0 : b = 0 then simp [b0] - else rw [Int.div_eq_iff_eq_mul_left b0 h, ← Int.ediv_eq_iff_eq_mul_left b0 h] - -theorem fdiv_eq_ediv_of_dvd : ∀ {a b : Int}, b ∣ a → a.fdiv b = a / b - | _, b, ⟨c, rfl⟩ => by if bz : b = 0 then simp [bz] else - rw [mul_fdiv_cancel_left _ bz, mul_ediv_cancel_left _ bz] - -theorem sub_ediv_of_dvd_sub {a b c : Int} - (hcab : c ∣ a - b) : (a - b) / c = a / c - b / c := by - rw [← Int.add_sub_cancel ((a-b) / c), ← Int.add_ediv_of_dvd_left hcab, Int.sub_add_cancel] - -@[simp] protected theorem div_left_inj {a b d : Int} - (hda : d ∣ a) (hdb : d ∣ b) : a.div d = b.div d ↔ a = b := by - refine ⟨fun h => ?_, congrArg (div · d)⟩ - rw [← Int.mul_div_cancel' hda, ← Int.mul_div_cancel' hdb, h] - -@[simp] protected theorem ediv_left_inj {a b d : Int} - (hda : d ∣ a) (hdb : d ∣ b) : a / d = b / d ↔ a = b := by - refine ⟨fun h => ?_, congrArg (ediv · d)⟩ - rw [← Int.mul_ediv_cancel' hda, ← Int.mul_ediv_cancel' hdb, h] - -theorem div_sign : ∀ a b, a.div (sign b) = a * sign b - | _, succ _ => by simp [sign, Int.mul_one] - | _, 0 => by simp [sign, Int.mul_zero] - | _, -[_+1] => by simp [sign, Int.mul_neg, Int.mul_one] - -theorem ediv_sign : ∀ a b, a / sign b = a * sign b - | _, succ _ => by simp [sign, Int.mul_one] - | _, 0 => by simp [sign, Int.mul_zero] - | _, -[_+1] => by simp [sign, Int.mul_neg, Int.mul_one] - -protected theorem sign_eq_div_abs (a : Int) : sign a = a.div (natAbs a) := - if az : a = 0 then by simp [az] else - (Int.div_eq_of_eq_mul_left (ofNat_ne_zero.2 <| natAbs_ne_zero.2 az) - (sign_mul_natAbs _).symm).symm - -theorem mul_sign : ∀ i : Int, i * sign i = natAbs i - | succ _ => Int.mul_one _ - | 0 => Int.mul_zero _ - | -[_+1] => Int.mul_neg_one _ - -theorem le_of_dvd {a b : Int} (bpos : 0 < b) (H : a ∣ b) : a ≤ b := - match a, b, eq_succ_of_zero_lt bpos, H with - | ofNat _, _, ⟨n, rfl⟩, H => ofNat_le.2 <| Nat.le_of_dvd n.succ_pos <| ofNat_dvd.1 H - | -[_+1], _, ⟨_, rfl⟩, _ => Int.le_trans (Int.le_of_lt <| negSucc_lt_zero _) (ofNat_zero_le _) - -theorem eq_one_of_dvd_one {a : Int} (H : 0 ≤ a) (H' : a ∣ 1) : a = 1 := - match a, eq_ofNat_of_zero_le H, H' with - | _, ⟨_, rfl⟩, H' => congrArg ofNat <| Nat.eq_one_of_dvd_one <| ofNat_dvd.1 H' - -theorem eq_one_of_mul_eq_one_right {a b : Int} (H : 0 ≤ a) (H' : a * b = 1) : a = 1 := - eq_one_of_dvd_one H ⟨b, H'.symm⟩ - -theorem eq_one_of_mul_eq_one_left {a b : Int} (H : 0 ≤ b) (H' : a * b = 1) : b = 1 := - eq_one_of_mul_eq_one_right H <| by rw [Int.mul_comm, H'] - -theorem le_of_mul_le_mul_left {a b c : Int} (w : a * b ≤ a * c) (h : 0 < a) : b ≤ c := by - have w := Int.sub_nonneg_of_le w - rw [← Int.mul_sub] at w - have w := Int.ediv_nonneg w (Int.le_of_lt h) - rw [Int.mul_ediv_cancel_left _ (Int.ne_of_gt h)] at w - exact Int.le_of_sub_nonneg w - -theorem le_of_mul_le_mul_right {a b c : Int} (w : b * a ≤ c * a) (h : 0 < a) : b ≤ c := by - rw [Int.mul_comm b, Int.mul_comm c] at w - exact le_of_mul_le_mul_left w h - -theorem lt_of_mul_lt_mul_left {a b c : Int} (w : a * b < a * c) (h : 0 ≤ a) : b < c := by - rcases Int.lt_trichotomy b c with lt | rfl | gt - · exact lt - · exact False.elim (Int.lt_irrefl _ w) - · rcases Int.lt_trichotomy a 0 with a_lt | rfl | a_gt - · exact False.elim (Int.lt_irrefl _ (Int.lt_of_lt_of_le a_lt h)) - · exact False.elim (Int.lt_irrefl b (by simp at w)) - · have := le_of_mul_le_mul_left (Int.le_of_lt w) a_gt - exact False.elim (Int.lt_irrefl _ (Int.lt_of_lt_of_le gt this)) - -theorem lt_of_mul_lt_mul_right {a b c : Int} (w : b * a < c * a) (h : 0 ≤ a) : b < c := by - rw [Int.mul_comm b, Int.mul_comm c] at w - exact lt_of_mul_lt_mul_left w h - -/-! -# `bmod` ("balanced" mod) - --/ - -theorem emod_bmod {x : Int} {m : Nat} : bmod (x % m) m = bmod x m := by - simp [bmod] - -@[simp] theorem bmod_bmod : bmod (bmod x m) m = bmod x m := by - rw [bmod, bmod_emod] - rfl - -@[simp] theorem bmod_zero : Int.bmod 0 m = 0 := by - dsimp [bmod] - simp only [zero_emod, Int.zero_sub, ite_eq_left_iff, Int.neg_eq_zero] - intro h - rw [@Int.not_lt] at h - match m with - | 0 => rfl - | (m+1) => - exfalso - rw [natCast_add, ofNat_one, Int.add_assoc, add_ediv_of_dvd_right] at h - change _ + 2 / 2 ≤ 0 at h - rw [Int.ediv_self, ← ofNat_two, ← ofNat_ediv, add_one_le_iff, ← @Int.not_le] at h - exact h (ofNat_nonneg _) - all_goals decide - -theorem dvd_bmod_sub_self {x : Int} {m : Nat} : (m : Int) ∣ bmod x m - x := by - dsimp [bmod] - split - · exact dvd_emod_sub_self - · rw [Int.sub_sub, Int.add_comm, ← Int.sub_sub] - exact Int.dvd_sub dvd_emod_sub_self (Int.dvd_refl _) - -theorem le_bmod {x : Int} {m : Nat} (h : 0 < m) : - (m/2) ≤ Int.bmod x m := by - dsimp [bmod] - have v : (m : Int) % 2 = 0 ∨ (m : Int) % 2 = 1 := emod_two_eq _ - split <;> rename_i w - · refine Int.le_trans ?_ (Int.emod_nonneg _ ?_) - · exact Int.neg_nonpos_of_nonneg (Int.ediv_nonneg (Int.ofNat_nonneg _) (by decide)) - · exact Int.ne_of_gt (ofNat_pos.mpr h) - · simp [Int.not_lt] at w - refine Int.le_trans ?_ (Int.sub_le_sub_right w _) - rw [← ediv_add_emod m 2] - generalize (m : Int) / 2 = q - generalize h : (m : Int) % 2 = r at * - rcases v with rfl | rfl - · rw [Int.add_zero, Int.mul_ediv_cancel_left, Int.add_ediv_of_dvd_left, - Int.mul_ediv_cancel_left, show (1 / 2 : Int) = 0 by decide, Int.add_zero, - Int.neg_eq_neg_one_mul] - conv => rhs; congr; rw [← Int.one_mul q] - rw [← Int.sub_mul, show (1 - 2 : Int) = -1 by decide] - apply Int.le_refl - all_goals try decide - all_goals apply Int.dvd_mul_right - · rw [Int.add_ediv_of_dvd_left, Int.mul_ediv_cancel_left, - show (1 / 2 : Int) = 0 by decide, Int.add_assoc, Int.add_ediv_of_dvd_left, - Int.mul_ediv_cancel_left, show ((1 + 1) / 2 : Int) = 1 by decide, ← Int.sub_sub, - Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_right_comm, Int.add_assoc q, - show (1 + -1 : Int) = 0 by decide, Int.add_zero, ← Int.neg_mul] - rw [Int.neg_eq_neg_one_mul] - conv => rhs; congr; rw [← Int.one_mul q] - rw [← Int.add_mul, show (1 + -2 : Int) = -1 by decide] - apply Int.le_refl - all_goals try decide - all_goals try apply Int.dvd_mul_right - -theorem bmod_lt {x : Int} {m : Nat} (h : 0 < m) : bmod x m < (m + 1) / 2 := by - dsimp [bmod] - split - · assumption - · apply Int.lt_of_lt_of_le - · show _ < 0 - have : x % m < m := emod_lt_of_pos x (ofNat_pos.mpr h) - exact Int.sub_neg_of_lt this - · exact Int.le.intro_sub _ rfl - -theorem bmod_le {x : Int} {m : Nat} (h : 0 < m) : bmod x m ≤ (m - 1) / 2 := by - refine lt_add_one_iff.mp ?_ - calc - bmod x m < (m + 1) / 2 := bmod_lt h - _ = ((m + 1 - 2) + 2)/2 := by simp - _ = (m - 1) / 2 + 1 := by - rw [add_ediv_of_dvd_right] - · simp (config := {decide := true}) only [Int.ediv_self] - congr 2 - rw [Int.add_sub_assoc, ← Int.sub_neg] - congr - · trivial - --- This could be strengthed by changing to `w : x ≠ -1` if needed. -theorem bmod_natAbs_plus_one (x : Int) (w : 1 < x.natAbs) : bmod x (x.natAbs + 1) = - x.sign := by - have t₁ : ∀ (x : Nat), x % (x + 2) = x := - fun x => Nat.mod_eq_of_lt (Nat.lt_succ_of_lt (Nat.lt.base x)) - have t₂ : ∀ (x : Int), 0 ≤ x → x % (x + 2) = x := fun x h => by - match x, h with - | Int.ofNat x, _ => erw [← Int.ofNat_two, ← ofNat_add, ← ofNat_emod, t₁]; rfl - cases x with - | ofNat x => - simp only [bmod, ofNat_eq_coe, natAbs_ofNat, natCast_add, ofNat_one, - emod_self_add_one (ofNat_nonneg x)] - match x with - | 0 => rw [if_pos] <;> simp (config := {decide := true}) - | (x+1) => - rw [if_neg] - · simp [← Int.sub_sub] - · refine Int.not_lt.mpr ?_ - simp only [← natCast_add, ← ofNat_one, ← ofNat_two, ← ofNat_ediv] - match x with - | 0 => apply Int.le_refl - | (x+1) => - refine Int.ofNat_le.mpr ?_ - apply Nat.div_le_of_le_mul - simp only [Nat.two_mul, Nat.add_assoc] - apply Nat.add_le_add_left (Nat.add_le_add_left (Nat.add_le_add_left (Nat.le_add_left - _ _) _) _) - | negSucc x => - rw [bmod, natAbs_negSucc, natCast_add, ofNat_one, sign_negSucc, Int.neg_neg, - Nat.succ_eq_add_one, negSucc_emod] - erw [t₂] - · rw [natCast_add, ofNat_one, Int.add_sub_cancel, Int.add_comm, Int.add_sub_cancel, if_pos] - · match x, w with - | (x+1), _ => - rw [Int.add_assoc, add_ediv_of_dvd_right, show (1 + 1 : Int) = 2 by decide, Int.ediv_self] - apply Int.lt_add_one_of_le - rw [Int.add_comm, ofNat_add, Int.add_assoc, add_ediv_of_dvd_right, - show ((1 : Nat) + 1 : Int) = 2 by decide, Int.ediv_self] - apply Int.le_add_of_nonneg_left - exact Int.le.intro_sub _ rfl - all_goals decide - · exact ofNat_nonneg x - · exact succ_ofNat_pos (x + 1) - -/-! ### `/` and ordering -/ - -protected theorem ediv_mul_le (a : Int) {b : Int} (H : b ≠ 0) : a / b * b ≤ a := - Int.le_of_sub_nonneg <| by rw [Int.mul_comm, ← emod_def]; apply emod_nonneg _ H - -protected theorem ediv_le_of_le_mul {a b c : Int} (H : 0 < c) (H' : a ≤ b * c) : a / c ≤ b := - le_of_mul_le_mul_right (Int.le_trans (Int.ediv_mul_le _ (Int.ne_of_gt H)) H') H - -protected theorem mul_lt_of_lt_ediv {a b c : Int} (H : 0 < c) (H3 : a < b / c) : a * c < b := - Int.lt_of_not_ge <| mt (Int.ediv_le_of_le_mul H) (Int.not_le_of_gt H3) - -protected theorem mul_le_of_le_ediv {a b c : Int} (H1 : 0 < c) (H2 : a ≤ b / c) : a * c ≤ b := - Int.le_trans (Int.mul_le_mul_of_nonneg_right H2 (Int.le_of_lt H1)) - (Int.ediv_mul_le _ (Int.ne_of_gt H1)) - -protected theorem le_ediv_of_mul_le {a b c : Int} (H1 : 0 < c) (H2 : a * c ≤ b) : a ≤ b / c := - le_of_lt_add_one <| - lt_of_mul_lt_mul_right (Int.lt_of_le_of_lt H2 (lt_ediv_add_one_mul_self _ H1)) (Int.le_of_lt H1) - -protected theorem le_ediv_iff_mul_le {a b c : Int} (H : 0 < c) : a ≤ b / c ↔ a * c ≤ b := - ⟨Int.mul_le_of_le_ediv H, Int.le_ediv_of_mul_le H⟩ - -protected theorem ediv_le_ediv {a b c : Int} (H : 0 < c) (H' : a ≤ b) : a / c ≤ b / c := - Int.le_ediv_of_mul_le H (Int.le_trans (Int.ediv_mul_le _ (Int.ne_of_gt H)) H') - -protected theorem ediv_lt_of_lt_mul {a b c : Int} (H : 0 < c) (H' : a < b * c) : a / c < b := - Int.lt_of_not_ge <| mt (Int.mul_le_of_le_ediv H) (Int.not_le_of_gt H') - -protected theorem lt_mul_of_ediv_lt {a b c : Int} (H1 : 0 < c) (H2 : a / c < b) : a < b * c := - Int.lt_of_not_ge <| mt (Int.le_ediv_of_mul_le H1) (Int.not_le_of_gt H2) - -protected theorem ediv_lt_iff_lt_mul {a b c : Int} (H : 0 < c) : a / c < b ↔ a < b * c := - ⟨Int.lt_mul_of_ediv_lt H, Int.ediv_lt_of_lt_mul H⟩ - -protected theorem le_mul_of_ediv_le {a b c : Int} (H1 : 0 ≤ b) (H2 : b ∣ a) (H3 : a / b ≤ c) : - a ≤ c * b := by - rw [← Int.ediv_mul_cancel H2]; exact Int.mul_le_mul_of_nonneg_right H3 H1 - -protected theorem lt_ediv_of_mul_lt {a b c : Int} (H1 : 0 ≤ b) (H2 : b ∣ c) (H3 : a * b < c) : - a < c / b := - Int.lt_of_not_ge <| mt (Int.le_mul_of_ediv_le H1 H2) (Int.not_le_of_gt H3) - -protected theorem lt_ediv_iff_mul_lt {a b : Int} (c : Int) (H : 0 < c) (H' : c ∣ b) : - a < b / c ↔ a * c < b := - ⟨Int.mul_lt_of_lt_ediv H, Int.lt_ediv_of_mul_lt (Int.le_of_lt H) H'⟩ - -theorem ediv_pos_of_pos_of_dvd {a b : Int} (H1 : 0 < a) (H2 : 0 ≤ b) (H3 : b ∣ a) : 0 < a / b := - Int.lt_ediv_of_mul_lt H2 H3 (by rwa [Int.zero_mul]) - -theorem ediv_eq_ediv_of_mul_eq_mul {a b c d : Int} - (H2 : d ∣ c) (H3 : b ≠ 0) (H4 : d ≠ 0) (H5 : a * d = b * c) : a / b = c / d := - Int.ediv_eq_of_eq_mul_right H3 <| by - rw [← Int.mul_ediv_assoc _ H2]; exact (Int.ediv_eq_of_eq_mul_left H4 H5.symm).symm - /-! ### The following lemmas have been commented out here for a while, and need restoration. -/ diff --git a/Std/Data/Int/Gcd.lean b/Std/Data/Int/Gcd.lean deleted file mode 100644 index 02506a13a4..0000000000 --- a/Std/Data/Int/Gcd.lean +++ /dev/null @@ -1,43 +0,0 @@ -/- -Copyright (c) 2023 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import Std.Data.Int.DivMod - -/-! -# Results about `Int.gcd`. --/ - -namespace Int - -theorem gcd_dvd_left {a b : Int} : (gcd a b : Int) ∣ a := by - have := Nat.gcd_dvd_left a.natAbs b.natAbs - rw [← Int.ofNat_dvd] at this - exact Int.dvd_trans this natAbs_dvd_self - -theorem gcd_dvd_right {a b : Int} : (gcd a b : Int) ∣ b := by - have := Nat.gcd_dvd_right a.natAbs b.natAbs - rw [← Int.ofNat_dvd] at this - exact Int.dvd_trans this natAbs_dvd_self - -@[simp] theorem one_gcd {a : Int} : gcd 1 a = 1 := by simp [gcd] -@[simp] theorem gcd_one {a : Int} : gcd a 1 = 1 := by simp [gcd] - -@[simp] theorem neg_gcd {a b : Int} : gcd (-a) b = gcd a b := by simp [gcd] -@[simp] theorem gcd_neg {a b : Int} : gcd a (-b) = gcd a b := by simp [gcd] - -/-- Computes the least common multiple of two integers, as a `Nat`. -/ -def lcm (m n : Int) : Nat := m.natAbs.lcm n.natAbs - -theorem lcm_ne_zero (hm : m ≠ 0) (hn : n ≠ 0) : lcm m n ≠ 0 := by - simp only [lcm] - apply Nat.lcm_ne_zero <;> simpa - -theorem dvd_lcm_left {a b : Int} : a ∣ lcm a b := - Int.dvd_trans dvd_natAbs_self (Int.ofNat_dvd.mpr (Nat.dvd_lcm_left a.natAbs b.natAbs)) - -theorem dvd_lcm_right {a b : Int} : b ∣ lcm a b := - Int.dvd_trans dvd_natAbs_self (Int.ofNat_dvd.mpr (Nat.dvd_lcm_right a.natAbs b.natAbs)) - -@[simp] theorem lcm_self {a : Int} : lcm a a = a.natAbs := Nat.lcm_self _ diff --git a/Std/Data/Int/Lemmas.lean b/Std/Data/Int/Lemmas.lean index a449fdb06f..a4c91a0005 100644 --- a/Std/Data/Int/Lemmas.lean +++ b/Std/Data/Int/Lemmas.lean @@ -1,6 +1,5 @@ -- This is a backwards compatibility shim, after `Std.Data.Int.Lemmas` was split into smaller files. -- Hopefully it can later be removed. -import Std.Data.Int.Gcd import Std.Data.Int.Order import Std.Data.Int.DivMod diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 2763b0bb7c..6aef66829d 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -5,526 +5,6 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Tactic.Alias -/-! -# Results about the order properties of the integers, and the integers as an ordered ring. --/ - -open Nat - namespace Int -/-! ## Order properties of the integers -/ - -protected theorem lt_of_not_ge {a b : Int} : ¬a ≤ b → b < a := Int.not_le.mp -protected theorem not_le_of_gt {a b : Int} : b < a → ¬a ≤ b := Int.not_le.mpr - -protected theorem le_of_not_le {a b : Int} : ¬ a ≤ b → b ≤ a := (Int.le_total a b).resolve_left - -@[simp] theorem negSucc_not_pos (n : Nat) : 0 < -[n+1] ↔ False := by - simp only [Int.not_lt, iff_false]; constructor - -theorem eq_negSucc_of_lt_zero : ∀ {a : Int}, a < 0 → ∃ n : Nat, a = -[n+1] - | ofNat _, h => absurd h (Int.not_lt.2 (ofNat_zero_le _)) - | -[n+1], _ => ⟨n, rfl⟩ - -protected theorem lt_of_add_lt_add_left {a b c : Int} (h : a + b < a + c) : b < c := by - have : -a + (a + b) < -a + (a + c) := Int.add_lt_add_left h _ - simp [Int.neg_add_cancel_left] at this - assumption - -protected theorem lt_of_add_lt_add_right {a b c : Int} (h : a + b < c + b) : a < c := - Int.lt_of_add_lt_add_left (a := b) <| by rwa [Int.add_comm b a, Int.add_comm b c] - -protected theorem add_lt_add_iff_left (a : Int) : a + b < a + c ↔ b < c := - ⟨Int.lt_of_add_lt_add_left, (Int.add_lt_add_left · _)⟩ - -protected theorem add_lt_add_iff_right (c : Int) : a + c < b + c ↔ a < b := - ⟨Int.lt_of_add_lt_add_right, (Int.add_lt_add_right · _)⟩ - -protected theorem add_lt_add {a b c d : Int} (h₁ : a < b) (h₂ : c < d) : a + c < b + d := - Int.lt_trans (Int.add_lt_add_right h₁ c) (Int.add_lt_add_left h₂ b) - -protected theorem add_lt_add_of_le_of_lt {a b c d : Int} (h₁ : a ≤ b) (h₂ : c < d) : - a + c < b + d := - Int.lt_of_le_of_lt (Int.add_le_add_right h₁ c) (Int.add_lt_add_left h₂ b) - -protected theorem add_lt_add_of_lt_of_le {a b c d : Int} (h₁ : a < b) (h₂ : c ≤ d) : - a + c < b + d := - Int.lt_of_lt_of_le (Int.add_lt_add_right h₁ c) (Int.add_le_add_left h₂ b) - -protected theorem lt_add_of_pos_right (a : Int) {b : Int} (h : 0 < b) : a < a + b := by - have : a + 0 < a + b := Int.add_lt_add_left h a - rwa [Int.add_zero] at this - -protected theorem lt_add_of_pos_left (a : Int) {b : Int} (h : 0 < b) : a < b + a := by - have : 0 + a < b + a := Int.add_lt_add_right h a - rwa [Int.zero_add] at this - -protected theorem add_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b := - Int.zero_add 0 ▸ Int.add_le_add ha hb - -protected theorem add_pos {a b : Int} (ha : 0 < a) (hb : 0 < b) : 0 < a + b := - Int.zero_add 0 ▸ Int.add_lt_add ha hb - -protected theorem add_pos_of_pos_of_nonneg {a b : Int} (ha : 0 < a) (hb : 0 ≤ b) : 0 < a + b := - Int.zero_add 0 ▸ Int.add_lt_add_of_lt_of_le ha hb - -protected theorem add_pos_of_nonneg_of_pos {a b : Int} (ha : 0 ≤ a) (hb : 0 < b) : 0 < a + b := - Int.zero_add 0 ▸ Int.add_lt_add_of_le_of_lt ha hb - -protected theorem add_nonpos {a b : Int} (ha : a ≤ 0) (hb : b ≤ 0) : a + b ≤ 0 := - Int.zero_add 0 ▸ Int.add_le_add ha hb - -protected theorem add_neg {a b : Int} (ha : a < 0) (hb : b < 0) : a + b < 0 := - Int.zero_add 0 ▸ Int.add_lt_add ha hb - -protected theorem add_neg_of_neg_of_nonpos {a b : Int} (ha : a < 0) (hb : b ≤ 0) : a + b < 0 := - Int.zero_add 0 ▸ Int.add_lt_add_of_lt_of_le ha hb - -protected theorem add_neg_of_nonpos_of_neg {a b : Int} (ha : a ≤ 0) (hb : b < 0) : a + b < 0 := - Int.zero_add 0 ▸ Int.add_lt_add_of_le_of_lt ha hb - -protected theorem lt_add_of_le_of_pos {a b c : Int} (hbc : b ≤ c) (ha : 0 < a) : b < c + a := - Int.add_zero b ▸ Int.add_lt_add_of_le_of_lt hbc ha - -theorem add_one_le_iff {a b : Int} : a + 1 ≤ b ↔ a < b := .rfl - -theorem lt_add_one_iff {a b : Int} : a < b + 1 ↔ a ≤ b := Int.add_le_add_iff_right _ - -@[simp] theorem succ_ofNat_pos (n : Nat) : 0 < (n : Int) + 1 := - lt_add_one_iff.2 (ofNat_zero_le _) - -theorem le_add_one {a b : Int} (h : a ≤ b) : a ≤ b + 1 := - Int.le_of_lt (Int.lt_add_one_iff.2 h) - -protected theorem nonneg_of_neg_nonpos {a : Int} (h : -a ≤ 0) : 0 ≤ a := - Int.le_of_neg_le_neg <| by rwa [Int.neg_zero] - -protected theorem nonpos_of_neg_nonneg {a : Int} (h : 0 ≤ -a) : a ≤ 0 := - Int.le_of_neg_le_neg <| by rwa [Int.neg_zero] - -protected theorem lt_of_neg_lt_neg {a b : Int} (h : -b < -a) : a < b := - Int.neg_neg a ▸ Int.neg_neg b ▸ Int.neg_lt_neg h - -protected theorem pos_of_neg_neg {a : Int} (h : -a < 0) : 0 < a := - Int.lt_of_neg_lt_neg <| by rwa [Int.neg_zero] - -protected theorem neg_of_neg_pos {a : Int} (h : 0 < -a) : a < 0 := - have : -0 < -a := by rwa [Int.neg_zero] - Int.lt_of_neg_lt_neg this - -protected theorem le_neg_of_le_neg {a b : Int} (h : a ≤ -b) : b ≤ -a := by - have h := Int.neg_le_neg h - rwa [Int.neg_neg] at h - -protected theorem neg_le_of_neg_le {a b : Int} (h : -a ≤ b) : -b ≤ a := by - have h := Int.neg_le_neg h - rwa [Int.neg_neg] at h - -protected theorem lt_neg_of_lt_neg {a b : Int} (h : a < -b) : b < -a := by - have h := Int.neg_lt_neg h - rwa [Int.neg_neg] at h - -protected theorem neg_lt_of_neg_lt {a b : Int} (h : -a < b) : -b < a := by - have h := Int.neg_lt_neg h - rwa [Int.neg_neg] at h - -protected theorem sub_nonpos_of_le {a b : Int} (h : a ≤ b) : a - b ≤ 0 := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem le_of_sub_nonpos {a b : Int} (h : a - b ≤ 0) : a ≤ b := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem sub_neg_of_lt {a b : Int} (h : a < b) : a - b < 0 := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem lt_of_sub_neg {a b : Int} (h : a - b < 0) : a < b := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem add_le_of_le_neg_add {a b c : Int} (h : b ≤ -a + c) : a + b ≤ c := by - have h := Int.add_le_add_left h a - rwa [Int.add_neg_cancel_left] at h - -protected theorem le_neg_add_of_add_le {a b c : Int} (h : a + b ≤ c) : b ≤ -a + c := by - have h := Int.add_le_add_left h (-a) - rwa [Int.neg_add_cancel_left] at h - -protected theorem add_le_of_le_sub_left {a b c : Int} (h : b ≤ c - a) : a + b ≤ c := by - have h := Int.add_le_add_left h a - rwa [← Int.add_sub_assoc, Int.add_comm a c, Int.add_sub_cancel] at h - -protected theorem le_sub_left_of_add_le {a b c : Int} (h : a + b ≤ c) : b ≤ c - a := by - have h := Int.add_le_add_right h (-a) - rwa [Int.add_comm a b, Int.add_neg_cancel_right] at h - -protected theorem add_le_of_le_sub_right {a b c : Int} (h : a ≤ c - b) : a + b ≤ c := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel] at h - -protected theorem le_sub_right_of_add_le {a b c : Int} (h : a + b ≤ c) : a ≤ c - b := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_neg_cancel_right] at h - -protected theorem le_add_of_neg_add_le {a b c : Int} (h : -b + a ≤ c) : a ≤ b + c := by - have h := Int.add_le_add_left h b - rwa [Int.add_neg_cancel_left] at h - -protected theorem neg_add_le_of_le_add {a b c : Int} (h : a ≤ b + c) : -b + a ≤ c := by - have h := Int.add_le_add_left h (-b) - rwa [Int.neg_add_cancel_left] at h - -protected theorem le_add_of_sub_left_le {a b c : Int} (h : a - b ≤ c) : a ≤ b + c := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel, Int.add_comm] at h - -protected theorem le_add_of_sub_right_le {a b c : Int} (h : a - c ≤ b) : a ≤ b + c := by - have h := Int.add_le_add_right h c - rwa [Int.sub_add_cancel] at h - -protected theorem sub_right_le_of_le_add {a b c : Int} (h : a ≤ b + c) : a - c ≤ b := by - have h := Int.add_le_add_right h (-c) - rwa [Int.add_neg_cancel_right] at h - -protected theorem le_add_of_neg_add_le_left {a b c : Int} (h : -b + a ≤ c) : a ≤ b + c := by - rw [Int.add_comm] at h - exact Int.le_add_of_sub_left_le h - -protected theorem neg_add_le_left_of_le_add {a b c : Int} (h : a ≤ b + c) : -b + a ≤ c := by - rw [Int.add_comm] - exact Int.sub_left_le_of_le_add h - -protected theorem le_add_of_neg_add_le_right {a b c : Int} (h : -c + a ≤ b) : a ≤ b + c := by - rw [Int.add_comm] at h - exact Int.le_add_of_sub_right_le h - -protected theorem neg_add_le_right_of_le_add {a b c : Int} (h : a ≤ b + c) : -c + a ≤ b := by - rw [Int.add_comm] at h - exact Int.neg_add_le_left_of_le_add h - -protected theorem le_add_of_neg_le_sub_left {a b c : Int} (h : -a ≤ b - c) : c ≤ a + b := - Int.le_add_of_neg_add_le_left (Int.add_le_of_le_sub_right h) - -protected theorem neg_le_sub_left_of_le_add {a b c : Int} (h : c ≤ a + b) : -a ≤ b - c := by - have h := Int.le_neg_add_of_add_le (Int.sub_left_le_of_le_add h) - rwa [Int.add_comm] at h - -protected theorem le_add_of_neg_le_sub_right {a b c : Int} (h : -b ≤ a - c) : c ≤ a + b := - Int.le_add_of_sub_right_le (Int.add_le_of_le_sub_left h) - -protected theorem neg_le_sub_right_of_le_add {a b c : Int} (h : c ≤ a + b) : -b ≤ a - c := - Int.le_sub_left_of_add_le (Int.sub_right_le_of_le_add h) - -protected theorem sub_le_of_sub_le {a b c : Int} (h : a - b ≤ c) : a - c ≤ b := - Int.sub_left_le_of_le_add (Int.le_add_of_sub_right_le h) - -protected theorem sub_le_sub_left {a b : Int} (h : a ≤ b) (c : Int) : c - b ≤ c - a := - Int.add_le_add_left (Int.neg_le_neg h) c - -protected theorem sub_le_sub_right {a b : Int} (h : a ≤ b) (c : Int) : a - c ≤ b - c := - Int.add_le_add_right h (-c) - -protected theorem sub_le_sub {a b c d : Int} (hab : a ≤ b) (hcd : c ≤ d) : a - d ≤ b - c := - Int.add_le_add hab (Int.neg_le_neg hcd) - -protected theorem add_lt_of_lt_neg_add {a b c : Int} (h : b < -a + c) : a + b < c := by - have h := Int.add_lt_add_left h a - rwa [Int.add_neg_cancel_left] at h - -protected theorem lt_neg_add_of_add_lt {a b c : Int} (h : a + b < c) : b < -a + c := by - have h := Int.add_lt_add_left h (-a) - rwa [Int.neg_add_cancel_left] at h - -protected theorem add_lt_of_lt_sub_left {a b c : Int} (h : b < c - a) : a + b < c := by - have h := Int.add_lt_add_left h a - rwa [← Int.add_sub_assoc, Int.add_comm a c, Int.add_sub_cancel] at h - -protected theorem lt_sub_left_of_add_lt {a b c : Int} (h : a + b < c) : b < c - a := by - have h := Int.add_lt_add_right h (-a) - rwa [Int.add_comm a b, Int.add_neg_cancel_right] at h - -protected theorem add_lt_of_lt_sub_right {a b c : Int} (h : a < c - b) : a + b < c := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel] at h - -protected theorem lt_sub_right_of_add_lt {a b c : Int} (h : a + b < c) : a < c - b := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_neg_cancel_right] at h - -protected theorem lt_add_of_neg_add_lt {a b c : Int} (h : -b + a < c) : a < b + c := by - have h := Int.add_lt_add_left h b - rwa [Int.add_neg_cancel_left] at h - -protected theorem neg_add_lt_of_lt_add {a b c : Int} (h : a < b + c) : -b + a < c := by - have h := Int.add_lt_add_left h (-b) - rwa [Int.neg_add_cancel_left] at h - -protected theorem lt_add_of_sub_left_lt {a b c : Int} (h : a - b < c) : a < b + c := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel, Int.add_comm] at h - -protected theorem sub_left_lt_of_lt_add {a b c : Int} (h : a < b + c) : a - b < c := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_comm b c, Int.add_neg_cancel_right] at h - -protected theorem lt_add_of_sub_right_lt {a b c : Int} (h : a - c < b) : a < b + c := by - have h := Int.add_lt_add_right h c - rwa [Int.sub_add_cancel] at h - -protected theorem sub_right_lt_of_lt_add {a b c : Int} (h : a < b + c) : a - c < b := by - have h := Int.add_lt_add_right h (-c) - rwa [Int.add_neg_cancel_right] at h - -protected theorem lt_add_of_neg_add_lt_left {a b c : Int} (h : -b + a < c) : a < b + c := by - rw [Int.add_comm] at h - exact Int.lt_add_of_sub_left_lt h - -protected theorem neg_add_lt_left_of_lt_add {a b c : Int} (h : a < b + c) : -b + a < c := by - rw [Int.add_comm] - exact Int.sub_left_lt_of_lt_add h - -protected theorem lt_add_of_neg_add_lt_right {a b c : Int} (h : -c + a < b) : a < b + c := by - rw [Int.add_comm] at h - exact Int.lt_add_of_sub_right_lt h - -protected theorem neg_add_lt_right_of_lt_add {a b c : Int} (h : a < b + c) : -c + a < b := by - rw [Int.add_comm] at h - exact Int.neg_add_lt_left_of_lt_add h - -protected theorem lt_add_of_neg_lt_sub_left {a b c : Int} (h : -a < b - c) : c < a + b := - Int.lt_add_of_neg_add_lt_left (Int.add_lt_of_lt_sub_right h) - -protected theorem neg_lt_sub_left_of_lt_add {a b c : Int} (h : c < a + b) : -a < b - c := by - have h := Int.lt_neg_add_of_add_lt (Int.sub_left_lt_of_lt_add h) - rwa [Int.add_comm] at h - -protected theorem lt_add_of_neg_lt_sub_right {a b c : Int} (h : -b < a - c) : c < a + b := - Int.lt_add_of_sub_right_lt (Int.add_lt_of_lt_sub_left h) - -protected theorem neg_lt_sub_right_of_lt_add {a b c : Int} (h : c < a + b) : -b < a - c := - Int.lt_sub_left_of_add_lt (Int.sub_right_lt_of_lt_add h) - -protected theorem sub_lt_of_sub_lt {a b c : Int} (h : a - b < c) : a - c < b := - Int.sub_left_lt_of_lt_add (Int.lt_add_of_sub_right_lt h) - -protected theorem sub_lt_sub_left {a b : Int} (h : a < b) (c : Int) : c - b < c - a := - Int.add_lt_add_left (Int.neg_lt_neg h) c - -protected theorem sub_lt_sub_right {a b : Int} (h : a < b) (c : Int) : a - c < b - c := - Int.add_lt_add_right h (-c) - -protected theorem sub_lt_sub {a b c d : Int} (hab : a < b) (hcd : c < d) : a - d < b - c := - Int.add_lt_add hab (Int.neg_lt_neg hcd) - -protected theorem sub_lt_sub_of_le_of_lt {a b c d : Int} - (hab : a ≤ b) (hcd : c < d) : a - d < b - c := - Int.add_lt_add_of_le_of_lt hab (Int.neg_lt_neg hcd) - -protected theorem sub_lt_sub_of_lt_of_le {a b c d : Int} - (hab : a < b) (hcd : c ≤ d) : a - d < b - c := - Int.add_lt_add_of_lt_of_le hab (Int.neg_le_neg hcd) - -protected theorem add_le_add_three {a b c d e f : Int} - (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) : a + b + c ≤ d + e + f := - Int.add_le_add (Int.add_le_add h₁ h₂) h₃ - -theorem exists_eq_neg_ofNat {a : Int} (H : a ≤ 0) : ∃ n : Nat, a = -(n : Int) := - let ⟨n, h⟩ := eq_ofNat_of_zero_le (Int.neg_nonneg_of_nonpos H) - ⟨n, Int.eq_neg_of_eq_neg h.symm⟩ - -theorem lt_of_add_one_le {a b : Int} (H : a + 1 ≤ b) : a < b := H - -theorem lt_add_one_of_le {a b : Int} (H : a ≤ b) : a < b + 1 := Int.add_le_add_right H 1 - -theorem le_of_lt_add_one {a b : Int} (H : a < b + 1) : a ≤ b := Int.le_of_add_le_add_right H - -theorem sub_one_lt_of_le {a b : Int} (H : a ≤ b) : a - 1 < b := - Int.sub_right_lt_of_lt_add <| lt_add_one_of_le H - -theorem le_of_sub_one_lt {a b : Int} (H : a - 1 < b) : a ≤ b := - le_of_lt_add_one <| Int.lt_add_of_sub_right_lt H - -theorem le_sub_one_of_lt {a b : Int} (H : a < b) : a ≤ b - 1 := Int.le_sub_right_of_add_le H - -theorem lt_of_le_sub_one {a b : Int} (H : a ≤ b - 1) : a < b := Int.add_le_of_le_sub_right H - -/- ### Order properties and multiplication -/ - -protected theorem mul_lt_mul {a b c d : Int} - (h₁ : a < c) (h₂ : b ≤ d) (h₃ : 0 < b) (h₄ : 0 ≤ c) : a * b < c * d := - Int.lt_of_lt_of_le (Int.mul_lt_mul_of_pos_right h₁ h₃) (Int.mul_le_mul_of_nonneg_left h₂ h₄) - -protected theorem mul_lt_mul' {a b c d : Int} - (h₁ : a ≤ c) (h₂ : b < d) (h₃ : 0 ≤ b) (h₄ : 0 < c) : a * b < c * d := - Int.lt_of_le_of_lt (Int.mul_le_mul_of_nonneg_right h₁ h₃) (Int.mul_lt_mul_of_pos_left h₂ h₄) - -protected theorem mul_neg_of_pos_of_neg {a b : Int} (ha : 0 < a) (hb : b < 0) : a * b < 0 := by - have h : a * b < a * 0 := Int.mul_lt_mul_of_pos_left hb ha - rwa [Int.mul_zero] at h - -protected theorem mul_neg_of_neg_of_pos {a b : Int} (ha : a < 0) (hb : 0 < b) : a * b < 0 := by - have h : a * b < 0 * b := Int.mul_lt_mul_of_pos_right ha hb - rwa [Int.zero_mul] at h - -protected theorem mul_nonneg_of_nonpos_of_nonpos {a b : Int} - (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b := by - have : 0 * b ≤ a * b := Int.mul_le_mul_of_nonpos_right ha hb - rwa [Int.zero_mul] at this - -protected theorem mul_lt_mul_of_neg_left {a b c : Int} (h : b < a) (hc : c < 0) : c * a < c * b := - have : -c > 0 := Int.neg_pos_of_neg hc - have : -c * b < -c * a := Int.mul_lt_mul_of_pos_left h this - have : -(c * b) < -(c * a) := by - rwa [← Int.neg_mul_eq_neg_mul, ← Int.neg_mul_eq_neg_mul] at this - Int.lt_of_neg_lt_neg this - -protected theorem mul_lt_mul_of_neg_right {a b c : Int} (h : b < a) (hc : c < 0) : a * c < b * c := - have : -c > 0 := Int.neg_pos_of_neg hc - have : b * -c < a * -c := Int.mul_lt_mul_of_pos_right h this - have : -(b * c) < -(a * c) := by - rwa [← Int.neg_mul_eq_mul_neg, ← Int.neg_mul_eq_mul_neg] at this - Int.lt_of_neg_lt_neg this - -protected theorem mul_pos_of_neg_of_neg {a b : Int} (ha : a < 0) (hb : b < 0) : 0 < a * b := by - have : 0 * b < a * b := Int.mul_lt_mul_of_neg_right ha hb - rwa [Int.zero_mul] at this - -protected theorem mul_self_le_mul_self {a b : Int} (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b := - Int.mul_le_mul h2 h2 h1 (Int.le_trans h1 h2) - -protected theorem mul_self_lt_mul_self {a b : Int} (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b := - Int.mul_lt_mul' (Int.le_of_lt h2) h2 h1 (Int.lt_of_le_of_lt h1 h2) - -/- ## sign -/ - -@[simp] theorem sign_zero : sign 0 = 0 := rfl -@[simp] theorem sign_one : sign 1 = 1 := rfl -theorem sign_neg_one : sign (-1) = -1 := rfl - -@[simp] theorem sign_of_add_one (x : Nat) : Int.sign (x + 1) = 1 := rfl -@[simp] theorem sign_negSucc (x : Nat) : Int.sign (Int.negSucc x) = -1 := rfl - -theorem natAbs_sign (z : Int) : z.sign.natAbs = if z = 0 then 0 else 1 := - match z with | 0 | succ _ | -[_+1] => rfl - -theorem natAbs_sign_of_nonzero {z : Int} (hz : z ≠ 0) : z.sign.natAbs = 1 := by - rw [Int.natAbs_sign, if_neg hz] - -theorem sign_ofNat_of_nonzero {n : Nat} (hn : n ≠ 0) : Int.sign n = 1 := - match n, Nat.exists_eq_succ_of_ne_zero hn with - | _, ⟨n, rfl⟩ => Int.sign_of_add_one n - -@[simp] theorem sign_neg (z : Int) : Int.sign (-z) = -Int.sign z := by - match z with | 0 | succ _ | -[_+1] => rfl - -theorem sign_mul_natAbs : ∀ a : Int, sign a * natAbs a = a - | 0 => rfl - | succ _ => Int.one_mul _ - | -[_+1] => (Int.neg_eq_neg_one_mul _).symm - -@[simp] theorem sign_mul : ∀ a b, sign (a * b) = sign a * sign b - | a, 0 | 0, b => by simp [Int.mul_zero, Int.zero_mul] - | succ _, succ _ | succ _, -[_+1] | -[_+1], succ _ | -[_+1], -[_+1] => rfl - -theorem sign_eq_one_of_pos {a : Int} (h : 0 < a) : sign a = 1 := - match a, eq_succ_of_zero_lt h with - | _, ⟨_, rfl⟩ => rfl - -theorem sign_eq_neg_one_of_neg {a : Int} (h : a < 0) : sign a = -1 := - match a, eq_negSucc_of_lt_zero h with - | _, ⟨_, rfl⟩ => rfl - -theorem eq_zero_of_sign_eq_zero : ∀ {a : Int}, sign a = 0 → a = 0 - | 0, _ => rfl - -theorem pos_of_sign_eq_one : ∀ {a : Int}, sign a = 1 → 0 < a - | (_ + 1 : Nat), _ => ofNat_lt.2 (Nat.succ_pos _) - -theorem neg_of_sign_eq_neg_one : ∀ {a : Int}, sign a = -1 → a < 0 - | (_ + 1 : Nat), h => nomatch h - | 0, h => nomatch h - | -[_+1], _ => negSucc_lt_zero _ - -theorem sign_eq_one_iff_pos (a : Int) : sign a = 1 ↔ 0 < a := - ⟨pos_of_sign_eq_one, sign_eq_one_of_pos⟩ - -theorem sign_eq_neg_one_iff_neg (a : Int) : sign a = -1 ↔ a < 0 := - ⟨neg_of_sign_eq_neg_one, sign_eq_neg_one_of_neg⟩ - -@[simp] theorem sign_eq_zero_iff_zero (a : Int) : sign a = 0 ↔ a = 0 := - ⟨eq_zero_of_sign_eq_zero, fun h => by rw [h, sign_zero]⟩ - -@[simp] theorem sign_sign : sign (sign x) = sign x := by - match x with - | 0 => rfl - | .ofNat (_ + 1) => rfl - | .negSucc _ => rfl - -@[simp] theorem sign_nonneg : 0 ≤ sign x ↔ 0 ≤ x := by - match x with - | 0 => rfl - | .ofNat (_ + 1) => - simp (config := { decide := true }) only [sign, true_iff] - exact Int.le_add_one (ofNat_nonneg _) - | .negSucc _ => simp (config := { decide := true }) [sign] - -/- ## natAbs -/ - -theorem natAbs_ne_zero {a : Int} : a.natAbs ≠ 0 ↔ a ≠ 0 := not_congr Int.natAbs_eq_zero - -theorem natAbs_mul_self : ∀ {a : Int}, ↑(natAbs a * natAbs a) = a * a - | ofNat _ => rfl - | -[_+1] => rfl - -theorem eq_nat_or_neg (a : Int) : ∃ n : Nat, a = n ∨ a = -↑n := ⟨_, natAbs_eq a⟩ - -theorem natAbs_mul_natAbs_eq {a b : Int} {c : Nat} - (h : a * b = (c : Int)) : a.natAbs * b.natAbs = c := by rw [← natAbs_mul, h, natAbs] - -@[simp] theorem natAbs_mul_self' (a : Int) : (natAbs a * natAbs a : Int) = a * a := by - rw [← Int.ofNat_mul, natAbs_mul_self] - -theorem natAbs_eq_iff {a : Int} {n : Nat} : a.natAbs = n ↔ a = n ∨ a = -↑n := by - rw [← Int.natAbs_eq_natAbs_iff, Int.natAbs_ofNat] - -theorem natAbs_add_le (a b : Int) : natAbs (a + b) ≤ natAbs a + natAbs b := by - suffices ∀ a b : Nat, natAbs (subNatNat a b.succ) ≤ (a + b).succ by - match a, b with - | (a:Nat), (b:Nat) => rw [ofNat_add_ofNat, natAbs_ofNat]; apply Nat.le_refl - | (a:Nat), -[b+1] => rw [natAbs_ofNat, natAbs_negSucc]; apply this - | -[a+1], (b:Nat) => - rw [natAbs_negSucc, natAbs_ofNat, Nat.succ_add, Nat.add_comm a b]; apply this - | -[a+1], -[b+1] => rw [natAbs_negSucc, succ_add]; apply Nat.le_refl - refine fun a b => subNatNat_elim a b.succ - (fun m n i => n = b.succ → natAbs i ≤ (m + b).succ) ?_ - (fun i n (e : (n + i).succ = _) => ?_) rfl - · rintro i n rfl - rw [Nat.add_comm _ i, Nat.add_assoc] - exact Nat.le_add_right i (b.succ + b).succ - · apply succ_le_succ - rw [← succ.inj e, ← Nat.add_assoc, Nat.add_comm] - apply Nat.le_add_right - -theorem natAbs_sub_le (a b : Int) : natAbs (a - b) ≤ natAbs a + natAbs b := by - rw [← Int.natAbs_neg b]; apply natAbs_add_le - -theorem negSucc_eq' (m : Nat) : -[m+1] = -m - 1 := by simp only [negSucc_eq, Int.neg_add]; rfl - -theorem natAbs_lt_natAbs_of_nonneg_of_lt {a b : Int} - (w₁ : 0 ≤ a) (w₂ : a < b) : a.natAbs < b.natAbs := - match a, b, eq_ofNat_of_zero_le w₁, eq_ofNat_of_zero_le (Int.le_trans w₁ (Int.le_of_lt w₂)) with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_lt.1 w₂ - -theorem eq_natAbs_iff_mul_eq_zero : natAbs a = n ↔ (a - n) * (a + n) = 0 := by - rw [natAbs_eq_iff, Int.mul_eq_zero, ← Int.sub_neg, Int.sub_eq_zero, Int.sub_eq_zero] - -/-! ### toNat -/ - -theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n - | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm - | -[m+1], n => by constructor <;> nofun - @[deprecated] alias ofNat_natAbs_eq_of_nonneg := natAbs_of_nonneg diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 820618d84a..2b1420bfd5 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -107,8 +107,8 @@ elab_rules : tactic | some mvarId => replaceMainGoal [mvarId] pure usedSimps | ``Parser.Tactic.dsimp => do - let { ctx, .. } ← withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp) - dsimpLocation' ctx (expandOptLocation stx[5]) + let { ctx, simprocs, .. } ← withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp) + dsimpLocation' ctx simprocs (expandOptLocation stx[5]) | _ => Elab.throwUnsupportedSyntax let a := a.getId; let x := x.getId squeezeScopes.modify fun map => Id.run do diff --git a/lean-toolchain b/lean-toolchain index 8465e8d271..45ede451b4 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-11 +leanprover/lean4:nightly-2024-03-12 From 63320274940bb727ab5f785d89e9ca428ab3da4e Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 12 Mar 2024 19:15:16 +1100 Subject: [PATCH 141/213] chore: adaptations for nightly-2024-03-12 --- Std/Data/Int.lean | 1 - Std/Data/Int/DivMod.lean | 793 ----------------------------------- Std/Data/Int/Lemmas.lean | 1 - Std/Data/Int/Order.lean | 520 ----------------------- Std/Tactic/SqueezeScope.lean | 4 +- lean-toolchain | 2 +- 6 files changed, 3 insertions(+), 1318 deletions(-) diff --git a/Std/Data/Int.lean b/Std/Data/Int.lean index 9f2f799da1..685988478a 100644 --- a/Std/Data/Int.lean +++ b/Std/Data/Int.lean @@ -1,4 +1,3 @@ import Std.Data.Int.DivMod -import Std.Data.Int.Gcd import Std.Data.Int.Lemmas import Std.Data.Int.Order diff --git a/Std/Data/Int/DivMod.lean b/Std/Data/Int/DivMod.lean index 1d7371c7f9..ed93565328 100644 --- a/Std/Data/Int/DivMod.lean +++ b/Std/Data/Int/DivMod.lean @@ -14,799 +14,6 @@ open Nat namespace Int -/-! ### `/` -/ - -theorem ofNat_div (m n : Nat) : ↑(m / n) = div ↑m ↑n := rfl - -theorem ofNat_fdiv : ∀ m n : Nat, ↑(m / n) = fdiv ↑m ↑n - | 0, _ => by simp [fdiv] - | succ _, _ => rfl - -theorem negSucc_ediv (m : Nat) {b : Int} (H : 0 < b) : -[m+1] / b = -(div m b + 1) := - match b, eq_succ_of_zero_lt H with - | _, ⟨_, rfl⟩ => rfl - -@[simp] protected theorem zero_div : ∀ b : Int, div 0 b = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => show -ofNat _ = _ by simp - -@[simp] theorem zero_fdiv (b : Int) : fdiv 0 b = 0 := by cases b <;> rfl - -@[simp] protected theorem div_zero : ∀ a : Int, div a 0 = 0 - | ofNat _ => show ofNat _ = _ by simp - | -[_+1] => rfl - -@[simp] protected theorem fdiv_zero : ∀ a : Int, fdiv a 0 = 0 - | 0 => rfl - | succ _ => rfl - | -[_+1] => rfl - -theorem fdiv_eq_ediv : ∀ (a : Int) {b : Int}, 0 ≤ b → fdiv a b = a / b - | 0, _, _ | -[_+1], 0, _ => by simp - | succ _, ofNat _, _ | -[_+1], succ _, _ => rfl - -theorem div_eq_ediv : ∀ {a b : Int}, 0 ≤ a → 0 ≤ b → a.div b = a / b - | 0, _, _, _ | _, 0, _, _ => by simp - | succ _, succ _, _, _ => rfl - -theorem fdiv_eq_div {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = div a b := - div_eq_ediv Ha Hb ▸ fdiv_eq_ediv _ Hb - -@[simp] protected theorem div_neg : ∀ a b : Int, a.div (-b) = -(a.div b) - | ofNat m, 0 => show ofNat (m / 0) = -↑(m / 0) by rw [Nat.div_zero]; rfl - | ofNat m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm - | ofNat m, succ n | -[m+1], 0 | -[m+1], -[n+1] => rfl - -@[simp] protected theorem neg_div : ∀ a b : Int, (-a).div b = -(a.div b) - | 0, n => by simp [Int.neg_zero] - | succ m, (n:Nat) | -[m+1], 0 | -[m+1], -[n+1] => rfl - | succ m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm - -protected theorem neg_div_neg (a b : Int) : (-a).div (-b) = a.div b := by - simp [Int.div_neg, Int.neg_div, Int.neg_neg] - -protected theorem div_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.div b := - match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_zero_le _ - -theorem fdiv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.fdiv b := - match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_fdiv .. ▸ ofNat_zero_le _ - -theorem ediv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a / b := - match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_zero_le _ - -protected theorem div_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a.div b ≤ 0 := - Int.nonpos_of_neg_nonneg <| Int.div_neg .. ▸ Int.div_nonneg Ha (Int.neg_nonneg_of_nonpos Hb) - -theorem fdiv_nonpos : ∀ {a b : Int}, 0 ≤ a → b ≤ 0 → a.fdiv b ≤ 0 - | 0, 0, _, _ | 0, -[_+1], _, _ | succ _, 0, _, _ | succ _, -[_+1], _, _ => ⟨_⟩ - -theorem ediv_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a / b ≤ 0 := - Int.nonpos_of_neg_nonneg <| Int.ediv_neg .. ▸ Int.ediv_nonneg Ha (Int.neg_nonneg_of_nonpos Hb) - -theorem fdiv_neg' : ∀ {a b : Int}, a < 0 → 0 < b → a.fdiv b < 0 - | -[_+1], succ _, _, _ => negSucc_lt_zero _ - -theorem ediv_neg' {a b : Int} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 := - match a, b, eq_negSucc_of_lt_zero Ha, eq_succ_of_zero_lt Hb with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => negSucc_lt_zero _ - -@[simp] protected theorem div_one : ∀ a : Int, a.div 1 = a - | (n:Nat) => congrArg ofNat (Nat.div_one _) - | -[n+1] => by simp [Int.div, neg_ofNat_succ] - -@[simp] theorem fdiv_one : ∀ a : Int, a.fdiv 1 = a - | 0 => rfl - | succ _ => congrArg Nat.cast (Nat.div_one _) - | -[_+1] => congrArg negSucc (Nat.div_one _) - -theorem div_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.div b = 0 := - match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2 - -theorem ediv_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a / b = 0 := - match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2 - -theorem add_mul_ediv_left (a : Int) {b : Int} - (c : Int) (H : b ≠ 0) : (a + b * c) / b = a / b + c := - Int.mul_comm .. ▸ Int.add_mul_ediv_right _ _ H - -@[simp] theorem mul_fdiv_cancel (a : Int) {b : Int} (H : b ≠ 0) : fdiv (a * b) b = a := - if b0 : 0 ≤ b then by - rw [fdiv_eq_ediv _ b0, mul_ediv_cancel _ H] - else - match a, b, Int.not_le.1 b0 with - | 0, _, _ => by simp [Int.zero_mul] - | succ a, -[b+1], _ => congrArg ofNat <| Nat.mul_div_cancel (succ a) b.succ_pos - | -[a+1], -[b+1], _ => congrArg negSucc <| Nat.div_eq_of_lt_le - (le_of_lt_succ <| Nat.mul_lt_mul_of_pos_right a.lt_succ_self b.succ_pos) - (lt_succ_self _) - -@[simp] protected theorem mul_div_cancel (a : Int) {b : Int} (H : b ≠ 0) : (a * b).div b = a := - have : ∀ {a b : Nat}, (b : Int) ≠ 0 → (div (a * b) b : Int) = a := fun H => by - rw [← ofNat_mul, ← ofNat_div, - Nat.mul_div_cancel _ <| Nat.pos_of_ne_zero <| Int.ofNat_ne_zero.1 H] - match a, b, a.eq_nat_or_neg, b.eq_nat_or_neg with - | _, _, ⟨a, .inl rfl⟩, ⟨b, .inl rfl⟩ => this H - | _, _, ⟨a, .inl rfl⟩, ⟨b, .inr rfl⟩ => by - rw [Int.mul_neg, Int.neg_div, Int.div_neg, Int.neg_neg, - this (Int.neg_ne_zero.1 H)] - | _, _, ⟨a, .inr rfl⟩, ⟨b, .inl rfl⟩ => by rw [Int.neg_mul, Int.neg_div, this H] - | _, _, ⟨a, .inr rfl⟩, ⟨b, .inr rfl⟩ => by - rw [Int.neg_mul_neg, Int.div_neg, this (Int.neg_ne_zero.1 H)] - -@[simp] protected theorem mul_div_cancel_left (b : Int) (H : a ≠ 0) : (a * b).div a = b := - Int.mul_comm .. ▸ Int.mul_div_cancel _ H - -@[simp] theorem mul_fdiv_cancel_left (b : Int) (H : a ≠ 0) : fdiv (a * b) a = b := - Int.mul_comm .. ▸ Int.mul_fdiv_cancel _ H - -@[simp] protected theorem div_self {a : Int} (H : a ≠ 0) : a.div a = 1 := by - have := Int.mul_div_cancel 1 H; rwa [Int.one_mul] at this - -@[simp] protected theorem fdiv_self {a : Int} (H : a ≠ 0) : a.fdiv a = 1 := by - have := Int.mul_fdiv_cancel 1 H; rwa [Int.one_mul] at this - -/-! ### mod -/ - -theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by cases m <;> simp [fmod, succ_eq_add_one] - -theorem negSucc_emod (m : Nat) {b : Int} (bpos : 0 < b) : -[m+1] % b = b - 1 - m % b := by - rw [Int.sub_sub, Int.add_comm] - match b, eq_succ_of_zero_lt bpos with - | _, ⟨n, rfl⟩ => rfl - -@[simp] theorem zero_mod (b : Int) : mod 0 b = 0 := by cases b <;> simp [mod] - -@[simp] theorem zero_fmod (b : Int) : fmod 0 b = 0 := by cases b <;> rfl - -@[simp] theorem mod_zero : ∀ a : Int, mod a 0 = a - | ofNat _ => congrArg ofNat <| Nat.mod_zero _ - | -[_+1] => rfl - -@[simp] theorem fmod_zero : ∀ a : Int, fmod a 0 = a - | 0 => rfl - | succ _ => congrArg ofNat <| Nat.mod_zero _ - | -[_+1] => congrArg negSucc <| Nat.mod_zero _ - -theorem mod_add_div : ∀ a b : Int, mod a b + b * (a.div b) = a - | ofNat _, ofNat _ => congrArg ofNat (Nat.mod_add_div ..) - | ofNat m, -[n+1] => by - show (m % succ n + -↑(succ n) * -↑(m / succ n) : Int) = m - rw [Int.neg_mul_neg]; exact congrArg ofNat (Nat.mod_add_div ..) - | -[_+1], 0 => rfl - | -[m+1], ofNat n => by - show -(↑((succ m) % n) : Int) + ↑n * -↑(succ m / n) = -↑(succ m) - rw [Int.mul_neg, ← Int.neg_add] - exact congrArg (-ofNat ·) (Nat.mod_add_div ..) - | -[m+1], -[n+1] => by - show -(↑(succ m % succ n) : Int) + -↑(succ n) * ↑(succ m / succ n) = -↑(succ m) - rw [Int.neg_mul, ← Int.neg_add] - exact congrArg (-ofNat ·) (Nat.mod_add_div ..) - -theorem fmod_add_fdiv : ∀ a b : Int, a.fmod b + b * a.fdiv b = a - | 0, ofNat _ | 0, -[_+1] => congrArg ofNat <| by simp - | succ m, ofNat n => congrArg ofNat <| Nat.mod_add_div .. - | succ m, -[n+1] => by - show subNatNat (m % succ n) n + (↑(succ n * (m / succ n)) + n + 1) = (m + 1) - rw [Int.add_comm _ n, ← Int.add_assoc, ← Int.add_assoc, - Int.subNatNat_eq_coe, Int.sub_add_cancel] - exact congrArg (ofNat · + 1) <| Nat.mod_add_div .. - | -[_+1], 0 => by rw [fmod_zero]; rfl - | -[m+1], succ n => by - show subNatNat .. - (↑(succ n * (m / succ n)) + ↑(succ n)) = -↑(succ m) - rw [Int.subNatNat_eq_coe, ← Int.sub_sub, ← Int.neg_sub, Int.sub_sub, Int.sub_sub_self] - exact congrArg (-ofNat ·) <| Nat.succ_add .. ▸ Nat.mod_add_div .. ▸ rfl - | -[m+1], -[n+1] => by - show -(↑(succ m % succ n) : Int) + -↑(succ n * (succ m / succ n)) = -↑(succ m) - rw [← Int.neg_add]; exact congrArg (-ofNat ·) <| Nat.mod_add_div .. - -theorem div_add_mod (a b : Int) : b * a.div b + mod a b = a := - (Int.add_comm ..).trans (mod_add_div ..) - -theorem fdiv_add_fmod (a b : Int) : b * a.fdiv b + a.fmod b = a := - (Int.add_comm ..).trans (fmod_add_fdiv ..) - -theorem mod_def (a b : Int) : mod a b = a - b * a.div b := by - rw [← Int.add_sub_cancel (mod a b), mod_add_div] - -theorem fmod_def (a b : Int) : a.fmod b = a - b * a.fdiv b := by - rw [← Int.add_sub_cancel (a.fmod b), fmod_add_fdiv] - -theorem fmod_eq_emod (a : Int) {b : Int} (hb : 0 ≤ b) : fmod a b = a % b := by - simp [fmod_def, emod_def, fdiv_eq_ediv _ hb] - -theorem mod_eq_emod {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : mod a b = a % b := by - simp [emod_def, mod_def, div_eq_ediv ha hb] - -theorem fmod_eq_mod {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fmod a b = mod a b := - mod_eq_emod Ha Hb ▸ fmod_eq_emod _ Hb - -@[simp] theorem mod_neg (a b : Int) : mod a (-b) = mod a b := by - rw [mod_def, mod_def, Int.div_neg, Int.neg_mul_neg] - -@[simp] theorem emod_neg (a b : Int) : a % -b = a % b := by - rw [emod_def, emod_def, Int.ediv_neg, Int.neg_mul_neg] - -@[simp] theorem mod_one (a : Int) : mod a 1 = 0 := by - simp [mod_def, Int.div_one, Int.one_mul, Int.sub_self] - -@[simp] theorem fmod_one (a : Int) : a.fmod 1 = 0 := by - simp [fmod_def, Int.one_mul, Int.sub_self] - -theorem emod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a % b = a := - have b0 := Int.le_trans H1 (Int.le_of_lt H2) - match a, b, eq_ofNat_of_zero_le H1, eq_ofNat_of_zero_le b0 with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg ofNat <| Nat.mod_eq_of_lt (Int.ofNat_lt.1 H2) - -@[simp] theorem emod_self_add_one {x : Int} (h : 0 ≤ x) : x % (x + 1) = x := - emod_eq_of_lt h (Int.lt_succ x) - -theorem mod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : mod a b = a := by - rw [mod_eq_emod H1 (Int.le_trans H1 (Int.le_of_lt H2)), emod_eq_of_lt H1 H2] - -theorem fmod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.fmod b = a := by - rw [fmod_eq_emod _ (Int.le_trans H1 (Int.le_of_lt H2)), emod_eq_of_lt H1 H2] - -theorem mod_nonneg : ∀ {a : Int} (b : Int), 0 ≤ a → 0 ≤ mod a b - | ofNat _, -[_+1], _ | ofNat _, ofNat _, _ => ofNat_nonneg _ - -theorem fmod_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a.fmod b := - fmod_eq_mod ha hb ▸ mod_nonneg _ ha - -theorem fmod_nonneg' (a : Int) {b : Int} (hb : 0 < b) : 0 ≤ a.fmod b := - fmod_eq_emod _ (Int.le_of_lt hb) ▸ emod_nonneg _ (Int.ne_of_lt hb).symm - -theorem mod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : mod a b < b := - match a, b, eq_succ_of_zero_lt H with - | ofNat _, _, ⟨n, rfl⟩ => ofNat_lt.2 <| Nat.mod_lt _ n.succ_pos - | -[_+1], _, ⟨n, rfl⟩ => Int.lt_of_le_of_lt - (Int.neg_nonpos_of_nonneg <| Int.ofNat_nonneg _) (ofNat_pos.2 n.succ_pos) - -theorem fmod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : a.fmod b < b := - fmod_eq_emod _ (Int.le_of_lt H) ▸ emod_lt_of_pos a H - -theorem emod_two_eq (x : Int) : x % 2 = 0 ∨ x % 2 = 1 := by - have h₁ : 0 ≤ x % 2 := Int.emod_nonneg x (by decide) - have h₂ : x % 2 < 2 := Int.emod_lt_of_pos x (by decide) - match x % 2, h₁, h₂ with - | 0, _, _ => simp - | 1, _, _ => simp - -theorem mod_add_div' (m k : Int) : mod m k + m.div k * k = m := by - rw [Int.mul_comm]; apply mod_add_div - -theorem div_add_mod' (m k : Int) : m.div k * k + mod m k = m := by - rw [Int.mul_comm]; apply div_add_mod - -theorem ediv_add_emod' (m k : Int) : m / k * k + m % k = m := by - rw [Int.mul_comm]; apply ediv_add_emod - -theorem add_emod_eq_add_emod_left {m n k : Int} (i : Int) - (H : m % n = k % n) : (i + m) % n = (i + k) % n := by - rw [Int.add_comm, add_emod_eq_add_emod_right _ H, Int.add_comm] - -theorem emod_add_cancel_left {m n k i : Int} : (i + m) % n = (i + k) % n ↔ m % n = k % n := by - rw [Int.add_comm, Int.add_comm i, emod_add_cancel_right] - -theorem emod_sub_cancel_right {m n k : Int} (i) : (m - i) % n = (k - i) % n ↔ m % n = k % n := - emod_add_cancel_right _ - -theorem emod_eq_emod_iff_emod_sub_eq_zero {m n k : Int} : m % n = k % n ↔ (m - k) % n = 0 := - (emod_sub_cancel_right k).symm.trans <| by simp [Int.sub_self] - -@[simp] theorem mul_mod_left (a b : Int) : (a * b).mod b = 0 := - if h : b = 0 then by simp [h, Int.mul_zero] else by - rw [Int.mod_def, Int.mul_div_cancel _ h, Int.mul_comm, Int.sub_self] - -@[simp] theorem mul_fmod_left (a b : Int) : (a * b).fmod b = 0 := - if h : b = 0 then by simp [h, Int.mul_zero] else by - rw [Int.fmod_def, Int.mul_fdiv_cancel _ h, Int.mul_comm, Int.sub_self] - -@[simp] theorem mul_mod_right (a b : Int) : (a * b).mod a = 0 := by - rw [Int.mul_comm, mul_mod_left] - -@[simp] theorem mul_fmod_right (a b : Int) : (a * b).fmod a = 0 := by - rw [Int.mul_comm, mul_fmod_left] - -@[simp] theorem mod_self {a : Int} : a.mod a = 0 := by - have := mul_mod_left 1 a; rwa [Int.one_mul] at this - -@[simp] theorem fmod_self {a : Int} : a.fmod a = 0 := by - have := mul_fmod_left 1 a; rwa [Int.one_mul] at this - -protected theorem ediv_emod_unique {a b r q : Int} (h : 0 < b) : - a / b = q ∧ a % b = r ↔ r + b * q = a ∧ 0 ≤ r ∧ r < b := by - constructor - · intro ⟨rfl, rfl⟩ - exact ⟨emod_add_ediv a b, emod_nonneg _ (Int.ne_of_gt h), emod_lt_of_pos _ h⟩ - · intro ⟨rfl, hz, hb⟩ - constructor - · rw [Int.add_mul_ediv_left r q (Int.ne_of_gt h), ediv_eq_zero_of_lt hz hb] - simp [Int.zero_add] - · rw [add_mul_emod_self_left, emod_eq_of_lt hz hb] - -/-! ### properties of `/` and `%` -/ - -@[simp] theorem mul_ediv_mul_of_pos {a : Int} - (b c : Int) (H : 0 < a) : (a * b) / (a * c) = b / c := - suffices ∀ (m k : Nat) (b : Int), (m.succ * b) / (m.succ * k) = b / k from - match a, eq_succ_of_zero_lt H, c, Int.eq_nat_or_neg c with - | _, ⟨m, rfl⟩, _, ⟨k, .inl rfl⟩ => this _ .. - | _, ⟨m, rfl⟩, _, ⟨k, .inr rfl⟩ => by - rw [Int.mul_neg, Int.ediv_neg, Int.ediv_neg]; apply congrArg Neg.neg; apply this - fun m k b => - match b, k with - | ofNat n, k => congrArg ofNat (Nat.mul_div_mul_left _ _ m.succ_pos) - | -[n+1], 0 => by - rw [Int.ofNat_zero, Int.mul_zero, Int.ediv_zero, Int.ediv_zero] - | -[n+1], succ k => congrArg negSucc <| - show (m.succ * n + m) / (m.succ * k.succ) = n / k.succ by - apply Nat.div_eq_of_lt_le - · refine Nat.le_trans ?_ (Nat.le_add_right _ _) - rw [← Nat.mul_div_mul_left _ _ m.succ_pos] - apply Nat.div_mul_le_self - · show m.succ * n.succ ≤ _ - rw [Nat.mul_left_comm] - apply Nat.mul_le_mul_left - apply (Nat.div_lt_iff_lt_mul k.succ_pos).1 - apply Nat.lt_succ_self - - -@[simp] theorem mul_ediv_mul_of_pos_left - (a : Int) {b : Int} (c : Int) (H : 0 < b) : (a * b) / (c * b) = a / c := by - rw [Int.mul_comm, Int.mul_comm c, mul_ediv_mul_of_pos _ _ H] - -@[simp] theorem mul_emod_mul_of_pos - {a : Int} (b c : Int) (H : 0 < a) : (a * b) % (a * c) = a * (b % c) := by - rw [emod_def, emod_def, mul_ediv_mul_of_pos _ _ H, Int.mul_sub, Int.mul_assoc] - -theorem lt_div_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a.div b + 1) * b := by - rw [Int.add_mul, Int.one_mul, Int.mul_comm] - exact Int.lt_add_of_sub_left_lt <| Int.mod_def .. ▸ mod_lt_of_pos _ H - -theorem lt_ediv_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a / b + 1) * b := by - rw [Int.add_mul, Int.one_mul, Int.mul_comm] - exact Int.lt_add_of_sub_left_lt <| Int.emod_def .. ▸ emod_lt_of_pos _ H - -theorem lt_fdiv_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a.fdiv b + 1) * b := - Int.fdiv_eq_ediv _ (Int.le_of_lt H) ▸ lt_ediv_add_one_mul_self a H - -@[simp] theorem natAbs_div (a b : Int) : natAbs (a.div b) = (natAbs a).div (natAbs b) := - match a, b, eq_nat_or_neg a, eq_nat_or_neg b with - | _, _, ⟨_, .inl rfl⟩, ⟨_, .inl rfl⟩ => rfl - | _, _, ⟨_, .inl rfl⟩, ⟨_, .inr rfl⟩ => by rw [Int.div_neg, natAbs_neg, natAbs_neg]; rfl - | _, _, ⟨_, .inr rfl⟩, ⟨_, .inl rfl⟩ => by rw [Int.neg_div, natAbs_neg, natAbs_neg]; rfl - | _, _, ⟨_, .inr rfl⟩, ⟨_, .inr rfl⟩ => by rw [Int.neg_div_neg, natAbs_neg, natAbs_neg]; rfl - -theorem natAbs_div_le_natAbs (a b : Int) : natAbs (a / b) ≤ natAbs a := - match b, eq_nat_or_neg b with - | _, ⟨n, .inl rfl⟩ => aux _ _ - | _, ⟨n, .inr rfl⟩ => by rw [Int.ediv_neg, natAbs_neg]; apply aux -where - aux : ∀ (a : Int) (n : Nat), natAbs (a / n) ≤ natAbs a - | ofNat _, _ => Nat.div_le_self .. - | -[_+1], 0 => Nat.zero_le _ - | -[_+1], succ _ => Nat.succ_le_succ (Nat.div_le_self _ _) - -theorem ediv_le_self {a : Int} (b : Int) (Ha : 0 ≤ a) : a / b ≤ a := by - have := Int.le_trans le_natAbs (ofNat_le.2 <| natAbs_div_le_natAbs a b) - rwa [natAbs_of_nonneg Ha] at this - -theorem mul_div_cancel_of_mod_eq_zero {a b : Int} (H : a.mod b = 0) : b * (a.div b) = a := by - have := mod_add_div a b; rwa [H, Int.zero_add] at this - -theorem div_mul_cancel_of_mod_eq_zero {a b : Int} (H : a.mod b = 0) : a.div b * b = a := by - rw [Int.mul_comm, mul_div_cancel_of_mod_eq_zero H] - -/-! ### dvd -/ - -protected theorem dvd_add_left {a b c : Int} (H : a ∣ c) : a ∣ b + c ↔ a ∣ b := - ⟨fun h => by have := Int.dvd_sub h H; rwa [Int.add_sub_cancel] at this, (Int.dvd_add · H)⟩ - -protected theorem dvd_add_right {a b c : Int} (H : a ∣ b) : a ∣ b + c ↔ a ∣ c := by - rw [Int.add_comm, Int.dvd_add_left H] - -protected theorem dvd_iff_dvd_of_dvd_sub {a b c : Int} (H : a ∣ b - c) : a ∣ b ↔ a ∣ c := - ⟨fun h => Int.sub_sub_self b c ▸ Int.dvd_sub h H, - fun h => Int.sub_add_cancel b c ▸ Int.dvd_add H h⟩ - -protected theorem dvd_iff_dvd_of_dvd_add {a b c : Int} (H : a ∣ b + c) : a ∣ b ↔ a ∣ c := by - rw [← Int.sub_neg] at H; rw [Int.dvd_iff_dvd_of_dvd_sub H, Int.dvd_neg] - -theorem natAbs_dvd {a b : Int} : (a.natAbs : Int) ∣ b ↔ a ∣ b := - match natAbs_eq a with - | .inl e => by rw [← e] - | .inr e => by rw [← Int.neg_dvd, ← e] - -theorem dvd_natAbs {a b : Int} : a ∣ b.natAbs ↔ a ∣ b := - match natAbs_eq b with - | .inl e => by rw [← e] - | .inr e => by rw [← Int.dvd_neg, ← e] - -theorem natAbs_dvd_self {a : Int} : (a.natAbs : Int) ∣ a := by - rw [Int.natAbs_dvd] - exact Int.dvd_refl a - -theorem dvd_natAbs_self {a : Int} : a ∣ (a.natAbs : Int) := by - rw [Int.dvd_natAbs] - exact Int.dvd_refl a - -theorem ofNat_dvd_right {n : Nat} {z : Int} : z ∣ (↑n : Int) ↔ z.natAbs ∣ n := by - rw [← natAbs_dvd_natAbs, natAbs_ofNat] - -theorem dvd_antisymm {a b : Int} (H1 : 0 ≤ a) (H2 : 0 ≤ b) : a ∣ b → b ∣ a → a = b := by - rw [← natAbs_of_nonneg H1, ← natAbs_of_nonneg H2] - rw [ofNat_dvd, ofNat_dvd, ofNat_inj] - apply Nat.dvd_antisymm - -theorem dvd_of_mod_eq_zero {a b : Int} (H : mod b a = 0) : a ∣ b := - ⟨b.div a, (mul_div_cancel_of_mod_eq_zero H).symm⟩ - -theorem mod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → mod b a = 0 - | _, _, ⟨_, rfl⟩ => mul_mod_right .. - -theorem dvd_iff_mod_eq_zero (a b : Int) : a ∣ b ↔ mod b a = 0 := - ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ - -/-- If `a % b = c` then `b` divides `a - c`. -/ -theorem dvd_sub_of_emod_eq {a b c : Int} (h : a % b = c) : b ∣ a - c := by - have hx : (a % b) % b = c % b := by - rw [h] - rw [Int.emod_emod, ← emod_sub_cancel_right c, Int.sub_self, zero_emod] at hx - exact dvd_of_emod_eq_zero hx - -protected theorem div_mul_cancel {a b : Int} (H : b ∣ a) : a.div b * b = a := - div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H) - -protected theorem mul_div_cancel' {a b : Int} (H : a ∣ b) : a * b.div a = b := by - rw [Int.mul_comm, Int.div_mul_cancel H] - -protected theorem mul_div_assoc (a : Int) : ∀ {b c : Int}, c ∣ b → (a * b).div c = a * (b.div c) - | _, c, ⟨d, rfl⟩ => - if cz : c = 0 then by simp [cz, Int.mul_zero] else by - rw [Int.mul_left_comm, Int.mul_div_cancel_left _ cz, Int.mul_div_cancel_left _ cz] - -protected theorem mul_div_assoc' (b : Int) {a c : Int} (h : c ∣ a) : - (a * b).div c = a.div c * b := by - rw [Int.mul_comm, Int.mul_div_assoc _ h, Int.mul_comm] - -theorem div_dvd_div : ∀ {a b c : Int}, a ∣ b → b ∣ c → b.div a ∣ c.div a - | a, _, _, ⟨b, rfl⟩, ⟨c, rfl⟩ => by - if az : a = 0 then simp [az] else - rw [Int.mul_div_cancel_left _ az, Int.mul_assoc, Int.mul_div_cancel_left _ az] - apply Int.dvd_mul_right - -protected theorem eq_mul_of_div_eq_right {a b c : Int} - (H1 : b ∣ a) (H2 : a.div b = c) : a = b * c := by rw [← H2, Int.mul_div_cancel' H1] - -protected theorem eq_mul_of_ediv_eq_right {a b c : Int} - (H1 : b ∣ a) (H2 : a / b = c) : a = b * c := by rw [← H2, Int.mul_ediv_cancel' H1] - -protected theorem div_eq_of_eq_mul_right {a b c : Int} - (H1 : b ≠ 0) (H2 : a = b * c) : a.div b = c := by rw [H2, Int.mul_div_cancel_left _ H1] - -protected theorem ediv_eq_of_eq_mul_right {a b c : Int} - (H1 : b ≠ 0) (H2 : a = b * c) : a / b = c := by rw [H2, Int.mul_ediv_cancel_left _ H1] - -protected theorem eq_div_of_mul_eq_right {a b c : Int} - (H1 : a ≠ 0) (H2 : a * b = c) : b = c.div a := - (Int.div_eq_of_eq_mul_right H1 H2.symm).symm - -protected theorem eq_ediv_of_mul_eq_right {a b c : Int} - (H1 : a ≠ 0) (H2 : a * b = c) : b = c / a := - (Int.ediv_eq_of_eq_mul_right H1 H2.symm).symm - -protected theorem div_eq_iff_eq_mul_right {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a.div b = c ↔ a = b * c := - ⟨Int.eq_mul_of_div_eq_right H', Int.div_eq_of_eq_mul_right H⟩ - -protected theorem ediv_eq_iff_eq_mul_right {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a / b = c ↔ a = b * c := - ⟨Int.eq_mul_of_ediv_eq_right H', Int.ediv_eq_of_eq_mul_right H⟩ - -protected theorem div_eq_iff_eq_mul_left {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a.div b = c ↔ a = c * b := by - rw [Int.mul_comm]; exact Int.div_eq_iff_eq_mul_right H H' - -protected theorem ediv_eq_iff_eq_mul_left {a b c : Int} - (H : b ≠ 0) (H' : b ∣ a) : a / b = c ↔ a = c * b := by - rw [Int.mul_comm]; exact Int.ediv_eq_iff_eq_mul_right H H' - -protected theorem eq_mul_of_div_eq_left {a b c : Int} - (H1 : b ∣ a) (H2 : a.div b = c) : a = c * b := by - rw [Int.mul_comm, Int.eq_mul_of_div_eq_right H1 H2] - -protected theorem eq_mul_of_ediv_eq_left {a b c : Int} - (H1 : b ∣ a) (H2 : a / b = c) : a = c * b := by - rw [Int.mul_comm, Int.eq_mul_of_ediv_eq_right H1 H2] - -protected theorem div_eq_of_eq_mul_left {a b c : Int} - (H1 : b ≠ 0) (H2 : a = c * b) : a.div b = c := - Int.div_eq_of_eq_mul_right H1 (by rw [Int.mul_comm, H2]) - -protected theorem ediv_eq_of_eq_mul_left {a b c : Int} - (H1 : b ≠ 0) (H2 : a = c * b) : a / b = c := - Int.ediv_eq_of_eq_mul_right H1 (by rw [Int.mul_comm, H2]) - -protected theorem eq_zero_of_div_eq_zero {d n : Int} (h : d ∣ n) (H : n.div d = 0) : n = 0 := by - rw [← Int.mul_div_cancel' h, H, Int.mul_zero] - -protected theorem eq_zero_of_ediv_eq_zero {d n : Int} (h : d ∣ n) (H : n / d = 0) : n = 0 := by - rw [← Int.mul_ediv_cancel' h, H, Int.mul_zero] - -theorem div_eq_ediv_of_dvd {a b : Int} (h : b ∣ a) : a.div b = a / b := by - if b0 : b = 0 then simp [b0] - else rw [Int.div_eq_iff_eq_mul_left b0 h, ← Int.ediv_eq_iff_eq_mul_left b0 h] - -theorem fdiv_eq_ediv_of_dvd : ∀ {a b : Int}, b ∣ a → a.fdiv b = a / b - | _, b, ⟨c, rfl⟩ => by if bz : b = 0 then simp [bz] else - rw [mul_fdiv_cancel_left _ bz, mul_ediv_cancel_left _ bz] - -theorem sub_ediv_of_dvd_sub {a b c : Int} - (hcab : c ∣ a - b) : (a - b) / c = a / c - b / c := by - rw [← Int.add_sub_cancel ((a-b) / c), ← Int.add_ediv_of_dvd_left hcab, Int.sub_add_cancel] - -@[simp] protected theorem div_left_inj {a b d : Int} - (hda : d ∣ a) (hdb : d ∣ b) : a.div d = b.div d ↔ a = b := by - refine ⟨fun h => ?_, congrArg (div · d)⟩ - rw [← Int.mul_div_cancel' hda, ← Int.mul_div_cancel' hdb, h] - -@[simp] protected theorem ediv_left_inj {a b d : Int} - (hda : d ∣ a) (hdb : d ∣ b) : a / d = b / d ↔ a = b := by - refine ⟨fun h => ?_, congrArg (ediv · d)⟩ - rw [← Int.mul_ediv_cancel' hda, ← Int.mul_ediv_cancel' hdb, h] - -theorem div_sign : ∀ a b, a.div (sign b) = a * sign b - | _, succ _ => by simp [sign, Int.mul_one] - | _, 0 => by simp [sign, Int.mul_zero] - | _, -[_+1] => by simp [sign, Int.mul_neg, Int.mul_one] - -theorem ediv_sign : ∀ a b, a / sign b = a * sign b - | _, succ _ => by simp [sign, Int.mul_one] - | _, 0 => by simp [sign, Int.mul_zero] - | _, -[_+1] => by simp [sign, Int.mul_neg, Int.mul_one] - -protected theorem sign_eq_div_abs (a : Int) : sign a = a.div (natAbs a) := - if az : a = 0 then by simp [az] else - (Int.div_eq_of_eq_mul_left (ofNat_ne_zero.2 <| natAbs_ne_zero.2 az) - (sign_mul_natAbs _).symm).symm - -theorem mul_sign : ∀ i : Int, i * sign i = natAbs i - | succ _ => Int.mul_one _ - | 0 => Int.mul_zero _ - | -[_+1] => Int.mul_neg_one _ - -theorem le_of_dvd {a b : Int} (bpos : 0 < b) (H : a ∣ b) : a ≤ b := - match a, b, eq_succ_of_zero_lt bpos, H with - | ofNat _, _, ⟨n, rfl⟩, H => ofNat_le.2 <| Nat.le_of_dvd n.succ_pos <| ofNat_dvd.1 H - | -[_+1], _, ⟨_, rfl⟩, _ => Int.le_trans (Int.le_of_lt <| negSucc_lt_zero _) (ofNat_zero_le _) - -theorem eq_one_of_dvd_one {a : Int} (H : 0 ≤ a) (H' : a ∣ 1) : a = 1 := - match a, eq_ofNat_of_zero_le H, H' with - | _, ⟨_, rfl⟩, H' => congrArg ofNat <| Nat.eq_one_of_dvd_one <| ofNat_dvd.1 H' - -theorem eq_one_of_mul_eq_one_right {a b : Int} (H : 0 ≤ a) (H' : a * b = 1) : a = 1 := - eq_one_of_dvd_one H ⟨b, H'.symm⟩ - -theorem eq_one_of_mul_eq_one_left {a b : Int} (H : 0 ≤ b) (H' : a * b = 1) : b = 1 := - eq_one_of_mul_eq_one_right H <| by rw [Int.mul_comm, H'] - -theorem le_of_mul_le_mul_left {a b c : Int} (w : a * b ≤ a * c) (h : 0 < a) : b ≤ c := by - have w := Int.sub_nonneg_of_le w - rw [← Int.mul_sub] at w - have w := Int.ediv_nonneg w (Int.le_of_lt h) - rw [Int.mul_ediv_cancel_left _ (Int.ne_of_gt h)] at w - exact Int.le_of_sub_nonneg w - -theorem le_of_mul_le_mul_right {a b c : Int} (w : b * a ≤ c * a) (h : 0 < a) : b ≤ c := by - rw [Int.mul_comm b, Int.mul_comm c] at w - exact le_of_mul_le_mul_left w h - -theorem lt_of_mul_lt_mul_left {a b c : Int} (w : a * b < a * c) (h : 0 ≤ a) : b < c := by - rcases Int.lt_trichotomy b c with lt | rfl | gt - · exact lt - · exact False.elim (Int.lt_irrefl _ w) - · rcases Int.lt_trichotomy a 0 with a_lt | rfl | a_gt - · exact False.elim (Int.lt_irrefl _ (Int.lt_of_lt_of_le a_lt h)) - · exact False.elim (Int.lt_irrefl b (by simp at w)) - · have := le_of_mul_le_mul_left (Int.le_of_lt w) a_gt - exact False.elim (Int.lt_irrefl _ (Int.lt_of_lt_of_le gt this)) - -theorem lt_of_mul_lt_mul_right {a b c : Int} (w : b * a < c * a) (h : 0 ≤ a) : b < c := by - rw [Int.mul_comm b, Int.mul_comm c] at w - exact lt_of_mul_lt_mul_left w h - -/-! -# `bmod` ("balanced" mod) - --/ - -theorem emod_bmod {x : Int} {m : Nat} : bmod (x % m) m = bmod x m := by - simp [bmod] - -@[simp] theorem bmod_bmod : bmod (bmod x m) m = bmod x m := by - rw [bmod, bmod_emod] - rfl - -@[simp] theorem bmod_zero : Int.bmod 0 m = 0 := by - dsimp [bmod] - simp only [zero_emod, Int.zero_sub, ite_eq_left_iff, Int.neg_eq_zero] - intro h - rw [@Int.not_lt] at h - match m with - | 0 => rfl - | (m+1) => - exfalso - rw [natCast_add, ofNat_one, Int.add_assoc, add_ediv_of_dvd_right] at h - change _ + 2 / 2 ≤ 0 at h - rw [Int.ediv_self, ← ofNat_two, ← ofNat_ediv, add_one_le_iff, ← @Int.not_le] at h - exact h (ofNat_nonneg _) - all_goals decide - -theorem dvd_bmod_sub_self {x : Int} {m : Nat} : (m : Int) ∣ bmod x m - x := by - dsimp [bmod] - split - · exact dvd_emod_sub_self - · rw [Int.sub_sub, Int.add_comm, ← Int.sub_sub] - exact Int.dvd_sub dvd_emod_sub_self (Int.dvd_refl _) - -theorem le_bmod {x : Int} {m : Nat} (h : 0 < m) : - (m/2) ≤ Int.bmod x m := by - dsimp [bmod] - have v : (m : Int) % 2 = 0 ∨ (m : Int) % 2 = 1 := emod_two_eq _ - split <;> rename_i w - · refine Int.le_trans ?_ (Int.emod_nonneg _ ?_) - · exact Int.neg_nonpos_of_nonneg (Int.ediv_nonneg (Int.ofNat_nonneg _) (by decide)) - · exact Int.ne_of_gt (ofNat_pos.mpr h) - · simp [Int.not_lt] at w - refine Int.le_trans ?_ (Int.sub_le_sub_right w _) - rw [← ediv_add_emod m 2] - generalize (m : Int) / 2 = q - generalize h : (m : Int) % 2 = r at * - rcases v with rfl | rfl - · rw [Int.add_zero, Int.mul_ediv_cancel_left, Int.add_ediv_of_dvd_left, - Int.mul_ediv_cancel_left, show (1 / 2 : Int) = 0 by decide, Int.add_zero, - Int.neg_eq_neg_one_mul] - conv => rhs; congr; rw [← Int.one_mul q] - rw [← Int.sub_mul, show (1 - 2 : Int) = -1 by decide] - apply Int.le_refl - all_goals try decide - all_goals apply Int.dvd_mul_right - · rw [Int.add_ediv_of_dvd_left, Int.mul_ediv_cancel_left, - show (1 / 2 : Int) = 0 by decide, Int.add_assoc, Int.add_ediv_of_dvd_left, - Int.mul_ediv_cancel_left, show ((1 + 1) / 2 : Int) = 1 by decide, ← Int.sub_sub, - Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_right_comm, Int.add_assoc q, - show (1 + -1 : Int) = 0 by decide, Int.add_zero, ← Int.neg_mul] - rw [Int.neg_eq_neg_one_mul] - conv => rhs; congr; rw [← Int.one_mul q] - rw [← Int.add_mul, show (1 + -2 : Int) = -1 by decide] - apply Int.le_refl - all_goals try decide - all_goals try apply Int.dvd_mul_right - -theorem bmod_lt {x : Int} {m : Nat} (h : 0 < m) : bmod x m < (m + 1) / 2 := by - dsimp [bmod] - split - · assumption - · apply Int.lt_of_lt_of_le - · show _ < 0 - have : x % m < m := emod_lt_of_pos x (ofNat_pos.mpr h) - exact Int.sub_neg_of_lt this - · exact Int.le.intro_sub _ rfl - -theorem bmod_le {x : Int} {m : Nat} (h : 0 < m) : bmod x m ≤ (m - 1) / 2 := by - refine lt_add_one_iff.mp ?_ - calc - bmod x m < (m + 1) / 2 := bmod_lt h - _ = ((m + 1 - 2) + 2)/2 := by simp - _ = (m - 1) / 2 + 1 := by - rw [add_ediv_of_dvd_right] - · simp (config := {decide := true}) only [Int.ediv_self] - congr 2 - rw [Int.add_sub_assoc, ← Int.sub_neg] - congr - · trivial - --- This could be strengthed by changing to `w : x ≠ -1` if needed. -theorem bmod_natAbs_plus_one (x : Int) (w : 1 < x.natAbs) : bmod x (x.natAbs + 1) = - x.sign := by - have t₁ : ∀ (x : Nat), x % (x + 2) = x := - fun x => Nat.mod_eq_of_lt (Nat.lt_succ_of_lt (Nat.lt.base x)) - have t₂ : ∀ (x : Int), 0 ≤ x → x % (x + 2) = x := fun x h => by - match x, h with - | Int.ofNat x, _ => erw [← Int.ofNat_two, ← ofNat_add, ← ofNat_emod, t₁]; rfl - cases x with - | ofNat x => - simp only [bmod, ofNat_eq_coe, natAbs_ofNat, natCast_add, ofNat_one, - emod_self_add_one (ofNat_nonneg x)] - match x with - | 0 => rw [if_pos] <;> simp (config := {decide := true}) - | (x+1) => - rw [if_neg] - · simp [← Int.sub_sub] - · refine Int.not_lt.mpr ?_ - simp only [← natCast_add, ← ofNat_one, ← ofNat_two, ← ofNat_ediv] - match x with - | 0 => apply Int.le_refl - | (x+1) => - refine Int.ofNat_le.mpr ?_ - apply Nat.div_le_of_le_mul - simp only [Nat.two_mul, Nat.add_assoc] - apply Nat.add_le_add_left (Nat.add_le_add_left (Nat.add_le_add_left (Nat.le_add_left - _ _) _) _) - | negSucc x => - rw [bmod, natAbs_negSucc, natCast_add, ofNat_one, sign_negSucc, Int.neg_neg, - Nat.succ_eq_add_one, negSucc_emod] - erw [t₂] - · rw [natCast_add, ofNat_one, Int.add_sub_cancel, Int.add_comm, Int.add_sub_cancel, if_pos] - · match x, w with - | (x+1), _ => - rw [Int.add_assoc, add_ediv_of_dvd_right, show (1 + 1 : Int) = 2 by decide, Int.ediv_self] - apply Int.lt_add_one_of_le - rw [Int.add_comm, ofNat_add, Int.add_assoc, add_ediv_of_dvd_right, - show ((1 : Nat) + 1 : Int) = 2 by decide, Int.ediv_self] - apply Int.le_add_of_nonneg_left - exact Int.le.intro_sub _ rfl - all_goals decide - · exact ofNat_nonneg x - · exact succ_ofNat_pos (x + 1) - -/-! ### `/` and ordering -/ - -protected theorem ediv_mul_le (a : Int) {b : Int} (H : b ≠ 0) : a / b * b ≤ a := - Int.le_of_sub_nonneg <| by rw [Int.mul_comm, ← emod_def]; apply emod_nonneg _ H - -protected theorem ediv_le_of_le_mul {a b c : Int} (H : 0 < c) (H' : a ≤ b * c) : a / c ≤ b := - le_of_mul_le_mul_right (Int.le_trans (Int.ediv_mul_le _ (Int.ne_of_gt H)) H') H - -protected theorem mul_lt_of_lt_ediv {a b c : Int} (H : 0 < c) (H3 : a < b / c) : a * c < b := - Int.lt_of_not_ge <| mt (Int.ediv_le_of_le_mul H) (Int.not_le_of_gt H3) - -protected theorem mul_le_of_le_ediv {a b c : Int} (H1 : 0 < c) (H2 : a ≤ b / c) : a * c ≤ b := - Int.le_trans (Int.mul_le_mul_of_nonneg_right H2 (Int.le_of_lt H1)) - (Int.ediv_mul_le _ (Int.ne_of_gt H1)) - -protected theorem le_ediv_of_mul_le {a b c : Int} (H1 : 0 < c) (H2 : a * c ≤ b) : a ≤ b / c := - le_of_lt_add_one <| - lt_of_mul_lt_mul_right (Int.lt_of_le_of_lt H2 (lt_ediv_add_one_mul_self _ H1)) (Int.le_of_lt H1) - -protected theorem le_ediv_iff_mul_le {a b c : Int} (H : 0 < c) : a ≤ b / c ↔ a * c ≤ b := - ⟨Int.mul_le_of_le_ediv H, Int.le_ediv_of_mul_le H⟩ - -protected theorem ediv_le_ediv {a b c : Int} (H : 0 < c) (H' : a ≤ b) : a / c ≤ b / c := - Int.le_ediv_of_mul_le H (Int.le_trans (Int.ediv_mul_le _ (Int.ne_of_gt H)) H') - -protected theorem ediv_lt_of_lt_mul {a b c : Int} (H : 0 < c) (H' : a < b * c) : a / c < b := - Int.lt_of_not_ge <| mt (Int.mul_le_of_le_ediv H) (Int.not_le_of_gt H') - -protected theorem lt_mul_of_ediv_lt {a b c : Int} (H1 : 0 < c) (H2 : a / c < b) : a < b * c := - Int.lt_of_not_ge <| mt (Int.le_ediv_of_mul_le H1) (Int.not_le_of_gt H2) - -protected theorem ediv_lt_iff_lt_mul {a b c : Int} (H : 0 < c) : a / c < b ↔ a < b * c := - ⟨Int.lt_mul_of_ediv_lt H, Int.ediv_lt_of_lt_mul H⟩ - -protected theorem le_mul_of_ediv_le {a b c : Int} (H1 : 0 ≤ b) (H2 : b ∣ a) (H3 : a / b ≤ c) : - a ≤ c * b := by - rw [← Int.ediv_mul_cancel H2]; exact Int.mul_le_mul_of_nonneg_right H3 H1 - -protected theorem lt_ediv_of_mul_lt {a b c : Int} (H1 : 0 ≤ b) (H2 : b ∣ c) (H3 : a * b < c) : - a < c / b := - Int.lt_of_not_ge <| mt (Int.le_mul_of_ediv_le H1 H2) (Int.not_le_of_gt H3) - -protected theorem lt_ediv_iff_mul_lt {a b : Int} (c : Int) (H : 0 < c) (H' : c ∣ b) : - a < b / c ↔ a * c < b := - ⟨Int.mul_lt_of_lt_ediv H, Int.lt_ediv_of_mul_lt (Int.le_of_lt H) H'⟩ - -theorem ediv_pos_of_pos_of_dvd {a b : Int} (H1 : 0 < a) (H2 : 0 ≤ b) (H3 : b ∣ a) : 0 < a / b := - Int.lt_ediv_of_mul_lt H2 H3 (by rwa [Int.zero_mul]) - -theorem ediv_eq_ediv_of_mul_eq_mul {a b c d : Int} - (H2 : d ∣ c) (H3 : b ≠ 0) (H4 : d ≠ 0) (H5 : a * d = b * c) : a / b = c / d := - Int.ediv_eq_of_eq_mul_right H3 <| by - rw [← Int.mul_ediv_assoc _ H2]; exact (Int.ediv_eq_of_eq_mul_left H4 H5.symm).symm - /-! ### The following lemmas have been commented out here for a while, and need restoration. -/ diff --git a/Std/Data/Int/Lemmas.lean b/Std/Data/Int/Lemmas.lean index a449fdb06f..a4c91a0005 100644 --- a/Std/Data/Int/Lemmas.lean +++ b/Std/Data/Int/Lemmas.lean @@ -1,6 +1,5 @@ -- This is a backwards compatibility shim, after `Std.Data.Int.Lemmas` was split into smaller files. -- Hopefully it can later be removed. -import Std.Data.Int.Gcd import Std.Data.Int.Order import Std.Data.Int.DivMod diff --git a/Std/Data/Int/Order.lean b/Std/Data/Int/Order.lean index 2763b0bb7c..6aef66829d 100644 --- a/Std/Data/Int/Order.lean +++ b/Std/Data/Int/Order.lean @@ -5,526 +5,6 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro -/ import Std.Tactic.Alias -/-! -# Results about the order properties of the integers, and the integers as an ordered ring. --/ - -open Nat - namespace Int -/-! ## Order properties of the integers -/ - -protected theorem lt_of_not_ge {a b : Int} : ¬a ≤ b → b < a := Int.not_le.mp -protected theorem not_le_of_gt {a b : Int} : b < a → ¬a ≤ b := Int.not_le.mpr - -protected theorem le_of_not_le {a b : Int} : ¬ a ≤ b → b ≤ a := (Int.le_total a b).resolve_left - -@[simp] theorem negSucc_not_pos (n : Nat) : 0 < -[n+1] ↔ False := by - simp only [Int.not_lt, iff_false]; constructor - -theorem eq_negSucc_of_lt_zero : ∀ {a : Int}, a < 0 → ∃ n : Nat, a = -[n+1] - | ofNat _, h => absurd h (Int.not_lt.2 (ofNat_zero_le _)) - | -[n+1], _ => ⟨n, rfl⟩ - -protected theorem lt_of_add_lt_add_left {a b c : Int} (h : a + b < a + c) : b < c := by - have : -a + (a + b) < -a + (a + c) := Int.add_lt_add_left h _ - simp [Int.neg_add_cancel_left] at this - assumption - -protected theorem lt_of_add_lt_add_right {a b c : Int} (h : a + b < c + b) : a < c := - Int.lt_of_add_lt_add_left (a := b) <| by rwa [Int.add_comm b a, Int.add_comm b c] - -protected theorem add_lt_add_iff_left (a : Int) : a + b < a + c ↔ b < c := - ⟨Int.lt_of_add_lt_add_left, (Int.add_lt_add_left · _)⟩ - -protected theorem add_lt_add_iff_right (c : Int) : a + c < b + c ↔ a < b := - ⟨Int.lt_of_add_lt_add_right, (Int.add_lt_add_right · _)⟩ - -protected theorem add_lt_add {a b c d : Int} (h₁ : a < b) (h₂ : c < d) : a + c < b + d := - Int.lt_trans (Int.add_lt_add_right h₁ c) (Int.add_lt_add_left h₂ b) - -protected theorem add_lt_add_of_le_of_lt {a b c d : Int} (h₁ : a ≤ b) (h₂ : c < d) : - a + c < b + d := - Int.lt_of_le_of_lt (Int.add_le_add_right h₁ c) (Int.add_lt_add_left h₂ b) - -protected theorem add_lt_add_of_lt_of_le {a b c d : Int} (h₁ : a < b) (h₂ : c ≤ d) : - a + c < b + d := - Int.lt_of_lt_of_le (Int.add_lt_add_right h₁ c) (Int.add_le_add_left h₂ b) - -protected theorem lt_add_of_pos_right (a : Int) {b : Int} (h : 0 < b) : a < a + b := by - have : a + 0 < a + b := Int.add_lt_add_left h a - rwa [Int.add_zero] at this - -protected theorem lt_add_of_pos_left (a : Int) {b : Int} (h : 0 < b) : a < b + a := by - have : 0 + a < b + a := Int.add_lt_add_right h a - rwa [Int.zero_add] at this - -protected theorem add_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b := - Int.zero_add 0 ▸ Int.add_le_add ha hb - -protected theorem add_pos {a b : Int} (ha : 0 < a) (hb : 0 < b) : 0 < a + b := - Int.zero_add 0 ▸ Int.add_lt_add ha hb - -protected theorem add_pos_of_pos_of_nonneg {a b : Int} (ha : 0 < a) (hb : 0 ≤ b) : 0 < a + b := - Int.zero_add 0 ▸ Int.add_lt_add_of_lt_of_le ha hb - -protected theorem add_pos_of_nonneg_of_pos {a b : Int} (ha : 0 ≤ a) (hb : 0 < b) : 0 < a + b := - Int.zero_add 0 ▸ Int.add_lt_add_of_le_of_lt ha hb - -protected theorem add_nonpos {a b : Int} (ha : a ≤ 0) (hb : b ≤ 0) : a + b ≤ 0 := - Int.zero_add 0 ▸ Int.add_le_add ha hb - -protected theorem add_neg {a b : Int} (ha : a < 0) (hb : b < 0) : a + b < 0 := - Int.zero_add 0 ▸ Int.add_lt_add ha hb - -protected theorem add_neg_of_neg_of_nonpos {a b : Int} (ha : a < 0) (hb : b ≤ 0) : a + b < 0 := - Int.zero_add 0 ▸ Int.add_lt_add_of_lt_of_le ha hb - -protected theorem add_neg_of_nonpos_of_neg {a b : Int} (ha : a ≤ 0) (hb : b < 0) : a + b < 0 := - Int.zero_add 0 ▸ Int.add_lt_add_of_le_of_lt ha hb - -protected theorem lt_add_of_le_of_pos {a b c : Int} (hbc : b ≤ c) (ha : 0 < a) : b < c + a := - Int.add_zero b ▸ Int.add_lt_add_of_le_of_lt hbc ha - -theorem add_one_le_iff {a b : Int} : a + 1 ≤ b ↔ a < b := .rfl - -theorem lt_add_one_iff {a b : Int} : a < b + 1 ↔ a ≤ b := Int.add_le_add_iff_right _ - -@[simp] theorem succ_ofNat_pos (n : Nat) : 0 < (n : Int) + 1 := - lt_add_one_iff.2 (ofNat_zero_le _) - -theorem le_add_one {a b : Int} (h : a ≤ b) : a ≤ b + 1 := - Int.le_of_lt (Int.lt_add_one_iff.2 h) - -protected theorem nonneg_of_neg_nonpos {a : Int} (h : -a ≤ 0) : 0 ≤ a := - Int.le_of_neg_le_neg <| by rwa [Int.neg_zero] - -protected theorem nonpos_of_neg_nonneg {a : Int} (h : 0 ≤ -a) : a ≤ 0 := - Int.le_of_neg_le_neg <| by rwa [Int.neg_zero] - -protected theorem lt_of_neg_lt_neg {a b : Int} (h : -b < -a) : a < b := - Int.neg_neg a ▸ Int.neg_neg b ▸ Int.neg_lt_neg h - -protected theorem pos_of_neg_neg {a : Int} (h : -a < 0) : 0 < a := - Int.lt_of_neg_lt_neg <| by rwa [Int.neg_zero] - -protected theorem neg_of_neg_pos {a : Int} (h : 0 < -a) : a < 0 := - have : -0 < -a := by rwa [Int.neg_zero] - Int.lt_of_neg_lt_neg this - -protected theorem le_neg_of_le_neg {a b : Int} (h : a ≤ -b) : b ≤ -a := by - have h := Int.neg_le_neg h - rwa [Int.neg_neg] at h - -protected theorem neg_le_of_neg_le {a b : Int} (h : -a ≤ b) : -b ≤ a := by - have h := Int.neg_le_neg h - rwa [Int.neg_neg] at h - -protected theorem lt_neg_of_lt_neg {a b : Int} (h : a < -b) : b < -a := by - have h := Int.neg_lt_neg h - rwa [Int.neg_neg] at h - -protected theorem neg_lt_of_neg_lt {a b : Int} (h : -a < b) : -b < a := by - have h := Int.neg_lt_neg h - rwa [Int.neg_neg] at h - -protected theorem sub_nonpos_of_le {a b : Int} (h : a ≤ b) : a - b ≤ 0 := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem le_of_sub_nonpos {a b : Int} (h : a - b ≤ 0) : a ≤ b := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem sub_neg_of_lt {a b : Int} (h : a < b) : a - b < 0 := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_right_neg] at h - -protected theorem lt_of_sub_neg {a b : Int} (h : a - b < 0) : a < b := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel, Int.zero_add] at h - -protected theorem add_le_of_le_neg_add {a b c : Int} (h : b ≤ -a + c) : a + b ≤ c := by - have h := Int.add_le_add_left h a - rwa [Int.add_neg_cancel_left] at h - -protected theorem le_neg_add_of_add_le {a b c : Int} (h : a + b ≤ c) : b ≤ -a + c := by - have h := Int.add_le_add_left h (-a) - rwa [Int.neg_add_cancel_left] at h - -protected theorem add_le_of_le_sub_left {a b c : Int} (h : b ≤ c - a) : a + b ≤ c := by - have h := Int.add_le_add_left h a - rwa [← Int.add_sub_assoc, Int.add_comm a c, Int.add_sub_cancel] at h - -protected theorem le_sub_left_of_add_le {a b c : Int} (h : a + b ≤ c) : b ≤ c - a := by - have h := Int.add_le_add_right h (-a) - rwa [Int.add_comm a b, Int.add_neg_cancel_right] at h - -protected theorem add_le_of_le_sub_right {a b c : Int} (h : a ≤ c - b) : a + b ≤ c := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel] at h - -protected theorem le_sub_right_of_add_le {a b c : Int} (h : a + b ≤ c) : a ≤ c - b := by - have h := Int.add_le_add_right h (-b) - rwa [Int.add_neg_cancel_right] at h - -protected theorem le_add_of_neg_add_le {a b c : Int} (h : -b + a ≤ c) : a ≤ b + c := by - have h := Int.add_le_add_left h b - rwa [Int.add_neg_cancel_left] at h - -protected theorem neg_add_le_of_le_add {a b c : Int} (h : a ≤ b + c) : -b + a ≤ c := by - have h := Int.add_le_add_left h (-b) - rwa [Int.neg_add_cancel_left] at h - -protected theorem le_add_of_sub_left_le {a b c : Int} (h : a - b ≤ c) : a ≤ b + c := by - have h := Int.add_le_add_right h b - rwa [Int.sub_add_cancel, Int.add_comm] at h - -protected theorem le_add_of_sub_right_le {a b c : Int} (h : a - c ≤ b) : a ≤ b + c := by - have h := Int.add_le_add_right h c - rwa [Int.sub_add_cancel] at h - -protected theorem sub_right_le_of_le_add {a b c : Int} (h : a ≤ b + c) : a - c ≤ b := by - have h := Int.add_le_add_right h (-c) - rwa [Int.add_neg_cancel_right] at h - -protected theorem le_add_of_neg_add_le_left {a b c : Int} (h : -b + a ≤ c) : a ≤ b + c := by - rw [Int.add_comm] at h - exact Int.le_add_of_sub_left_le h - -protected theorem neg_add_le_left_of_le_add {a b c : Int} (h : a ≤ b + c) : -b + a ≤ c := by - rw [Int.add_comm] - exact Int.sub_left_le_of_le_add h - -protected theorem le_add_of_neg_add_le_right {a b c : Int} (h : -c + a ≤ b) : a ≤ b + c := by - rw [Int.add_comm] at h - exact Int.le_add_of_sub_right_le h - -protected theorem neg_add_le_right_of_le_add {a b c : Int} (h : a ≤ b + c) : -c + a ≤ b := by - rw [Int.add_comm] at h - exact Int.neg_add_le_left_of_le_add h - -protected theorem le_add_of_neg_le_sub_left {a b c : Int} (h : -a ≤ b - c) : c ≤ a + b := - Int.le_add_of_neg_add_le_left (Int.add_le_of_le_sub_right h) - -protected theorem neg_le_sub_left_of_le_add {a b c : Int} (h : c ≤ a + b) : -a ≤ b - c := by - have h := Int.le_neg_add_of_add_le (Int.sub_left_le_of_le_add h) - rwa [Int.add_comm] at h - -protected theorem le_add_of_neg_le_sub_right {a b c : Int} (h : -b ≤ a - c) : c ≤ a + b := - Int.le_add_of_sub_right_le (Int.add_le_of_le_sub_left h) - -protected theorem neg_le_sub_right_of_le_add {a b c : Int} (h : c ≤ a + b) : -b ≤ a - c := - Int.le_sub_left_of_add_le (Int.sub_right_le_of_le_add h) - -protected theorem sub_le_of_sub_le {a b c : Int} (h : a - b ≤ c) : a - c ≤ b := - Int.sub_left_le_of_le_add (Int.le_add_of_sub_right_le h) - -protected theorem sub_le_sub_left {a b : Int} (h : a ≤ b) (c : Int) : c - b ≤ c - a := - Int.add_le_add_left (Int.neg_le_neg h) c - -protected theorem sub_le_sub_right {a b : Int} (h : a ≤ b) (c : Int) : a - c ≤ b - c := - Int.add_le_add_right h (-c) - -protected theorem sub_le_sub {a b c d : Int} (hab : a ≤ b) (hcd : c ≤ d) : a - d ≤ b - c := - Int.add_le_add hab (Int.neg_le_neg hcd) - -protected theorem add_lt_of_lt_neg_add {a b c : Int} (h : b < -a + c) : a + b < c := by - have h := Int.add_lt_add_left h a - rwa [Int.add_neg_cancel_left] at h - -protected theorem lt_neg_add_of_add_lt {a b c : Int} (h : a + b < c) : b < -a + c := by - have h := Int.add_lt_add_left h (-a) - rwa [Int.neg_add_cancel_left] at h - -protected theorem add_lt_of_lt_sub_left {a b c : Int} (h : b < c - a) : a + b < c := by - have h := Int.add_lt_add_left h a - rwa [← Int.add_sub_assoc, Int.add_comm a c, Int.add_sub_cancel] at h - -protected theorem lt_sub_left_of_add_lt {a b c : Int} (h : a + b < c) : b < c - a := by - have h := Int.add_lt_add_right h (-a) - rwa [Int.add_comm a b, Int.add_neg_cancel_right] at h - -protected theorem add_lt_of_lt_sub_right {a b c : Int} (h : a < c - b) : a + b < c := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel] at h - -protected theorem lt_sub_right_of_add_lt {a b c : Int} (h : a + b < c) : a < c - b := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_neg_cancel_right] at h - -protected theorem lt_add_of_neg_add_lt {a b c : Int} (h : -b + a < c) : a < b + c := by - have h := Int.add_lt_add_left h b - rwa [Int.add_neg_cancel_left] at h - -protected theorem neg_add_lt_of_lt_add {a b c : Int} (h : a < b + c) : -b + a < c := by - have h := Int.add_lt_add_left h (-b) - rwa [Int.neg_add_cancel_left] at h - -protected theorem lt_add_of_sub_left_lt {a b c : Int} (h : a - b < c) : a < b + c := by - have h := Int.add_lt_add_right h b - rwa [Int.sub_add_cancel, Int.add_comm] at h - -protected theorem sub_left_lt_of_lt_add {a b c : Int} (h : a < b + c) : a - b < c := by - have h := Int.add_lt_add_right h (-b) - rwa [Int.add_comm b c, Int.add_neg_cancel_right] at h - -protected theorem lt_add_of_sub_right_lt {a b c : Int} (h : a - c < b) : a < b + c := by - have h := Int.add_lt_add_right h c - rwa [Int.sub_add_cancel] at h - -protected theorem sub_right_lt_of_lt_add {a b c : Int} (h : a < b + c) : a - c < b := by - have h := Int.add_lt_add_right h (-c) - rwa [Int.add_neg_cancel_right] at h - -protected theorem lt_add_of_neg_add_lt_left {a b c : Int} (h : -b + a < c) : a < b + c := by - rw [Int.add_comm] at h - exact Int.lt_add_of_sub_left_lt h - -protected theorem neg_add_lt_left_of_lt_add {a b c : Int} (h : a < b + c) : -b + a < c := by - rw [Int.add_comm] - exact Int.sub_left_lt_of_lt_add h - -protected theorem lt_add_of_neg_add_lt_right {a b c : Int} (h : -c + a < b) : a < b + c := by - rw [Int.add_comm] at h - exact Int.lt_add_of_sub_right_lt h - -protected theorem neg_add_lt_right_of_lt_add {a b c : Int} (h : a < b + c) : -c + a < b := by - rw [Int.add_comm] at h - exact Int.neg_add_lt_left_of_lt_add h - -protected theorem lt_add_of_neg_lt_sub_left {a b c : Int} (h : -a < b - c) : c < a + b := - Int.lt_add_of_neg_add_lt_left (Int.add_lt_of_lt_sub_right h) - -protected theorem neg_lt_sub_left_of_lt_add {a b c : Int} (h : c < a + b) : -a < b - c := by - have h := Int.lt_neg_add_of_add_lt (Int.sub_left_lt_of_lt_add h) - rwa [Int.add_comm] at h - -protected theorem lt_add_of_neg_lt_sub_right {a b c : Int} (h : -b < a - c) : c < a + b := - Int.lt_add_of_sub_right_lt (Int.add_lt_of_lt_sub_left h) - -protected theorem neg_lt_sub_right_of_lt_add {a b c : Int} (h : c < a + b) : -b < a - c := - Int.lt_sub_left_of_add_lt (Int.sub_right_lt_of_lt_add h) - -protected theorem sub_lt_of_sub_lt {a b c : Int} (h : a - b < c) : a - c < b := - Int.sub_left_lt_of_lt_add (Int.lt_add_of_sub_right_lt h) - -protected theorem sub_lt_sub_left {a b : Int} (h : a < b) (c : Int) : c - b < c - a := - Int.add_lt_add_left (Int.neg_lt_neg h) c - -protected theorem sub_lt_sub_right {a b : Int} (h : a < b) (c : Int) : a - c < b - c := - Int.add_lt_add_right h (-c) - -protected theorem sub_lt_sub {a b c d : Int} (hab : a < b) (hcd : c < d) : a - d < b - c := - Int.add_lt_add hab (Int.neg_lt_neg hcd) - -protected theorem sub_lt_sub_of_le_of_lt {a b c d : Int} - (hab : a ≤ b) (hcd : c < d) : a - d < b - c := - Int.add_lt_add_of_le_of_lt hab (Int.neg_lt_neg hcd) - -protected theorem sub_lt_sub_of_lt_of_le {a b c d : Int} - (hab : a < b) (hcd : c ≤ d) : a - d < b - c := - Int.add_lt_add_of_lt_of_le hab (Int.neg_le_neg hcd) - -protected theorem add_le_add_three {a b c d e f : Int} - (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) : a + b + c ≤ d + e + f := - Int.add_le_add (Int.add_le_add h₁ h₂) h₃ - -theorem exists_eq_neg_ofNat {a : Int} (H : a ≤ 0) : ∃ n : Nat, a = -(n : Int) := - let ⟨n, h⟩ := eq_ofNat_of_zero_le (Int.neg_nonneg_of_nonpos H) - ⟨n, Int.eq_neg_of_eq_neg h.symm⟩ - -theorem lt_of_add_one_le {a b : Int} (H : a + 1 ≤ b) : a < b := H - -theorem lt_add_one_of_le {a b : Int} (H : a ≤ b) : a < b + 1 := Int.add_le_add_right H 1 - -theorem le_of_lt_add_one {a b : Int} (H : a < b + 1) : a ≤ b := Int.le_of_add_le_add_right H - -theorem sub_one_lt_of_le {a b : Int} (H : a ≤ b) : a - 1 < b := - Int.sub_right_lt_of_lt_add <| lt_add_one_of_le H - -theorem le_of_sub_one_lt {a b : Int} (H : a - 1 < b) : a ≤ b := - le_of_lt_add_one <| Int.lt_add_of_sub_right_lt H - -theorem le_sub_one_of_lt {a b : Int} (H : a < b) : a ≤ b - 1 := Int.le_sub_right_of_add_le H - -theorem lt_of_le_sub_one {a b : Int} (H : a ≤ b - 1) : a < b := Int.add_le_of_le_sub_right H - -/- ### Order properties and multiplication -/ - -protected theorem mul_lt_mul {a b c d : Int} - (h₁ : a < c) (h₂ : b ≤ d) (h₃ : 0 < b) (h₄ : 0 ≤ c) : a * b < c * d := - Int.lt_of_lt_of_le (Int.mul_lt_mul_of_pos_right h₁ h₃) (Int.mul_le_mul_of_nonneg_left h₂ h₄) - -protected theorem mul_lt_mul' {a b c d : Int} - (h₁ : a ≤ c) (h₂ : b < d) (h₃ : 0 ≤ b) (h₄ : 0 < c) : a * b < c * d := - Int.lt_of_le_of_lt (Int.mul_le_mul_of_nonneg_right h₁ h₃) (Int.mul_lt_mul_of_pos_left h₂ h₄) - -protected theorem mul_neg_of_pos_of_neg {a b : Int} (ha : 0 < a) (hb : b < 0) : a * b < 0 := by - have h : a * b < a * 0 := Int.mul_lt_mul_of_pos_left hb ha - rwa [Int.mul_zero] at h - -protected theorem mul_neg_of_neg_of_pos {a b : Int} (ha : a < 0) (hb : 0 < b) : a * b < 0 := by - have h : a * b < 0 * b := Int.mul_lt_mul_of_pos_right ha hb - rwa [Int.zero_mul] at h - -protected theorem mul_nonneg_of_nonpos_of_nonpos {a b : Int} - (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b := by - have : 0 * b ≤ a * b := Int.mul_le_mul_of_nonpos_right ha hb - rwa [Int.zero_mul] at this - -protected theorem mul_lt_mul_of_neg_left {a b c : Int} (h : b < a) (hc : c < 0) : c * a < c * b := - have : -c > 0 := Int.neg_pos_of_neg hc - have : -c * b < -c * a := Int.mul_lt_mul_of_pos_left h this - have : -(c * b) < -(c * a) := by - rwa [← Int.neg_mul_eq_neg_mul, ← Int.neg_mul_eq_neg_mul] at this - Int.lt_of_neg_lt_neg this - -protected theorem mul_lt_mul_of_neg_right {a b c : Int} (h : b < a) (hc : c < 0) : a * c < b * c := - have : -c > 0 := Int.neg_pos_of_neg hc - have : b * -c < a * -c := Int.mul_lt_mul_of_pos_right h this - have : -(b * c) < -(a * c) := by - rwa [← Int.neg_mul_eq_mul_neg, ← Int.neg_mul_eq_mul_neg] at this - Int.lt_of_neg_lt_neg this - -protected theorem mul_pos_of_neg_of_neg {a b : Int} (ha : a < 0) (hb : b < 0) : 0 < a * b := by - have : 0 * b < a * b := Int.mul_lt_mul_of_neg_right ha hb - rwa [Int.zero_mul] at this - -protected theorem mul_self_le_mul_self {a b : Int} (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b := - Int.mul_le_mul h2 h2 h1 (Int.le_trans h1 h2) - -protected theorem mul_self_lt_mul_self {a b : Int} (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b := - Int.mul_lt_mul' (Int.le_of_lt h2) h2 h1 (Int.lt_of_le_of_lt h1 h2) - -/- ## sign -/ - -@[simp] theorem sign_zero : sign 0 = 0 := rfl -@[simp] theorem sign_one : sign 1 = 1 := rfl -theorem sign_neg_one : sign (-1) = -1 := rfl - -@[simp] theorem sign_of_add_one (x : Nat) : Int.sign (x + 1) = 1 := rfl -@[simp] theorem sign_negSucc (x : Nat) : Int.sign (Int.negSucc x) = -1 := rfl - -theorem natAbs_sign (z : Int) : z.sign.natAbs = if z = 0 then 0 else 1 := - match z with | 0 | succ _ | -[_+1] => rfl - -theorem natAbs_sign_of_nonzero {z : Int} (hz : z ≠ 0) : z.sign.natAbs = 1 := by - rw [Int.natAbs_sign, if_neg hz] - -theorem sign_ofNat_of_nonzero {n : Nat} (hn : n ≠ 0) : Int.sign n = 1 := - match n, Nat.exists_eq_succ_of_ne_zero hn with - | _, ⟨n, rfl⟩ => Int.sign_of_add_one n - -@[simp] theorem sign_neg (z : Int) : Int.sign (-z) = -Int.sign z := by - match z with | 0 | succ _ | -[_+1] => rfl - -theorem sign_mul_natAbs : ∀ a : Int, sign a * natAbs a = a - | 0 => rfl - | succ _ => Int.one_mul _ - | -[_+1] => (Int.neg_eq_neg_one_mul _).symm - -@[simp] theorem sign_mul : ∀ a b, sign (a * b) = sign a * sign b - | a, 0 | 0, b => by simp [Int.mul_zero, Int.zero_mul] - | succ _, succ _ | succ _, -[_+1] | -[_+1], succ _ | -[_+1], -[_+1] => rfl - -theorem sign_eq_one_of_pos {a : Int} (h : 0 < a) : sign a = 1 := - match a, eq_succ_of_zero_lt h with - | _, ⟨_, rfl⟩ => rfl - -theorem sign_eq_neg_one_of_neg {a : Int} (h : a < 0) : sign a = -1 := - match a, eq_negSucc_of_lt_zero h with - | _, ⟨_, rfl⟩ => rfl - -theorem eq_zero_of_sign_eq_zero : ∀ {a : Int}, sign a = 0 → a = 0 - | 0, _ => rfl - -theorem pos_of_sign_eq_one : ∀ {a : Int}, sign a = 1 → 0 < a - | (_ + 1 : Nat), _ => ofNat_lt.2 (Nat.succ_pos _) - -theorem neg_of_sign_eq_neg_one : ∀ {a : Int}, sign a = -1 → a < 0 - | (_ + 1 : Nat), h => nomatch h - | 0, h => nomatch h - | -[_+1], _ => negSucc_lt_zero _ - -theorem sign_eq_one_iff_pos (a : Int) : sign a = 1 ↔ 0 < a := - ⟨pos_of_sign_eq_one, sign_eq_one_of_pos⟩ - -theorem sign_eq_neg_one_iff_neg (a : Int) : sign a = -1 ↔ a < 0 := - ⟨neg_of_sign_eq_neg_one, sign_eq_neg_one_of_neg⟩ - -@[simp] theorem sign_eq_zero_iff_zero (a : Int) : sign a = 0 ↔ a = 0 := - ⟨eq_zero_of_sign_eq_zero, fun h => by rw [h, sign_zero]⟩ - -@[simp] theorem sign_sign : sign (sign x) = sign x := by - match x with - | 0 => rfl - | .ofNat (_ + 1) => rfl - | .negSucc _ => rfl - -@[simp] theorem sign_nonneg : 0 ≤ sign x ↔ 0 ≤ x := by - match x with - | 0 => rfl - | .ofNat (_ + 1) => - simp (config := { decide := true }) only [sign, true_iff] - exact Int.le_add_one (ofNat_nonneg _) - | .negSucc _ => simp (config := { decide := true }) [sign] - -/- ## natAbs -/ - -theorem natAbs_ne_zero {a : Int} : a.natAbs ≠ 0 ↔ a ≠ 0 := not_congr Int.natAbs_eq_zero - -theorem natAbs_mul_self : ∀ {a : Int}, ↑(natAbs a * natAbs a) = a * a - | ofNat _ => rfl - | -[_+1] => rfl - -theorem eq_nat_or_neg (a : Int) : ∃ n : Nat, a = n ∨ a = -↑n := ⟨_, natAbs_eq a⟩ - -theorem natAbs_mul_natAbs_eq {a b : Int} {c : Nat} - (h : a * b = (c : Int)) : a.natAbs * b.natAbs = c := by rw [← natAbs_mul, h, natAbs] - -@[simp] theorem natAbs_mul_self' (a : Int) : (natAbs a * natAbs a : Int) = a * a := by - rw [← Int.ofNat_mul, natAbs_mul_self] - -theorem natAbs_eq_iff {a : Int} {n : Nat} : a.natAbs = n ↔ a = n ∨ a = -↑n := by - rw [← Int.natAbs_eq_natAbs_iff, Int.natAbs_ofNat] - -theorem natAbs_add_le (a b : Int) : natAbs (a + b) ≤ natAbs a + natAbs b := by - suffices ∀ a b : Nat, natAbs (subNatNat a b.succ) ≤ (a + b).succ by - match a, b with - | (a:Nat), (b:Nat) => rw [ofNat_add_ofNat, natAbs_ofNat]; apply Nat.le_refl - | (a:Nat), -[b+1] => rw [natAbs_ofNat, natAbs_negSucc]; apply this - | -[a+1], (b:Nat) => - rw [natAbs_negSucc, natAbs_ofNat, Nat.succ_add, Nat.add_comm a b]; apply this - | -[a+1], -[b+1] => rw [natAbs_negSucc, succ_add]; apply Nat.le_refl - refine fun a b => subNatNat_elim a b.succ - (fun m n i => n = b.succ → natAbs i ≤ (m + b).succ) ?_ - (fun i n (e : (n + i).succ = _) => ?_) rfl - · rintro i n rfl - rw [Nat.add_comm _ i, Nat.add_assoc] - exact Nat.le_add_right i (b.succ + b).succ - · apply succ_le_succ - rw [← succ.inj e, ← Nat.add_assoc, Nat.add_comm] - apply Nat.le_add_right - -theorem natAbs_sub_le (a b : Int) : natAbs (a - b) ≤ natAbs a + natAbs b := by - rw [← Int.natAbs_neg b]; apply natAbs_add_le - -theorem negSucc_eq' (m : Nat) : -[m+1] = -m - 1 := by simp only [negSucc_eq, Int.neg_add]; rfl - -theorem natAbs_lt_natAbs_of_nonneg_of_lt {a b : Int} - (w₁ : 0 ≤ a) (w₂ : a < b) : a.natAbs < b.natAbs := - match a, b, eq_ofNat_of_zero_le w₁, eq_ofNat_of_zero_le (Int.le_trans w₁ (Int.le_of_lt w₂)) with - | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_lt.1 w₂ - -theorem eq_natAbs_iff_mul_eq_zero : natAbs a = n ↔ (a - n) * (a + n) = 0 := by - rw [natAbs_eq_iff, Int.mul_eq_zero, ← Int.sub_neg, Int.sub_eq_zero, Int.sub_eq_zero] - -/-! ### toNat -/ - -theorem mem_toNat' : ∀ (a : Int) (n : Nat), toNat' a = some n ↔ a = n - | (m : Nat), n => Option.some_inj.trans ofNat_inj.symm - | -[m+1], n => by constructor <;> nofun - @[deprecated] alias ofNat_natAbs_eq_of_nonneg := natAbs_of_nonneg diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 820618d84a..2b1420bfd5 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -107,8 +107,8 @@ elab_rules : tactic | some mvarId => replaceMainGoal [mvarId] pure usedSimps | ``Parser.Tactic.dsimp => do - let { ctx, .. } ← withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp) - dsimpLocation' ctx (expandOptLocation stx[5]) + let { ctx, simprocs, .. } ← withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp) + dsimpLocation' ctx simprocs (expandOptLocation stx[5]) | _ => Elab.throwUnsupportedSyntax let a := a.getId; let x := x.getId squeezeScopes.modify fun map => Id.run do diff --git a/lean-toolchain b/lean-toolchain index 8465e8d271..45ede451b4 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-11 +leanprover/lean4:nightly-2024-03-12 From d273b2fa12c198a6fc9375addb041affaf4ad332 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 12 Mar 2024 19:18:10 +1100 Subject: [PATCH 142/213] fix test --- Std/Tactic/SqueezeScope.lean | 3 ++- test/simp_trace.lean | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 2b1420bfd5..39fad08cfc 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -107,7 +107,8 @@ elab_rules : tactic | some mvarId => replaceMainGoal [mvarId] pure usedSimps | ``Parser.Tactic.dsimp => do - let { ctx, simprocs, .. } ← withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp) + let { ctx, simprocs, .. } ← withMainContext <| + mkSimpContext stx (eraseLocal := false) (kind := .dsimp) dsimpLocation' ctx simprocs (expandOptLocation stx[5]) | _ => Elab.throwUnsupportedSyntax let a := a.getId; let x := x.getId diff --git a/test/simp_trace.lean b/test/simp_trace.lean index b3cefc454c..c8b0dc270f 100644 --- a/test/simp_trace.lean +++ b/test/simp_trace.lean @@ -5,7 +5,7 @@ set_option linter.missingDocs false /-- info: Try this: simp only [Nat.add_comm] -/ #guard_msgs in example : x + 1 = 1 + x := by simp? [Nat.add_comm, Nat.mul_comm] -/-- info: Try this: dsimp only -/ +/-- info: Try this: dsimp only [Nat.reduceAdd] -/ #guard_msgs in example : 1 + 1 = 2 := by dsimp? From c59e73d9e9a0d182985584fb06ee186ed5ca840d Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Wed, 13 Mar 2024 04:17:06 +0000 Subject: [PATCH 143/213] Trigger CI for https://github.com/leanprover/lean4/pull/3579 From e002a969c814cfe05912471cb43e537665f8e89f Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 13 Mar 2024 19:10:54 +1100 Subject: [PATCH 144/213] bump toolchain --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 45ede451b4..c532a09f53 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-12 +leanprover/lean4:nightly-2024-03-13 From 5bcbfa4b9b93bdde24b95521222757e76cac4333 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 15 Mar 2024 09:14:25 +0000 Subject: [PATCH 145/213] chore: bump to nightly-2024-03-15 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index c532a09f53..4b4b300fc6 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-13 +leanprover/lean4:nightly-2024-03-15 From c3bbed04bdb72ad9be03a338f0057599a980386c Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 15 Mar 2024 20:34:24 +1100 Subject: [PATCH 146/213] fixes --- Std/CodeAction/Attr.lean | 2 +- Std/Tactic/Alias.lean | 4 ++-- Std/Tactic/OpenPrivate.lean | 2 +- Std/Tactic/PrintDependents.lean | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Std/CodeAction/Attr.lean b/Std/CodeAction/Attr.lean index f748450e7d..ad5e0f62d3 100644 --- a/Std/CodeAction/Attr.lean +++ b/Std/CodeAction/Attr.lean @@ -124,7 +124,7 @@ initialize if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions modifyEnv (tacticSeqCodeActionExt.addEntry · (decl, ← mkTacticSeqCodeAction decl)) else - let args ← args.mapM resolveGlobalConstNoOverloadWithInfo + let args ← args.mapM realizeGlobalConstNoOverloadWithInfo if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions modifyEnv (tacticCodeActionExt.addEntry · (⟨decl, args⟩, ← mkTacticCodeAction decl)) | _ => pure () diff --git a/Std/Tactic/Alias.lean b/Std/Tactic/Alias.lean index 87bbf2aba4..0be46ea599 100644 --- a/Std/Tactic/Alias.lean +++ b/Std/Tactic/Alias.lean @@ -79,7 +79,7 @@ def setDeprecatedTarget (target : Name) (arr : Array Attribute) : Array Attribut -/ elab (name := alias) mods:declModifiers "alias " alias:ident " := " name:ident : command => Command.liftTermElabM do - let name ← resolveGlobalConstNoOverloadWithInfo name + let name ← realizeGlobalConstNoOverloadWithInfo name let cinfo ← getConstInfo name let declMods ← elabModifiers mods let (attrs, machineApplicable) := setDeprecatedTarget name declMods.attrs @@ -164,7 +164,7 @@ private def addSide (mp : Bool) (declName : Name) (declMods : Modifiers) (thm : elab (name := aliasLR) mods:declModifiers "alias " "⟨" aliasFwd:binderIdent ", " aliasRev:binderIdent "⟩" " := " name:ident : command => Command.liftTermElabM do - let name ← resolveGlobalConstNoOverloadWithInfo name + let name ← realizeGlobalConstNoOverloadWithInfo name let declMods ← elabModifiers mods let declMods := { declMods with attrs := (setDeprecatedTarget name declMods.attrs).1 } let .thmInfo thm ← getConstInfo name | throwError "Target must be a theorem" diff --git a/Std/Tactic/OpenPrivate.lean b/Std/Tactic/OpenPrivate.lean index 0d3686a264..7ade0b94d9 100644 --- a/Std/Tactic/OpenPrivate.lean +++ b/Std/Tactic/OpenPrivate.lean @@ -49,7 +49,7 @@ def elabOpenPrivateLike (ids : Array Ident) (tgts mods : Option (Array Ident)) (f : (priv full user : Name) → CommandElabM Name) : CommandElabM Unit := do let mut names := NameSet.empty for tgt in tgts.getD #[] do - let n ← resolveGlobalConstNoOverloadWithInfo tgt + let n ← liftCoreM <| realizeGlobalConstNoOverloadWithInfo tgt names ← Meta.collectPrivateIn n names for mod in mods.getD #[] do let some modIdx := (← getEnv).moduleIdxForModule? mod.getId diff --git a/Std/Tactic/PrintDependents.lean b/Std/Tactic/PrintDependents.lean index 007bb6c7a0..3234456a63 100644 --- a/Std/Tactic/PrintDependents.lean +++ b/Std/Tactic/PrintDependents.lean @@ -16,7 +16,7 @@ of all theorems directly referenced that are "to blame" for this dependency. Use unexpected dependencies. -/ namespace Std.Tactic -open Lean Elab +open Lean Elab Command namespace CollectDependents @@ -88,7 +88,7 @@ theorem bar' : 1 = 1 ∨ 1 ≠ 1 := foo -/ elab tk:"#print" &"dependents" ids:(ppSpace colGt ident)* : command => do let env ← getEnv - let ids ← ids.mapM fun c => return (← resolveGlobalConstNoOverloadWithInfo c, true) + let ids ← ids.mapM fun c => return (← liftCoreM <| realizeGlobalConstNoOverloadWithInfo c, true) let init := CollectDependents.mkState ids false let mut state := init let mut out := #[] From 3294e7311826c118eaa115542b420e1ff5177435 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 15 Mar 2024 20:47:01 +1100 Subject: [PATCH 147/213] fix deprecated code action --- Std/CodeAction/Deprecated.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Std/CodeAction/Deprecated.lean b/Std/CodeAction/Deprecated.lean index 132edd575b..e17ed8b2f0 100644 --- a/Std/CodeAction/Deprecated.lean +++ b/Std/CodeAction/Deprecated.lean @@ -29,8 +29,8 @@ def deprecatedCodeActionProvider : CodeActionProvider := fun params snap => do let mut i := 0 let doc ← readDoc let mut msgs := #[] - for diag in snap.interactiveDiags do - if let some #[.deprecated] := diag.tags? then + for m in snap.msgLog.msgs do + if m.data.isDeprecationWarning then if h : _ then msgs := msgs.push (snap.cmdState.messages.msgs[i]'h) i := i + 1 From 2c55b6bdd2a48362316f6ca24ddb5a2f1e8536a7 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 15 Mar 2024 21:01:11 +1100 Subject: [PATCH 148/213] check for reserved names in isAutoDecl --- Std/Tactic/Lint/Basic.lean | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/Std/Tactic/Lint/Basic.lean b/Std/Tactic/Lint/Basic.lean index a14cea4afd..31ed595743 100644 --- a/Std/Tactic/Lint/Basic.lean +++ b/Std/Tactic/Lint/Basic.lean @@ -34,16 +34,18 @@ expansion. def isAutoDecl (decl : Name) : CoreM Bool := do if decl.hasMacroScopes then return true if decl.isInternal then return true + let env ← getEnv + if isReservedName env decl then return true if let Name.str n s := decl then if s.startsWith "proof_" || s.startsWith "match_" || s.startsWith "unsafe_" then return true - if (← getEnv).isConstructor n && ["injEq", "inj", "sizeOf_spec"].any (· == s) then + if env.isConstructor n && ["injEq", "inj", "sizeOf_spec"].any (· == s) then return true if let ConstantInfo.inductInfo _ := (← getEnv).find? n then if [casesOnSuffix, recOnSuffix, brecOnSuffix, binductionOnSuffix, belowSuffix, "ibelow", "ndrec", "ndrecOn", "noConfusionType", "noConfusion", "ofNat", "toCtorIdx" ].any (· == s) then return true - if let some _ := isSubobjectField? (← getEnv) n s then + if let some _ := isSubobjectField? env n s then return true pure false From 05f0ca9f3682a13607af6cd9d9ccaf6decb32e1b Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 16 Mar 2024 09:13:30 +0000 Subject: [PATCH 149/213] chore: bump to nightly-2024-03-16 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 4b4b300fc6..539e2b1908 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-15 +leanprover/lean4:nightly-2024-03-16 From ecee90f43fa52d3d6763ccfe4c5bb57bfc17870c Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sun, 17 Mar 2024 09:13:02 +0000 Subject: [PATCH 150/213] chore: bump to nightly-2024-03-17 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 539e2b1908..3ad467e179 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-16 +leanprover/lean4:nightly-2024-03-17 From c318688b9640702decc05914310c686af0ca14af Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 18 Mar 2024 09:15:33 +0000 Subject: [PATCH 151/213] chore: bump to nightly-2024-03-18 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 3ad467e179..26a2acc287 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-17 +leanprover/lean4:nightly-2024-03-18 From 70c816de1091582298e0de6de94322e376611bf5 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 18 Mar 2024 22:15:53 +1100 Subject: [PATCH 152/213] fix --- Std.lean | 1 - Std/Data/List/Perm.lean | 3 +- Std/Logic.lean | 3 -- Std/Tactic/Relation/Rfl.lean | 78 ------------------------------------ test/rfl.lean | 3 +- 5 files changed, 4 insertions(+), 84 deletions(-) delete mode 100644 Std/Tactic/Relation/Rfl.lean diff --git a/Std.lean b/Std.lean index 2d3a6d9782..ec0b29517d 100644 --- a/Std.lean +++ b/Std.lean @@ -92,7 +92,6 @@ import Std.Tactic.OpenPrivate import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix -import Std.Tactic.Relation.Rfl import Std.Tactic.SeqFocus import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable diff --git a/Std/Data/List/Perm.lean b/Std/Data/List/Perm.lean index aa382e3ad4..2438d0f0f5 100644 --- a/Std/Data/List/Perm.lean +++ b/Std/Data/List/Perm.lean @@ -4,9 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import Std.Tactic.Alias -import Std.Tactic.Relation.Rfl import Std.Data.List.Init.Attach import Std.Data.List.Pairwise +-- Adaptation note: nightly-2024-03-18. We should be able to remove this after nightly-2024-03-19. +import Lean.Elab.Tactic.Rfl /-! # List Permutations diff --git a/Std/Logic.lean b/Std/Logic.lean index e7703371ff..1069b48c75 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -32,9 +32,6 @@ end Classical theorem heq_iff_eq : HEq a b ↔ a = b := ⟨eq_of_heq, heq_of_eq⟩ -theorem proof_irrel_heq {p q : Prop} (hp : p) (hq : q) : HEq hp hq := by - cases propext (iff_of_true hp hq); rfl - @[simp] theorem eq_rec_constant {α : Sort _} {a a' : α} {β : Sort _} (y : β) (h : a = a') : (@Eq.rec α a (fun α _ => β) y a' h) = y := by cases h; rfl diff --git a/Std/Tactic/Relation/Rfl.lean b/Std/Tactic/Relation/Rfl.lean deleted file mode 100644 index 13a1c7d4c4..0000000000 --- a/Std/Tactic/Relation/Rfl.lean +++ /dev/null @@ -1,78 +0,0 @@ -/- -Copyright (c) 2022 Newell Jensen. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Newell Jensen, Thomas Murrills --/ -import Lean.Meta.Tactic.Apply -import Lean.Elab.Tactic.Basic - -/-! -# `rfl` tactic extension for reflexive relations - -This extends the `rfl` tactic so that it works on any reflexive relation, -provided the reflexivity lemma has been marked as `@[refl]`. --/ - -namespace Std.Tactic - -open Lean Meta - -/-- Discrimation tree settings for the `refl` extension. -/ -def reflExt.config : WhnfCoreConfig := {} - -/-- Environment extensions for `refl` lemmas -/ -initialize reflExt : - SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ← - registerSimpleScopedEnvExtension { - addEntry := fun dt (n, ks) => dt.insertCore ks n - initial := {} - } - -initialize registerBuiltinAttribute { - name := `refl - descr := "reflexivity relation" - add := fun decl _ kind => MetaM.run' do - let declTy := (← getConstInfo decl).type - let (_, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy - let fail := throwError - "@[refl] attribute only applies to lemmas proving x ∼ x, got {declTy}" - let .app (.app rel lhs) rhs := targetTy | fail - unless ← withNewMCtxDepth <| isDefEq lhs rhs do fail - let key ← DiscrTree.mkPath rel reflExt.config - reflExt.add (decl, key) kind -} - -open Elab Tactic - -/-- `MetaM` version of the `rfl` tactic. - -This tactic applies to a goal whose target has the form `x ~ x`, where `~` is a reflexive -relation, that is, a relation which has a reflexive lemma tagged with the attribute [refl]. --/ -def _root_.Lean.MVarId.applyRfl (goal : MVarId) : MetaM Unit := do - let .app (.app rel _) _ ← whnfR <|← instantiateMVars <|← goal.getType - | throwError "reflexivity lemmas only apply to binary relations, not{ - indentExpr (← goal.getType)}" - let s ← saveState - let mut ex? := none - for lem in ← (reflExt.getState (← getEnv)).getMatch rel reflExt.config do - try - let gs ← goal.apply (← mkConstWithFreshMVarLevels lem) - if gs.isEmpty then return () else - logError <| MessageData.tagged `Tactic.unsolvedGoals <| m!"unsolved goals\n{ - goalsToMessageData gs}" - catch e => - ex? := ex? <|> (some (← saveState, e)) -- stash the first failure of `apply` - s.restore - if let some (sErr, e) := ex? then - sErr.restore - throw e - else - throwError "rfl failed, no lemma with @[refl] applies" - -/-- -This tactic applies to a goal whose target has the form `x ~ x`, where `~` is a reflexive -relation, that is, a relation which has a reflexive lemma tagged with the attribute [refl]. --/ -elab_rules : tactic - | `(tactic| rfl) => withMainContext do liftMetaFinishingTactic (·.applyRfl) diff --git a/test/rfl.lean b/test/rfl.lean index 8d2383785d..b9bb0db0ee 100644 --- a/test/rfl.lean +++ b/test/rfl.lean @@ -1,4 +1,5 @@ -import Std.Tactic.Relation.Rfl +import Lean.Elab.Tactic.Rfl +-- Adaptation note: we should be able to remove this import after nightly-2024-03-19 set_option linter.missingDocs false From 48ebe8ff50f0b9855f260fdec48e5a3a4d3efd3b Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Tue, 19 Mar 2024 09:14:43 +0000 Subject: [PATCH 153/213] chore: bump to nightly-2024-03-19 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 26a2acc287..5e613f5757 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-18 +leanprover/lean4:nightly-2024-03-19 From edb7a9d0f63b7f1161a21ba62be70c1cf323ef32 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 20 Mar 2024 11:51:04 +1100 Subject: [PATCH 154/213] fixes --- Std/Data/Array/Lemmas.lean | 14 +++++++------- Std/Data/UnionFind/Basic.lean | 31 ++++++++++++++++--------------- Std/Data/UnionFind/Lemmas.lean | 2 +- 3 files changed, 24 insertions(+), 23 deletions(-) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 7a4cf9bd73..199f1a3036 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -210,13 +210,6 @@ theorem size_eq_length_data (as : Array α) : as.size = as.data.length := rfl | zero => simp [Nat.fold] | succ k ih => rw [Nat.fold, flip]; simpa -theorem get_modify {arr : Array α} {x i} (h : i < arr.size) : - (arr.modify x f).get ⟨i, by simp [h]⟩ = - if x = i then f (arr.get ⟨i, h⟩) else arr.get ⟨i, h⟩ := by - simp [modify, modifyM, Id.run]; split - · simp [get_set _ _ _ h]; split <;> simp [*] - · rw [if_neg (mt (by rintro rfl; exact h) ‹_›)] - @[simp] theorem reverse_data (a : Array α) : a.reverse.data = a.data.reverse := by let rec go (as : Array α) (i j hj) (h : i + j + 1 = a.size) (h₂ : as.size = a.size) @@ -523,6 +516,13 @@ theorem mapIdx_spec (as : Array α) (f : Fin as.size → α → β) unfold modify modifyM Id.run split <;> simp +theorem get_modify {arr : Array α} {x i} (h : i < arr.size) : + (arr.modify x f).get ⟨i, by simp [h]⟩ = + if x = i then f (arr.get ⟨i, h⟩) else arr.get ⟨i, h⟩ := by + simp [modify, modifyM, Id.run]; split + · simp [get_set _ _ _ h]; split <;> simp [*] + · rw [if_neg (mt (by rintro rfl; exact h) ‹_›)] + /-! ### filter -/ @[simp] theorem filter_data (p : α → Bool) (l : Array α) : diff --git a/Std/Data/UnionFind/Basic.lean b/Std/Data/UnionFind/Basic.lean index 8012fb2da0..e75dfa9968 100644 --- a/Std/Data/UnionFind/Basic.lean +++ b/Std/Data/UnionFind/Basic.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Std.Data.Array.Lemmas +import Std.Tactic.Lint.Misc namespace Std @@ -109,8 +110,8 @@ namespace UnionFind /-- Create an empty union-find structure with specific capacity -/ def mkEmpty (c : Nat) : UnionFind where arr := Array.mkEmpty c - parentD_lt := (fun.) - rankD_lt := fun. + parentD_lt := nofun + rankD_lt := nofun /-- Empty union-find structure -/ def empty := mkEmpty 0 @@ -180,7 +181,7 @@ def root (self : UnionFind) (x : Fin self.size) : Fin self.size := else have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ h) self.root ⟨y, self.parent'_lt x⟩ -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x @[inherit_doc root] def rootN (self : UnionFind) (x : Fin n) (h : n = self.size) : Fin n := @@ -200,7 +201,7 @@ theorem parent_root (self : UnionFind) (x : Fin self.size) : rw [root]; split <;> [assumption; skip] have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) apply parent_root -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x theorem parent_rootD (self : UnionFind) (x : Nat) : self.parent (self.rootD x) = self.rootD x := by @@ -232,7 +233,7 @@ theorem rootD_ext {m1 m2 : UnionFind} else have := Nat.sub_lt_sub_left (m2.lt_rankMax x) (m2.rank_lt h) rw [← rootD_parent, H, rootD_ext H, rootD_parent] -termination_by _ => m2.rankMax - m2.rank x +termination_by m2.rankMax - m2.rank x theorem le_rank_root {self : UnionFind} {x : Nat} : self.rank x ≤ self.rank (self.rootD x) := by if h : self.parent x = x then @@ -241,7 +242,7 @@ theorem le_rank_root {self : UnionFind} {x : Nat} : self.rank x ≤ self.rank (s have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank_lt h) rw [← rootD_parent] exact Nat.le_trans (Nat.le_of_lt (self.rank_lt h)) le_rank_root -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x theorem lt_rank_root {self : UnionFind} {x : Nat} : self.rank x < self.rank (self.rootD x) ↔ self.parent x ≠ x := by @@ -267,7 +268,7 @@ def findAux (self : UnionFind) (x : Fin self.size) : FindAux self.size := have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ h) let ⟨arr₁, root, H⟩ := self.findAux ⟨y, self.parent'_lt x⟩ ⟨arr₁.modify x fun s => { s with parent := root }, root, by simp [H]⟩ -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x @[nolint unusedHavesSuffices] theorem findAux_root {self : UnionFind} {x : Fin self.size} : @@ -275,7 +276,7 @@ theorem findAux_root {self : UnionFind} {x : Fin self.size} : rw [findAux, root]; simp; split <;> simp have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) exact findAux_root -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x @[nolint unusedHavesSuffices] theorem findAux_s {self : UnionFind} {x : Fin self.size} : @@ -299,7 +300,7 @@ theorem rankD_findAux {self : UnionFind} {x : Fin self.size} : split <;> simp [← rankD_eq, rankD_findAux (x := ⟨_, self.parent'_lt x⟩), -Array.get_eq_getElem] else simp [rank, rankD]; rw [dif_neg (by rwa [FindAux.size_eq]), dif_neg h] -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x theorem parentD_findAux {self : UnionFind} {x : Fin self.size} : parentD (findAux self x).s i = @@ -322,7 +323,7 @@ theorem parentD_findAux_rootD {self : UnionFind} {x : Fin self.size} : have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) rw [← rootD_parent, parent, parentD_eq] exact parentD_findAux_rootD (x := ⟨_, self.parent'_lt x⟩) -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x theorem parentD_findAux_lt {self : UnionFind} {x : Fin self.size} (h : i < self.size) : parentD (findAux self x).s i < self.size := by @@ -332,7 +333,7 @@ theorem parentD_findAux_lt {self : UnionFind} {x : Fin self.size} (h : i < self. rw [parentD_findAux]; split <;> [simp [rootD_lt]; skip] have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) apply parentD_findAux_lt h -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x theorem parentD_findAux_or (self : UnionFind) (x : Fin self.size) (i) : parentD (findAux self x).s i = self.rootD i ∧ self.rootD i = self.rootD x ∨ @@ -344,7 +345,7 @@ theorem parentD_findAux_or (self : UnionFind) (x : Fin self.size) (i) : have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) exact (parentD_findAux_or self ⟨_, self.parent'_lt x⟩ i).imp_left <| .imp_right fun h => by simp only [h, ← parentD_eq, rootD_parent, Array.data_length] -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x theorem lt_rankD_findAux {self : UnionFind} {x : Fin self.size} : parentD (findAux self x).s i ≠ i → @@ -356,7 +357,7 @@ theorem lt_rankD_findAux {self : UnionFind} {x : Fin self.size} : · subst i; rwa [lt_rank_root, Ne, ← rootD_eq_self] · have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) apply lt_rankD_findAux h' -termination_by _ => self.rankMax - self.rank x +termination_by self.rankMax - self.rank x /-- Find root of a union-find node, updating the structure using path compression. -/ def find (self : UnionFind) (x : Fin self.size) : @@ -416,7 +417,7 @@ theorem find_parent_or (self : UnionFind) (x : Fin self.size) (i) : obtain ⟨h1, _⟩ | h1 := find_parent_or self x i · rw [h1, rootD_rootD] · rw [h1, rootD_parent] -termination_by _ => (self.find x).1.rankMax - (self.find x).1.rank i +termination_by (self.find x).1.rankMax - (self.find x).1.rank i decreasing_by exact this -- why is this needed? It is way slower without it /-- Link two union-find nodes -/ @@ -431,7 +432,7 @@ def linkAux (self : Array UFNode) (x y : Fin self.size) : Array UFNode := else let arr₁ := self.set x {nx with parent := y} if nx.rank = ny.rank then - arr₁.set ⟨y, by simp⟩ {ny with rank := ny.rank + 1} + arr₁.set ⟨y, by simp [arr₁]⟩ {ny with rank := ny.rank + 1} else arr₁ diff --git a/Std/Data/UnionFind/Lemmas.lean b/Std/Data/UnionFind/Lemmas.lean index f78782253c..e08cddd53e 100644 --- a/Std/Data/UnionFind/Lemmas.lean +++ b/Std/Data/UnionFind/Lemmas.lean @@ -88,13 +88,13 @@ theorem root_link {self : UnionFind} {x y : Fin self.size} rw [← rootD_parent, go (m.parent i)] rw [hm i]; split <;> [subst i; rw [rootD_parent]] simp [rootD_eq_self.2 xroot, rootD_eq_self.2 yroot] + termination_by m.rankMax - m.rank i exact ⟨x, .inl rfl, go⟩ if hr : self.rank y < self.rank x then exact this xroot yroot fun i => by simp [parent_link, h, hr] else simpa (config := {singlePass := true}) [or_comm] using this yroot xroot fun i => by simp [parent_link, h, hr] -termination_by go => m.rankMax - m.rank i nonrec theorem Equiv.rfl : Equiv self a a := rfl theorem Equiv.symm : Equiv self a b → Equiv self b a := .symm From 976093efcb3c1f6c9d80ab7015ba4cce372f9f87 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 20 Mar 2024 11:53:25 +1100 Subject: [PATCH 155/213] chore: adaptations for nightly-2024-03-19 --- Std.lean | 1 - Std/CodeAction/Attr.lean | 2 +- Std/CodeAction/Deprecated.lean | 4 +- Std/Data/Array/Lemmas.lean | 56 +++++++++++++++++++++++ Std/Data/List/Perm.lean | 3 +- Std/Logic.lean | 3 -- Std/Tactic/Alias.lean | 4 +- Std/Tactic/Lint/Basic.lean | 6 ++- Std/Tactic/OpenPrivate.lean | 2 +- Std/Tactic/PrintDependents.lean | 4 +- Std/Tactic/Relation/Rfl.lean | 78 --------------------------------- lean-toolchain | 2 +- test/rfl.lean | 3 +- 13 files changed, 73 insertions(+), 95 deletions(-) delete mode 100644 Std/Tactic/Relation/Rfl.lean diff --git a/Std.lean b/Std.lean index 2d3a6d9782..ec0b29517d 100644 --- a/Std.lean +++ b/Std.lean @@ -92,7 +92,6 @@ import Std.Tactic.OpenPrivate import Std.Tactic.PermuteGoals import Std.Tactic.PrintDependents import Std.Tactic.PrintPrefix -import Std.Tactic.Relation.Rfl import Std.Tactic.SeqFocus import Std.Tactic.SqueezeScope import Std.Tactic.Unreachable diff --git a/Std/CodeAction/Attr.lean b/Std/CodeAction/Attr.lean index f748450e7d..ad5e0f62d3 100644 --- a/Std/CodeAction/Attr.lean +++ b/Std/CodeAction/Attr.lean @@ -124,7 +124,7 @@ initialize if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions modifyEnv (tacticSeqCodeActionExt.addEntry · (decl, ← mkTacticSeqCodeAction decl)) else - let args ← args.mapM resolveGlobalConstNoOverloadWithInfo + let args ← args.mapM realizeGlobalConstNoOverloadWithInfo if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions modifyEnv (tacticCodeActionExt.addEntry · (⟨decl, args⟩, ← mkTacticCodeAction decl)) | _ => pure () diff --git a/Std/CodeAction/Deprecated.lean b/Std/CodeAction/Deprecated.lean index 132edd575b..e17ed8b2f0 100644 --- a/Std/CodeAction/Deprecated.lean +++ b/Std/CodeAction/Deprecated.lean @@ -29,8 +29,8 @@ def deprecatedCodeActionProvider : CodeActionProvider := fun params snap => do let mut i := 0 let doc ← readDoc let mut msgs := #[] - for diag in snap.interactiveDiags do - if let some #[.deprecated] := diag.tags? then + for m in snap.msgLog.msgs do + if m.data.isDeprecationWarning then if h : _ then msgs := msgs.push (snap.cmdState.messages.msgs[i]'h) i := i + 1 diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 3e289cbfe6..583423cb83 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -843,3 +843,59 @@ instance [DecidableEq α] (a : α) (as : Array α) : Decidable (a ∈ as) := /-! ### erase -/ @[simp] proof_wanted erase_data [BEq α] {l : Array α} {a : α} : (l.erase a).data = l.data.erase a + +/-! ### swap -/ + +@[simp] theorem get_swap_right (a : Array α) {i j : Fin a.size} : (a.swap i j)[j.val] = a[i] := + by simp only [swap, fin_cast_val, get_eq_getElem, getElem_set_eq, getElem_fin] + +@[simp] theorem get_swap_left (a : Array α) {i j : Fin a.size} : (a.swap i j)[i.val] = a[j] := + if he : ((Array.size_set _ _ _).symm ▸ j).val = i.val then by + simp only [←he, fin_cast_val, get_swap_right, getElem_fin] + else by + apply Eq.trans + · apply Array.get_set_ne + · simp only [size_set, Fin.is_lt] + · assumption + · simp [get_set_ne] + +@[simp] theorem get_swap_of_ne (a : Array α) {i j : Fin a.size} (hp : p < a.size) + (hi : p ≠ i) (hj : p ≠ j) : (a.swap i j)[p]'(a.size_swap .. |>.symm ▸ hp) = a[p] := by + apply Eq.trans + · have : ((a.size_set i (a.get j)).symm ▸ j).val = j.val := by simp only [fin_cast_val] + apply Array.get_set_ne + · simp only [this] + apply Ne.symm + · assumption + · apply Array.get_set_ne + · apply Ne.symm + · assumption + +theorem get_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 + split + · simp_all only [get_swap_left] + · split <;> simp_all + +theorem get_swap' (a : Array α) (i j : Fin a.size) (k : Nat) (hk' : k < (a.swap i j).size) : + (a.swap i j)[k] = if k = i then a[j] else if k = j then a[i] else a[k]'(by simp_all) := by + apply get_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 + apply ext + · simp only [size_swap] + · intros + simp only [get_swap'] + split + · simp_all + · split <;> simp_all + +theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i := by + apply ext + · simp only [size_swap] + · intros + simp only [get_swap'] + split + · split <;> simp_all + · split <;> simp_all diff --git a/Std/Data/List/Perm.lean b/Std/Data/List/Perm.lean index aa382e3ad4..2438d0f0f5 100644 --- a/Std/Data/List/Perm.lean +++ b/Std/Data/List/Perm.lean @@ -4,9 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import Std.Tactic.Alias -import Std.Tactic.Relation.Rfl import Std.Data.List.Init.Attach import Std.Data.List.Pairwise +-- Adaptation note: nightly-2024-03-18. We should be able to remove this after nightly-2024-03-19. +import Lean.Elab.Tactic.Rfl /-! # List Permutations diff --git a/Std/Logic.lean b/Std/Logic.lean index e7703371ff..1069b48c75 100644 --- a/Std/Logic.lean +++ b/Std/Logic.lean @@ -32,9 +32,6 @@ end Classical theorem heq_iff_eq : HEq a b ↔ a = b := ⟨eq_of_heq, heq_of_eq⟩ -theorem proof_irrel_heq {p q : Prop} (hp : p) (hq : q) : HEq hp hq := by - cases propext (iff_of_true hp hq); rfl - @[simp] theorem eq_rec_constant {α : Sort _} {a a' : α} {β : Sort _} (y : β) (h : a = a') : (@Eq.rec α a (fun α _ => β) y a' h) = y := by cases h; rfl diff --git a/Std/Tactic/Alias.lean b/Std/Tactic/Alias.lean index 87bbf2aba4..0be46ea599 100644 --- a/Std/Tactic/Alias.lean +++ b/Std/Tactic/Alias.lean @@ -79,7 +79,7 @@ def setDeprecatedTarget (target : Name) (arr : Array Attribute) : Array Attribut -/ elab (name := alias) mods:declModifiers "alias " alias:ident " := " name:ident : command => Command.liftTermElabM do - let name ← resolveGlobalConstNoOverloadWithInfo name + let name ← realizeGlobalConstNoOverloadWithInfo name let cinfo ← getConstInfo name let declMods ← elabModifiers mods let (attrs, machineApplicable) := setDeprecatedTarget name declMods.attrs @@ -164,7 +164,7 @@ private def addSide (mp : Bool) (declName : Name) (declMods : Modifiers) (thm : elab (name := aliasLR) mods:declModifiers "alias " "⟨" aliasFwd:binderIdent ", " aliasRev:binderIdent "⟩" " := " name:ident : command => Command.liftTermElabM do - let name ← resolveGlobalConstNoOverloadWithInfo name + let name ← realizeGlobalConstNoOverloadWithInfo name let declMods ← elabModifiers mods let declMods := { declMods with attrs := (setDeprecatedTarget name declMods.attrs).1 } let .thmInfo thm ← getConstInfo name | throwError "Target must be a theorem" diff --git a/Std/Tactic/Lint/Basic.lean b/Std/Tactic/Lint/Basic.lean index a14cea4afd..31ed595743 100644 --- a/Std/Tactic/Lint/Basic.lean +++ b/Std/Tactic/Lint/Basic.lean @@ -34,16 +34,18 @@ expansion. def isAutoDecl (decl : Name) : CoreM Bool := do if decl.hasMacroScopes then return true if decl.isInternal then return true + let env ← getEnv + if isReservedName env decl then return true if let Name.str n s := decl then if s.startsWith "proof_" || s.startsWith "match_" || s.startsWith "unsafe_" then return true - if (← getEnv).isConstructor n && ["injEq", "inj", "sizeOf_spec"].any (· == s) then + if env.isConstructor n && ["injEq", "inj", "sizeOf_spec"].any (· == s) then return true if let ConstantInfo.inductInfo _ := (← getEnv).find? n then if [casesOnSuffix, recOnSuffix, brecOnSuffix, binductionOnSuffix, belowSuffix, "ibelow", "ndrec", "ndrecOn", "noConfusionType", "noConfusion", "ofNat", "toCtorIdx" ].any (· == s) then return true - if let some _ := isSubobjectField? (← getEnv) n s then + if let some _ := isSubobjectField? env n s then return true pure false diff --git a/Std/Tactic/OpenPrivate.lean b/Std/Tactic/OpenPrivate.lean index 0d3686a264..7ade0b94d9 100644 --- a/Std/Tactic/OpenPrivate.lean +++ b/Std/Tactic/OpenPrivate.lean @@ -49,7 +49,7 @@ def elabOpenPrivateLike (ids : Array Ident) (tgts mods : Option (Array Ident)) (f : (priv full user : Name) → CommandElabM Name) : CommandElabM Unit := do let mut names := NameSet.empty for tgt in tgts.getD #[] do - let n ← resolveGlobalConstNoOverloadWithInfo tgt + let n ← liftCoreM <| realizeGlobalConstNoOverloadWithInfo tgt names ← Meta.collectPrivateIn n names for mod in mods.getD #[] do let some modIdx := (← getEnv).moduleIdxForModule? mod.getId diff --git a/Std/Tactic/PrintDependents.lean b/Std/Tactic/PrintDependents.lean index 007bb6c7a0..3234456a63 100644 --- a/Std/Tactic/PrintDependents.lean +++ b/Std/Tactic/PrintDependents.lean @@ -16,7 +16,7 @@ of all theorems directly referenced that are "to blame" for this dependency. Use unexpected dependencies. -/ namespace Std.Tactic -open Lean Elab +open Lean Elab Command namespace CollectDependents @@ -88,7 +88,7 @@ theorem bar' : 1 = 1 ∨ 1 ≠ 1 := foo -/ elab tk:"#print" &"dependents" ids:(ppSpace colGt ident)* : command => do let env ← getEnv - let ids ← ids.mapM fun c => return (← resolveGlobalConstNoOverloadWithInfo c, true) + let ids ← ids.mapM fun c => return (← liftCoreM <| realizeGlobalConstNoOverloadWithInfo c, true) let init := CollectDependents.mkState ids false let mut state := init let mut out := #[] diff --git a/Std/Tactic/Relation/Rfl.lean b/Std/Tactic/Relation/Rfl.lean deleted file mode 100644 index 13a1c7d4c4..0000000000 --- a/Std/Tactic/Relation/Rfl.lean +++ /dev/null @@ -1,78 +0,0 @@ -/- -Copyright (c) 2022 Newell Jensen. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Newell Jensen, Thomas Murrills --/ -import Lean.Meta.Tactic.Apply -import Lean.Elab.Tactic.Basic - -/-! -# `rfl` tactic extension for reflexive relations - -This extends the `rfl` tactic so that it works on any reflexive relation, -provided the reflexivity lemma has been marked as `@[refl]`. --/ - -namespace Std.Tactic - -open Lean Meta - -/-- Discrimation tree settings for the `refl` extension. -/ -def reflExt.config : WhnfCoreConfig := {} - -/-- Environment extensions for `refl` lemmas -/ -initialize reflExt : - SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ← - registerSimpleScopedEnvExtension { - addEntry := fun dt (n, ks) => dt.insertCore ks n - initial := {} - } - -initialize registerBuiltinAttribute { - name := `refl - descr := "reflexivity relation" - add := fun decl _ kind => MetaM.run' do - let declTy := (← getConstInfo decl).type - let (_, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy - let fail := throwError - "@[refl] attribute only applies to lemmas proving x ∼ x, got {declTy}" - let .app (.app rel lhs) rhs := targetTy | fail - unless ← withNewMCtxDepth <| isDefEq lhs rhs do fail - let key ← DiscrTree.mkPath rel reflExt.config - reflExt.add (decl, key) kind -} - -open Elab Tactic - -/-- `MetaM` version of the `rfl` tactic. - -This tactic applies to a goal whose target has the form `x ~ x`, where `~` is a reflexive -relation, that is, a relation which has a reflexive lemma tagged with the attribute [refl]. --/ -def _root_.Lean.MVarId.applyRfl (goal : MVarId) : MetaM Unit := do - let .app (.app rel _) _ ← whnfR <|← instantiateMVars <|← goal.getType - | throwError "reflexivity lemmas only apply to binary relations, not{ - indentExpr (← goal.getType)}" - let s ← saveState - let mut ex? := none - for lem in ← (reflExt.getState (← getEnv)).getMatch rel reflExt.config do - try - let gs ← goal.apply (← mkConstWithFreshMVarLevels lem) - if gs.isEmpty then return () else - logError <| MessageData.tagged `Tactic.unsolvedGoals <| m!"unsolved goals\n{ - goalsToMessageData gs}" - catch e => - ex? := ex? <|> (some (← saveState, e)) -- stash the first failure of `apply` - s.restore - if let some (sErr, e) := ex? then - sErr.restore - throw e - else - throwError "rfl failed, no lemma with @[refl] applies" - -/-- -This tactic applies to a goal whose target has the form `x ~ x`, where `~` is a reflexive -relation, that is, a relation which has a reflexive lemma tagged with the attribute [refl]. --/ -elab_rules : tactic - | `(tactic| rfl) => withMainContext do liftMetaFinishingTactic (·.applyRfl) diff --git a/lean-toolchain b/lean-toolchain index c532a09f53..5e613f5757 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-13 +leanprover/lean4:nightly-2024-03-19 diff --git a/test/rfl.lean b/test/rfl.lean index 8d2383785d..b9bb0db0ee 100644 --- a/test/rfl.lean +++ b/test/rfl.lean @@ -1,4 +1,5 @@ -import Std.Tactic.Relation.Rfl +import Lean.Elab.Tactic.Rfl +-- Adaptation note: we should be able to remove this import after nightly-2024-03-19 set_option linter.missingDocs false From 865c48eb5d3b17621b5474f036c107c8bf5d32c9 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 21 Mar 2024 11:32:30 +1100 Subject: [PATCH 156/213] fix --- Std/Tactic/Lint/Basic.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Tactic/Lint/Basic.lean b/Std/Tactic/Lint/Basic.lean index 31ed595743..8f9150a173 100644 --- a/Std/Tactic/Lint/Basic.lean +++ b/Std/Tactic/Lint/Basic.lean @@ -45,7 +45,7 @@ def isAutoDecl (decl : Name) : CoreM Bool := do "ndrec", "ndrecOn", "noConfusionType", "noConfusion", "ofNat", "toCtorIdx" ].any (· == s) then return true - if let some _ := isSubobjectField? env n s then + if let some _ := isSubobjectField? env n (.mkSimple s) then return true pure false From 4ccec467512c550a7dfe1375fc200f985811abeb Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Thu, 21 Mar 2024 09:14:49 +0000 Subject: [PATCH 157/213] chore: bump to nightly-2024-03-21 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 5e613f5757..6fd55e8e99 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-19 +leanprover/lean4:nightly-2024-03-21 From cda53ac100bec332649022581970df08e042b2e1 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 22 Mar 2024 11:21:09 +1100 Subject: [PATCH 158/213] fix --- Std/Data/List/Lemmas.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index b9c012ec5b..407c508bb0 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -7,6 +7,7 @@ import Std.Control.ForInStep.Lemmas import Std.Data.Nat.Basic import Std.Data.List.Basic import Std.Tactic.Init +import Std.Tactic.Alias namespace List @@ -926,7 +927,6 @@ theorem get_take' (L : List α) {j i} : theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l.get? m := by induction n generalizing l m with | zero => - simp only [Nat.zero_eq] at h exact absurd h (Nat.not_lt_of_le m.zero_le) | succ _ hn => cases l with From 702be0d3c58529e496e147aec8df6dc074029852 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 22 Mar 2024 20:05:04 +1100 Subject: [PATCH 159/213] bump --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 6fd55e8e99..a6f89805e1 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-21 +leanprover/lean4:nightly-2024-03-22 From 4dbc8fabbc625b7775e14faadb25fa7466b539bb Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 22 Mar 2024 20:15:34 +1100 Subject: [PATCH 160/213] unused variable --- Std/Tactic/Where.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Tactic/Where.lean b/Std/Tactic/Where.lean index 367670e49c..5a3cbbbfa3 100644 --- a/Std/Tactic/Where.lean +++ b/Std/Tactic/Where.lean @@ -35,7 +35,7 @@ private def describeOpenDecls (ds : List OpenDecl) : MessageData := Id.run do (lines, simple) := flush lines simple let ex' := ex.map toMessageData lines := lines.push m!"open {ns} hiding {MessageData.joinSep ex' ", "}" - (lines, simple) := flush lines simple + (lines, _) := flush lines simple return MessageData.joinSep lines.toList "\n" private def describeOptions (opts : Options) : CommandElabM (Option MessageData) := do From eadf616edd4b9d10461916df60b4c1f08359087b Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 22 Mar 2024 20:18:10 +1100 Subject: [PATCH 161/213] fix test --- test/print_prefix.lean | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/test/print_prefix.lean b/test/print_prefix.lean index 9f742b382a..d7cc920de1 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -133,15 +133,13 @@ testMatchProof._unsafe_rec : (n : Nat) → Fin n → Unit testMatchProof.match_1 : (motive : (x : Nat) → Fin x → Sort u_1) → (x : Nat) → (x_1 : Fin x) → - ((n : Nat) → (isLt : 0 < n) → motive n { val := 0, isLt := isLt }) → - ((as i : Nat) → (h : Nat.succ i < Nat.succ as) → motive (Nat.succ as) { val := Nat.succ i, isLt := h }) → - motive x x_1 + ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → + ((as i : Nat) → (h : Nat.succ i < Nat.succ as) → motive (Nat.succ as) ⟨Nat.succ i, h⟩) → motive x x_1 testMatchProof.match_1._cstage1 : (motive : (x : Nat) → Fin x → Sort u_1) → (x : Nat) → (x_1 : Fin x) → - ((n : Nat) → (isLt : 0 < n) → motive n { val := 0, isLt := isLt }) → - ((as i : Nat) → (h : Nat.succ i < Nat.succ as) → motive (Nat.succ as) { val := Nat.succ i, isLt := h }) → - motive x x_1 + ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → + ((as i : Nat) → (h : Nat.succ i < Nat.succ as) → motive (Nat.succ as) ⟨Nat.succ i, h⟩) → motive x x_1 testMatchProof.proof_1 : ∀ (as i : Nat), Nat.succ i < Nat.succ as → Nat.succ i ≤ as testMatchProof.proof_2 : ∀ (as i : Nat), Nat.succ i < Nat.succ as → Nat.succ i ≤ as -/ From 36473ef8ad6c1311b4aaae5967eeb47e5c2ae905 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Fri, 22 Mar 2024 21:41:41 +1100 Subject: [PATCH 162/213] fix check_imports script --- scripts/check_imports.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/check_imports.lean b/scripts/check_imports.lean index 2023954e45..048981bba0 100644 --- a/scripts/check_imports.lean +++ b/scripts/check_imports.lean @@ -82,7 +82,7 @@ def checkMissingImports (modName : Name) (modData : ModuleData) (reqImports : Ar def checkStdDataDir (modMap : HashMap Name ModuleData) (entry : IO.FS.DirEntry) (autofix : Bool := false) : LogIO Unit := do - let moduleName := `Std.Data ++ entry.fileName + let moduleName := `Std.Data ++ .mkSimple entry.fileName let requiredImports ← addModulesIn (recurse := true) #[] (root := moduleName) entry.path let .some module := modMap.find? moduleName | warn true s!"Could not find {moduleName}; Not imported into Std." From 5161bf26603df937885dc2c24e42287b8d5c7733 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 23 Mar 2024 09:14:26 +0000 Subject: [PATCH 163/213] chore: bump to nightly-2024-03-23 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index a6f89805e1..eadba7cd5e 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-22 +leanprover/lean4:nightly-2024-03-23 From 96a5ca9a39f64659184a3c145fe658c9af0ee602 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sun, 24 Mar 2024 09:14:00 +1100 Subject: [PATCH 164/213] fix test --- test/print_prefix.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/print_prefix.lean b/test/print_prefix.lean index d7cc920de1..a506e926c6 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -134,14 +134,14 @@ testMatchProof.match_1 : (motive : (x : Nat) → Fin x → Sort u_1) → (x : Nat) → (x_1 : Fin x) → ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → - ((as i : Nat) → (h : Nat.succ i < Nat.succ as) → motive (Nat.succ as) ⟨Nat.succ i, h⟩) → motive x x_1 + ((as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) → motive x x_1 testMatchProof.match_1._cstage1 : (motive : (x : Nat) → Fin x → Sort u_1) → (x : Nat) → (x_1 : Fin x) → ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → - ((as i : Nat) → (h : Nat.succ i < Nat.succ as) → motive (Nat.succ as) ⟨Nat.succ i, h⟩) → motive x x_1 -testMatchProof.proof_1 : ∀ (as i : Nat), Nat.succ i < Nat.succ as → Nat.succ i ≤ as -testMatchProof.proof_2 : ∀ (as i : Nat), Nat.succ i < Nat.succ as → Nat.succ i ≤ as + ((as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) → motive x x_1 +testMatchProof.proof_1 : ∀ (as i : Nat), i.succ < as.succ → i.succ ≤ as +testMatchProof.proof_2 : ∀ (as i : Nat), i.succ < as.succ → i.succ ≤ as -/ #guard_msgs in #print prefix (config:={internals:=true}) testMatchProof From 9a1aa2d8ffd6f8b96948345d21dcfb1dac8789ab Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sun, 24 Mar 2024 09:15:33 +0000 Subject: [PATCH 165/213] chore: bump to nightly-2024-03-24 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index eadba7cd5e..ca08d93846 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-23 +leanprover/lean4:nightly-2024-03-24 From 2e31efe2f1d57a0ad616f54e0220b7a6e4cde48c Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 25 Mar 2024 09:15:15 +0000 Subject: [PATCH 166/213] chore: bump to nightly-2024-03-25 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index ca08d93846..f55067a5b4 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-24 +leanprover/lean4:nightly-2024-03-25 From f9dbfb5e057b18ae588202e945d17826fc929e92 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 26 Mar 2024 19:15:06 +1100 Subject: [PATCH 167/213] bump --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index f55067a5b4..379f4bc3c7 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-25 +leanprover/lean4:nightly-2024-03-26 From e0ab3b19dc0338aec7d5405b476faf8aa89db2ef Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Wed, 27 Mar 2024 09:15:58 +0000 Subject: [PATCH 168/213] chore: bump to nightly-2024-03-27 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 379f4bc3c7..c6306360b3 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-26 +leanprover/lean4:nightly-2024-03-27 From 74f80f5289aef638ef2dd7a10ae683fffba1fb90 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Thu, 28 Mar 2024 09:15:35 +0000 Subject: [PATCH 169/213] chore: bump to nightly-2024-03-28 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index c6306360b3..2f33486949 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-27 +leanprover/lean4:nightly-2024-03-28 From 406fe30baf9887a5cbc9cb3471d6d84fd29bfc52 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Thu, 28 Mar 2024 16:24:29 -0700 Subject: [PATCH 170/213] fix: remove upstreamed defs and fix some proofs --- Std/Data/Array/Lemmas.lean | 24 ++-- Std/Data/List/Basic.lean | 244 ------------------------------------- Std/Data/List/Lemmas.lean | 2 +- 3 files changed, 13 insertions(+), 257 deletions(-) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 199f1a3036..536f5071f4 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -20,12 +20,6 @@ local macro_rules | `($x[$i]'$h) => `(getElem $x $i $h) @[simp] theorem getElem!_fin [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n) [Decidable (Dom a i)] [Inhabited Elem] : a[i]! = a[i.1]! := rfl -theorem getElem?_pos [GetElem Cont Idx Elem Dom] - (a : Cont) (i : Idx) (h : Dom a i) [Decidable (Dom a i)] : a[i]? = a[i] := dif_pos h - -theorem getElem?_neg [GetElem Cont Idx Elem Dom] - (a : Cont) (i : Idx) (h : ¬Dom a i) [Decidable (Dom a i)] : a[i]? = none := dif_neg h - @[simp] theorem mkArray_data (n : Nat) (v : α) : (mkArray n v).data = List.replicate n v := rfl @[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) : @@ -93,13 +87,19 @@ theorem get?_push_eq (a : Array α) (x : α) : (a.push x)[a.size]? = some x := b rw [getElem?_pos, get_push_eq] theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x else a[i]? := by - split - . next heq => rw [heq, getElem?_pos, get_push_eq] - · next hne => + 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?, size_push, g, h1, h2, get_push_lt] + | Or.inr (Or.inl heq) => + simp [heq, getElem?_pos, get_push_eq] + | Or.inr (Or.inr g) => simp only [getElem?, size_push] - split <;> split <;> try simp only [*, get_push_lt] - · next p q => exact Or.elim (Nat.eq_or_lt_of_le (Nat.le_of_lt_succ p)) hne q - · next p q => exact p (Nat.lt.step q) + have h1 : ¬ (i < a.size ) := by omega + have h2 : ¬ (i < a.size + 1) := by omega + have h3 : i ≠ a.size := by omega + simp [h1, h2, h3] @[simp] theorem get?_size {a : Array α} : a[a.size]? = none := by simp only [getElem?, Nat.lt_irrefl, dite_false] diff --git a/Std/Data/List/Basic.lean b/Std/Data/List/Basic.lean index 7774294973..86afb0187b 100644 --- a/Std/Data/List/Basic.lean +++ b/Std/Data/List/Basic.lean @@ -6,250 +6,6 @@ Authors: Leonardo de Moura namespace List -/-! ## Tail recursive implementations for definitions from core -/ - -/-- Tail recursive version of `erase`. -/ -@[inline] def setTR (l : List α) (n : Nat) (a : α) : List α := go l n #[] where - /-- Auxiliary for `setTR`: `setTR.go l a xs n acc = acc.toList ++ set xs a`, - unless `n ≥ l.length` in which case it returns `l` -/ - go : List α → Nat → Array α → List α - | [], _, _ => l - | _::xs, 0, acc => acc.toListAppend (a::xs) - | x::xs, n+1, acc => go xs n (acc.push x) - -@[csimp] theorem set_eq_setTR : @set = @setTR := by - funext α l n a; simp [setTR] - let rec go (acc) : ∀ xs n, l = acc.data ++ xs → - setTR.go l a xs n acc = acc.data ++ xs.set n a - | [], _ => fun h => by simp [setTR.go, set, h] - | x::xs, 0 => by simp [setTR.go, set] - | x::xs, n+1 => fun h => by simp [setTR.go, set]; rw [go _ xs]; {simp}; simp [h] - exact (go #[] _ _ rfl).symm - -/-- Tail recursive version of `erase`. -/ -@[inline] def eraseTR [BEq α] (l : List α) (a : α) : List α := go l #[] where - /-- Auxiliary for `eraseTR`: `eraseTR.go l a xs acc = acc.toList ++ erase xs a`, - unless `a` is not present in which case it returns `l` -/ - go : List α → Array α → List α - | [], _ => l - | x::xs, acc => bif x == a then acc.toListAppend xs else go xs (acc.push x) - -@[csimp] theorem erase_eq_eraseTR : @List.erase = @eraseTR := by - funext α _ l a; simp [eraseTR] - suffices ∀ xs acc, l = acc.data ++ xs → eraseTR.go l a xs acc = acc.data ++ xs.erase a from - (this l #[] (by simp)).symm - intro xs; induction xs with intro acc h - | nil => simp [List.erase, eraseTR.go, h] - | cons x xs IH => - simp [List.erase, eraseTR.go] - cases x == a <;> simp - · rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `eraseIdx`. -/ -@[inline] def eraseIdxTR (l : List α) (n : Nat) : List α := go l n #[] where - /-- Auxiliary for `eraseIdxTR`: `eraseIdxTR.go l n xs acc = acc.toList ++ eraseIdx xs a`, - unless `a` is not present in which case it returns `l` -/ - go : List α → Nat → Array α → List α - | [], _, _ => l - | _::as, 0, acc => acc.toListAppend as - | a::as, n+1, acc => go as n (acc.push a) - -@[csimp] theorem eraseIdx_eq_eraseIdxTR : @eraseIdx = @eraseIdxTR := by - funext α l n; simp [eraseIdxTR] - suffices ∀ xs acc, l = acc.data ++ xs → eraseIdxTR.go l xs n acc = acc.data ++ xs.eraseIdx n from - (this l #[] (by simp)).symm - intro xs; induction xs generalizing n with intro acc h - | nil => simp [eraseIdx, eraseIdxTR.go, h] - | cons x xs IH => - match n with - | 0 => simp [eraseIdx, eraseIdxTR.go] - | n+1 => - simp [eraseIdx, eraseIdxTR.go] - rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `bind`. -/ -@[inline] def bindTR (as : List α) (f : α → List β) : List β := go as #[] where - /-- Auxiliary for `bind`: `bind.go f as = acc.toList ++ bind f as` -/ - @[specialize] go : List α → Array β → List β - | [], acc => acc.toList - | x::xs, acc => go xs (acc ++ f x) - -@[csimp] theorem bind_eq_bindTR : @List.bind = @bindTR := by - funext α β as f - let rec go : ∀ as acc, bindTR.go f as acc = acc.data ++ as.bind f - | [], acc => by simp [bindTR.go, bind] - | x::xs, acc => by simp [bindTR.go, bind, go xs] - exact (go as #[]).symm - -/-- Tail recursive version of `join`. -/ -@[inline] def joinTR (l : List (List α)) : List α := bindTR l id - -@[csimp] theorem join_eq_joinTR : @join = @joinTR := by - funext α l; rw [← List.bind_id, List.bind_eq_bindTR]; rfl - -/-- Tail recursive version of `filterMap`. -/ -@[inline] def filterMapTR (f : α → Option β) (l : List α) : List β := go l #[] where - /-- Auxiliary for `filterMap`: `filterMap.go f l = acc.toList ++ filterMap f l` -/ - @[specialize] go : List α → Array β → List β - | [], acc => acc.toList - | a::as, acc => match f a with - | none => go as acc - | some b => go as (acc.push b) - -@[csimp] theorem filterMap_eq_filterMapTR : @List.filterMap = @filterMapTR := by - funext α β f l - let rec go : ∀ as acc, filterMapTR.go f as acc = acc.data ++ as.filterMap f - | [], acc => by simp [filterMapTR.go, filterMap] - | a::as, acc => by simp [filterMapTR.go, filterMap, go as]; split <;> simp [*] - exact (go l #[]).symm - -/-- Tail recursive version of `replace`. -/ -@[inline] def replaceTR [BEq α] (l : List α) (b c : α) : List α := go l #[] where - /-- Auxiliary for `replace`: `replace.go l b c xs acc = acc.toList ++ replace xs b c`, - unless `b` is not found in `xs` in which case it returns `l`. -/ - @[specialize] go : List α → Array α → List α - | [], _ => l - | a::as, acc => bif a == b then acc.toListAppend (c::as) else go as (acc.push a) - -@[csimp] theorem replace_eq_replaceTR : @List.replace = @replaceTR := by - funext α _ l b c; simp [replaceTR] - suffices ∀ xs acc, l = acc.data ++ xs → - replaceTR.go l b c xs acc = acc.data ++ xs.replace b c from - (this l #[] (by simp)).symm - intro xs; induction xs with intro acc - | nil => simp [replace, replaceTR.go] - | cons x xs IH => - simp [replace, replaceTR.go]; split <;> simp [*] - · intro h; rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `take`. -/ -@[inline] def takeTR (n : Nat) (l : List α) : List α := go l n #[] where - /-- Auxiliary for `take`: `take.go l xs n acc = acc.toList ++ take n xs`, - unless `n ≥ xs.length` in which case it returns `l`. -/ - @[specialize] go : List α → Nat → Array α → List α - | [], _, _ => l - | _::_, 0, acc => acc.toList - | a::as, n+1, acc => go as n (acc.push a) - -@[csimp] theorem take_eq_takeTR : @take = @takeTR := by - funext α n l; simp [takeTR] - suffices ∀ xs acc, l = acc.data ++ xs → takeTR.go l xs n acc = acc.data ++ xs.take n from - (this l #[] (by simp)).symm - intro xs; induction xs generalizing n with intro acc - | nil => cases n <;> simp [take, takeTR.go] - | cons x xs IH => - cases n with simp [take, takeTR.go] - | succ n => intro h; rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `takeWhile`. -/ -@[inline] def takeWhileTR (p : α → Bool) (l : List α) : List α := go l #[] where - /-- Auxiliary for `takeWhile`: `takeWhile.go p l xs acc = acc.toList ++ takeWhile p xs`, - unless no element satisfying `p` is found in `xs` in which case it returns `l`. -/ - @[specialize] go : List α → Array α → List α - | [], _ => l - | a::as, acc => bif p a then go as (acc.push a) else acc.toList - -@[csimp] theorem takeWhile_eq_takeWhileTR : @takeWhile = @takeWhileTR := by - funext α p l; simp [takeWhileTR] - suffices ∀ xs acc, l = acc.data ++ xs → - takeWhileTR.go p l xs acc = acc.data ++ xs.takeWhile p from - (this l #[] (by simp)).symm - intro xs; induction xs with intro acc - | nil => simp [takeWhile, takeWhileTR.go] - | cons x xs IH => - simp [takeWhile, takeWhileTR.go]; split <;> simp [*] - · intro h; rw [IH]; simp; simp; exact h - -/-- Tail recursive version of `foldr`. -/ -@[specialize] def foldrTR (f : α → β → β) (init : β) (l : List α) : β := l.toArray.foldr f init - -@[csimp] theorem foldr_eq_foldrTR : @foldr = @foldrTR := by - funext α β f init l; simp [foldrTR, Array.foldr_eq_foldr_data, -Array.size_toArray] - -/-- Tail recursive version of `zipWith`. -/ -@[inline] def zipWithTR (f : α → β → γ) (as : List α) (bs : List β) : List γ := go as bs #[] where - /-- Auxiliary for `zipWith`: `zipWith.go f as bs acc = acc.toList ++ zipWith f as bs` -/ - go : List α → List β → Array γ → List γ - | a::as, b::bs, acc => go as bs (acc.push (f a b)) - | _, _, acc => acc.toList - -@[csimp] theorem zipWith_eq_zipWithTR : @zipWith = @zipWithTR := by - funext α β γ f as bs - let rec go : ∀ as bs acc, zipWithTR.go f as bs acc = acc.data ++ as.zipWith f bs - | [], _, acc | _::_, [], acc => by simp [zipWithTR.go, zipWith] - | a::as, b::bs, acc => by simp [zipWithTR.go, zipWith, go as bs] - exact (go as bs #[]).symm - -/-- Tail recursive version of `unzip`. -/ -def unzipTR (l : List (α × β)) : List α × List β := - l.foldr (fun (a, b) (al, bl) => (a::al, b::bl)) ([], []) - -@[csimp] theorem unzip_eq_unzipTR : @unzip = @unzipTR := by - funext α β l; simp [unzipTR]; induction l <;> simp [*] - -/-- Tail recursive version of `enumFrom`. -/ -def enumFromTR (n : Nat) (l : List α) : List (Nat × α) := - let arr := l.toArray - (arr.foldr (fun a (n, acc) => (n-1, (n-1, a) :: acc)) (n + arr.size, [])).2 - -@[csimp] theorem enumFrom_eq_enumFromTR : @enumFrom = @enumFromTR := by - funext α n l; simp [enumFromTR, -Array.size_toArray] - let f := fun (a : α) (n, acc) => (n-1, (n-1, a) :: acc) - let rec go : ∀ l n, l.foldr f (n + l.length, []) = (n, enumFrom n l) - | [], n => rfl - | a::as, n => by - rw [← show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as] - simp [enumFrom, f] - rw [Array.foldr_eq_foldr_data] - simp [go] - -theorem replicateTR_loop_eq : ∀ n, replicateTR.loop a n acc = replicate n a ++ acc - | 0 => rfl - | n+1 => by rw [← replicateTR_loop_replicate_eq _ 1 n, replicate, replicate, - replicateTR.loop, replicateTR_loop_eq n, replicateTR_loop_eq n, append_assoc]; rfl - -/-- Tail recursive version of `dropLast`. -/ -@[inline] def dropLastTR (l : List α) : List α := l.toArray.pop.toList - -@[csimp] theorem dropLast_eq_dropLastTR : @dropLast = @dropLastTR := by - funext α l; simp [dropLastTR] - -/-- Tail recursive version of `intersperse`. -/ -def intersperseTR (sep : α) : List α → List α - | [] => [] - | [x] => [x] - | x::y::xs => x :: sep :: y :: xs.foldr (fun a r => sep :: a :: r) [] - -@[csimp] theorem intersperse_eq_intersperseTR : @intersperse = @intersperseTR := by - funext α sep l; simp [intersperseTR] - match l with - | [] | [_] => rfl - | x::y::xs => simp [intersperse]; induction xs generalizing y <;> simp [*] - -/-- Tail recursive version of `intercalate`. -/ -def intercalateTR (sep : List α) : List (List α) → List α - | [] => [] - | [x] => x - | x::xs => go sep.toArray x xs #[] -where - /-- Auxiliary for `intercalateTR`: - `intercalateTR.go sep x xs acc = acc.toList ++ intercalate sep.toList (x::xs)` -/ - go (sep : Array α) : List α → List (List α) → Array α → List α - | x, [], acc => acc.toListAppend x - | x, y::xs, acc => go sep y xs (acc ++ x ++ sep) - -@[csimp] theorem intercalate_eq_intercalateTR : @intercalate = @intercalateTR := by - funext α sep l; simp [intercalate, intercalateTR] - match l with - | [] => rfl - | [_] => simp - | x::y::xs => - let rec go {acc x} : ∀ xs, - intercalateTR.go sep.toArray x xs acc = acc.data ++ join (intersperse sep (x::xs)) - | [] => by simp [intercalateTR.go] - | _::_ => by simp [intercalateTR.go, go] - simp [intersperse, go] - /-! ## New definitions -/ /-- diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 4c80ce5e1d..da5a56601b 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -754,7 +754,7 @@ theorem get?_zero (l : List α) : l.get? 0 = l.head? := by cases l <;> rfl @[simp] theorem getElem_eq_get (l : List α) (i : Nat) (h) : l[i]'h = l.get ⟨i, h⟩ := rfl @[simp] theorem getElem?_eq_get? (l : List α) (i : Nat) : l[i]? = l.get? i := by - unfold getElem?; split + simp only [getElem?]; split · exact (get?_eq_get ‹_›).symm · exact (get?_eq_none.2 <| Nat.not_lt.1 ‹_›).symm From 1c9e0fb121384f9ea89c54295301556082370256 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 29 Mar 2024 09:14:31 +0000 Subject: [PATCH 171/213] chore: bump to nightly-2024-03-29 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 2f33486949..7268b6fc68 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-28 +leanprover/lean4:nightly-2024-03-29 From aec0741522b0a23f1ed7051a936cf43f76a907ae Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 30 Mar 2024 09:13:18 +0000 Subject: [PATCH 172/213] chore: bump to nightly-2024-03-30 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 7268b6fc68..ba450671c4 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-29 +leanprover/lean4:nightly-2024-03-30 From 06f06f9267718090265dd1e38c0bbe0300dc2db5 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 1 Apr 2024 09:16:56 +0000 Subject: [PATCH 173/213] chore: bump to nightly-2024-04-01 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index ba450671c4..4610193327 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-03-30 +leanprover/lean4:nightly-2024-04-01 From fac121c5b5b97f61c0bea495105e3da41eebd8a4 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Tue, 2 Apr 2024 09:15:46 +0000 Subject: [PATCH 174/213] chore: bump to nightly-2024-04-02 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 4610193327..39301b0434 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-01 +leanprover/lean4:nightly-2024-04-02 From 0af134abc3d7433de13467d9dc4281e155c1fbfd Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 2 Apr 2024 20:25:54 +1100 Subject: [PATCH 175/213] fixes --- Std/Lean/PersistentHashMap.lean | 6 ------ Std/Tactic/SqueezeScope.lean | 2 +- 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/Std/Lean/PersistentHashMap.lean b/Std/Lean/PersistentHashMap.lean index 4122f193b4..5054e15758 100644 --- a/Std/Lean/PersistentHashMap.lean +++ b/Std/Lean/PersistentHashMap.lean @@ -19,12 +19,6 @@ def insert' (m : PersistentHashMap α β) (a : α) (b : β) : PersistentHashMap let m := m.insert a b (m, m.size == oldSize) -/-- -Turns a `PersistentHashMap` into an array of key-value pairs. --/ -def toArray (m : PersistentHashMap α β) : Array (α × β) := - m.foldl (init := Array.mkEmpty m.size) fun xs k v => xs.push (k, v) - /-- Builds a `PersistentHashMap` from a list of key-value pairs. Values of duplicated keys are replaced by their respective last occurrences. diff --git a/Std/Tactic/SqueezeScope.lean b/Std/Tactic/SqueezeScope.lean index 39fad08cfc..cfb0476a57 100644 --- a/Std/Tactic/SqueezeScope.lean +++ b/Std/Tactic/SqueezeScope.lean @@ -85,7 +85,7 @@ elab_rules : tactic throw e if let some new := new then for (_, stx, usedSimps) in new do - let usedSimps := usedSimps.foldl (fun s usedSimps => usedSimps.fold .insert s) {} + let usedSimps := usedSimps.foldl (fun s usedSimps => usedSimps.foldl .insert s) {} let stx' ← mkSimpCallStx stx usedSimps TryThis.addSuggestion stx[0] stx' (origSpan? := stx) From 8ac01e7a007d637647af9350b39f6ba6b8cdb2bf Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Wed, 3 Apr 2024 09:15:52 +0000 Subject: [PATCH 176/213] chore: bump to nightly-2024-04-03 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 39301b0434..430ebaa8ea 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-02 +leanprover/lean4:nightly-2024-04-03 From e0eb3090ec2e5044c92e9bba9c269c91375f8d5e Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Thu, 4 Apr 2024 09:15:41 +0000 Subject: [PATCH 177/213] chore: bump to nightly-2024-04-04 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 430ebaa8ea..a6455ebdf6 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-03 +leanprover/lean4:nightly-2024-04-04 From 4d33b75d6944068d84f27cd43942deb75471724a Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 5 Apr 2024 09:14:50 +0000 Subject: [PATCH 178/213] chore: bump to nightly-2024-04-05 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index a6455ebdf6..7db3fefa0f 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-04 +leanprover/lean4:nightly-2024-04-05 From 956e5c6c4f7b43f6468d90374dede5cf8fc89387 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Fri, 29 Mar 2024 14:51:55 -0700 Subject: [PATCH 179/213] wip: list migration --- Std/Data/List/Count.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/Std/Data/List/Count.lean b/Std/Data/List/Count.lean index 4458c457dc..6611d032f6 100644 --- a/Std/Data/List/Count.lean +++ b/Std/Data/List/Count.lean @@ -116,7 +116,6 @@ theorem countP_mono_left (h : ∀ x ∈ l, p x → q x) : countP p l ≤ countP apply Nat.le_trans ?_ (Nat.le_add_right _ _) apply ihl hl . simp [ha h] - apply Nat.succ_le_succ apply ihl hl theorem countP_congr (h : ∀ x ∈ l, p x ↔ q x) : countP p l = countP q l := From f47b0fbad62f1ffeb1f39bb85cbe4d763e86d7fd Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sun, 7 Apr 2024 09:14:32 +0000 Subject: [PATCH 180/213] chore: bump to nightly-2024-04-07 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 7db3fefa0f..be51c72f93 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-05 +leanprover/lean4:nightly-2024-04-07 From 7514475571b81a3957e06555b968a099e658ec0d Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 8 Apr 2024 09:16:19 +0000 Subject: [PATCH 181/213] chore: bump to nightly-2024-04-08 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index be51c72f93..518ef00b94 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-07 +leanprover/lean4:nightly-2024-04-08 From 324d76c9d226ae84d37a66ad203dcd3bf417dc84 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Tue, 9 Apr 2024 09:16:00 +0000 Subject: [PATCH 182/213] chore: bump to nightly-2024-04-09 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 518ef00b94..16b2110185 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-08 +leanprover/lean4:nightly-2024-04-09 From 1352583e15fe7a6480eff3b856c1628064d3a453 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Thu, 11 Apr 2024 09:16:05 +0000 Subject: [PATCH 183/213] chore: bump to nightly-2024-04-11 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 16b2110185..ebbf7a5930 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-09 +leanprover/lean4:nightly-2024-04-11 From e9b95dc6dbfaf37a78d0cb41290dc87301462d19 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 12 Apr 2024 09:16:06 +0000 Subject: [PATCH 184/213] chore: bump to nightly-2024-04-12 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index ebbf7a5930..b12b17b955 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-11 +leanprover/lean4:nightly-2024-04-12 From e6a371f1e787048ff023514ac2fa5257b982fcf8 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 13 Apr 2024 09:12:11 +0000 Subject: [PATCH 185/213] chore: bump to nightly-2024-04-13 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index b12b17b955..7053a5b266 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-12 +leanprover/lean4:nightly-2024-04-13 From ea64e2bf3e04e9df1d7f7eed07163a4dc2da43b5 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sun, 14 Apr 2024 11:22:19 +0000 Subject: [PATCH 186/213] chore: bump to nightly-2024-04-14 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 7053a5b266..a34b780847 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-13 +leanprover/lean4:nightly-2024-04-14 From 6fd186cfe079d52c9ffb761f56033e030672a610 Mon Sep 17 00:00:00 2001 From: Kyle Miller Date: Sun, 14 Apr 2024 11:21:16 -0700 Subject: [PATCH 187/213] fix: for lean4#3851 (#741) --- Std/Data/Array/Basic.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Std/Data/Array/Basic.lean b/Std/Data/Array/Basic.lean index f1a940ae75..d0c937f1a9 100644 --- a/Std/Data/Array/Basic.lean +++ b/Std/Data/Array/Basic.lean @@ -161,11 +161,11 @@ namespace Subarray The empty subarray. -/ protected def empty : Subarray α where - as := #[] + array := #[] start := 0 stop := 0 - h₁ := Nat.le_refl 0 - h₂ := Nat.le_refl 0 + start_le_stop := Nat.le_refl 0 + stop_le_array_size := Nat.le_refl 0 instance : EmptyCollection (Subarray α) := ⟨Subarray.empty⟩ @@ -198,7 +198,7 @@ def popHead? (as : Subarray α) : Option (α × Subarray α) := let tail := { as with start := as.start + 1 - h₁ := Nat.le_of_lt_succ $ Nat.succ_lt_succ h } + start_le_stop := Nat.le_of_lt_succ $ Nat.succ_lt_succ h } some (head, tail) else none From 7022446d4bf5443d9b26daf4cc10fb6b551ff798 Mon Sep 17 00:00:00 2001 From: Kyle Miller Date: Sun, 14 Apr 2024 11:30:03 -0700 Subject: [PATCH 188/213] fix: for std4#727 interacting with lean4#3625 The signature pretty printer changed, so the test needed to be updated. --- test/print_prefix.lean | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/test/print_prefix.lean b/test/print_prefix.lean index 857515a9f8..7b9cdaada3 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -53,10 +53,10 @@ TestStruct.casesOn.{u} {motive : TestStruct → Sort u} (t : TestStruct) (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) : motive t TestStruct.foo (self : TestStruct) : Int TestStruct.mk (foo bar : Int) : TestStruct -TestStruct.mk.inj {foo bar foo bar : Int} (x✝ : { foo := foo, bar := bar } = { foo := foo, bar := bar }) : - foo = foo ∧ bar = bar -TestStruct.mk.injEq (foo bar foo bar : Int) : - ({ foo := foo, bar := bar } = { foo := foo, bar := bar }) = (foo = foo ∧ bar = bar) +TestStruct.mk.inj {foo bar : Int} : + ∀ {foo_1 bar_1 : Int}, { foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 } → foo = foo_1 ∧ bar = bar_1 +TestStruct.mk.injEq (foo bar : Int) : + ∀ (foo_1 bar_1 : Int), ({ foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 }) = (foo = foo_1 ∧ bar = bar_1) TestStruct.mk.sizeOf_spec (foo bar : Int) : sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar TestStruct.noConfusion.{u} {P : Sort u} {v1 v2 : TestStruct} (h12 : v1 = v2) : TestStruct.noConfusionType P v1 v2 TestStruct.noConfusionType.{u} (P : Sort u) (v1 v2 : TestStruct) : Sort u @@ -86,10 +86,10 @@ TestStruct.recOn.{u} {motive : TestStruct → Sort u} (t : TestStruct) #print prefix (config := {propositions := false}) TestStruct /-- -info: TestStruct.mk.inj {foo bar foo bar : Int} (x✝ : { foo := foo, bar := bar } = { foo := foo, bar := bar }) : - foo = foo ∧ bar = bar -TestStruct.mk.injEq (foo bar foo bar : Int) : - ({ foo := foo, bar := bar } = { foo := foo, bar := bar }) = (foo = foo ∧ bar = bar) +info: TestStruct.mk.inj {foo bar : Int} : + ∀ {foo_1 bar_1 : Int}, { foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 } → foo = foo_1 ∧ bar = bar_1 +TestStruct.mk.injEq (foo bar : Int) : + ∀ (foo_1 bar_1 : Int), ({ foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 }) = (foo = foo_1 ∧ bar = bar_1) TestStruct.mk.sizeOf_spec (foo bar : Int) : sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar -/ #guard_msgs in @@ -124,28 +124,28 @@ def testMatchProof : (n : Nat) → Fin n → Unit | _, ⟨0, _⟩ => () | Nat.succ as, ⟨Nat.succ i, h⟩ => testMatchProof as ⟨i, Nat.le_of_succ_le_succ h⟩ -/-- info: testMatchProof (n : Nat) (a✝ : Fin n) : Unit -/ +/-- info: testMatchProof (n : Nat) : Fin n → Unit -/ #guard_msgs in #print prefix testMatchProof /-- -info: testMatchProof : (n : Nat) → Fin n → Unit -testMatchProof._cstage1 : (n : Nat) → Fin n → Unit +info: testMatchProof (n : Nat) : Fin n → Unit +testMatchProof._cstage1 (n : Nat) : Fin n → Unit testMatchProof._cstage2 : _obj → _obj → _obj -testMatchProof._sunfold : (n : Nat) → Fin n → Unit -testMatchProof._unsafe_rec : (n : Nat) → Fin n → Unit -testMatchProof.match_1 : (motive : (x : Nat) → Fin x → Sort u_1) → +testMatchProof._sunfold (n : Nat) : Fin n → Unit +testMatchProof._unsafe_rec (n : Nat) : Fin n → Unit +testMatchProof.match_1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) : (x : Nat) → (x_1 : Fin x) → ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → ((as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) → motive x x_1 -testMatchProof.match_1._cstage1 : (motive : (x : Nat) → Fin x → Sort u_1) → +testMatchProof.match_1._cstage1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) : (x : Nat) → (x_1 : Fin x) → ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → ((as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) → motive x x_1 -testMatchProof.proof_1 : ∀ (as i : Nat), i.succ < as.succ → i.succ ≤ as -testMatchProof.proof_2 : ∀ (as i : Nat), i.succ < as.succ → i.succ ≤ as +testMatchProof.proof_1 (as i : Nat) (h : i.succ < as.succ) : i.succ ≤ as +testMatchProof.proof_2 (as i : Nat) (h : i.succ < as.succ) : i.succ ≤ as -/ #guard_msgs in #print prefix (config := {internals := true}) testMatchProof @@ -168,7 +168,7 @@ TestInd.rec.{u} {motive : TestInd → Sort u} (foo : motive TestInd.foo) (bar : motive t TestInd.recOn.{u} {motive : TestInd → Sort u} (t : TestInd) (foo : motive TestInd.foo) (bar : motive TestInd.bar) : motive t -TestInd.toCtorIdx (x✝ : TestInd) : Nat +TestInd.toCtorIdx : TestInd → Nat -/ #guard_msgs in #print prefix TestInd From fba4f4a13af1efff96c554a16aa4ba7b697b6bd7 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 15 Apr 2024 16:21:09 +1000 Subject: [PATCH 189/213] update to #734 --- Std/Tactic/ShowUnused.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Std/Tactic/ShowUnused.lean b/Std/Tactic/ShowUnused.lean index bc75663478..9efc6b7673 100644 --- a/Std/Tactic/ShowUnused.lean +++ b/Std/Tactic/ShowUnused.lean @@ -16,7 +16,7 @@ both in the message on `#show_unused`, as well as on the declarations themselves -/ namespace Std.Tactic.ShowUnused -open Lean +open Lean Elab Command variable (env : Environment) in private partial def visit (n : Name) : StateM NameSet Unit := do @@ -46,7 +46,7 @@ def bar := foo ``` -/ elab tk:"#show_unused" ids:(ppSpace colGt ident)* : command => do - let ns ← ids.mapM Elab.resolveGlobalConstNoOverloadWithInfo + let ns ← ids.mapM fun s => liftCoreM <| realizeGlobalConstNoOverloadWithInfo s let env ← getEnv let decls := env.constants.map₂.foldl (fun m n _ => m.insert n) {} let mut unused := #[] From f032d36b099bb63d3fa72eca0cee394bba6ee516 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Tue, 16 Apr 2024 09:04:56 +0000 Subject: [PATCH 190/213] chore: bump to nightly-2024-04-16 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index a34b780847..9e0fede34e 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-14 +leanprover/lean4:nightly-2024-04-16 From 92a9edabd60c57b7652d3237cfcd146190089cd4 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 17 Apr 2024 16:59:44 +1000 Subject: [PATCH 191/213] fix --- Std/Data/Array/Lemmas.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index cb017deaab..59f779831e 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Gabriel Ebner -/ +import Std.Data.List.Init.Lemmas import Std.Data.List.Lemmas import Std.Data.Array.Init.Lemmas import Std.Data.Array.Basic From d9fed9f6d8d15df2aca4d649579fe9b8c2c18a8a Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Wed, 17 Apr 2024 09:05:11 +0000 Subject: [PATCH 192/213] chore: bump to nightly-2024-04-17 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 9e0fede34e..2d7b40ae05 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-16 +leanprover/lean4:nightly-2024-04-17 From 1ace58637d8c35b0b4abd4207185a6810750d7bf Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 18 Apr 2024 10:15:46 +1000 Subject: [PATCH 193/213] fix imports --- Std/Data/List/Lemmas.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index f0d2e3e432..ff6edcc135 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M -/ import Std.Control.ForInStep.Lemmas import Std.Data.Nat.Basic +import Std.Data.List.Init.Lemmas import Std.Data.List.Basic import Std.Tactic.Init import Std.Tactic.Alias From e2e923c018820646260df23961a481172d1cc720 Mon Sep 17 00:00:00 2001 From: Markus Himmel Date: Thu, 18 Apr 2024 03:42:47 +0200 Subject: [PATCH 194/213] fix: Data.List.Lemmas shoud import Data.List.Init.Lemmas on nightly-testing (#746) --- Std/Data/Array/Lemmas.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index 59f779831e..cb017deaab 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Gabriel Ebner -/ -import Std.Data.List.Init.Lemmas import Std.Data.List.Lemmas import Std.Data.Array.Init.Lemmas import Std.Data.Array.Basic From 6b9dbead934c7cf8988804c33bf36ea0d2d773a5 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Thu, 18 Apr 2024 12:13:17 +1000 Subject: [PATCH 195/213] fix --- Std/Data/String/Lemmas.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Std/Data/String/Lemmas.lean b/Std/Data/String/Lemmas.lean index 65e7eaf1f8..0bd703baa7 100644 --- a/Std/Data/String/Lemmas.lean +++ b/Std/Data/String/Lemmas.lean @@ -33,7 +33,7 @@ theorem ext_iff {s₁ s₂ : String} : s₁ = s₂ ↔ s₁.data = s₂.data := rfl @[simp] theorem length_pushn (c : Char) (n : Nat) : (pushn s c n).length = s.length + n := by - unfold pushn; induction n <;> simp [Nat.repeat, Nat.add_succ, *] + unfold pushn; induction n <;> simp [Nat.repeat, Nat.add_assoc, *] @[simp] theorem length_append (s t : String) : (s ++ t).length = s.length + t.length := by simp only [length, append, List.length_append] From c0de883fb1eaa3b76ae4ea1f8eb7654122567b61 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 19 Apr 2024 09:04:54 +0000 Subject: [PATCH 196/213] chore: bump to nightly-2024-04-19 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 2d7b40ae05..c4046b46ed 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-17 +leanprover/lean4:nightly-2024-04-19 From 9ed83a2bdbf7ab0a14434f0c2e56856691ddcc7c Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 19 Apr 2024 10:01:03 +0000 Subject: [PATCH 197/213] Update lean-toolchain for testing https://github.com/leanprover/lean4/pull/3951 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 2d7b40ae05..ebf5fc0f62 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-17 +leanprover/lean4-pr-releases:pr-release-3951 From 6742a139e1bf8705d4b97550c3fe99418275c7e3 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 19 Apr 2024 10:23:45 +0000 Subject: [PATCH 198/213] Trigger CI for https://github.com/leanprover/lean4/pull/3951 From 0ac6b68532fd8cac7dfffd73124bf110ee19d7f7 Mon Sep 17 00:00:00 2001 From: Joachim Breitner Date: Fri, 19 Apr 2024 12:35:09 +0200 Subject: [PATCH 199/213] Avoid MessageData.isEmpty in printPrefix --- Std/Tactic/PrintPrefix.lean | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/Std/Tactic/PrintPrefix.lean b/Std/Tactic/PrintPrefix.lean index ca757c8e15..b342b38b12 100644 --- a/Std/Tactic/PrintPrefix.lean +++ b/Std/Tactic/PrintPrefix.lean @@ -73,12 +73,11 @@ private def lexNameLt : Name -> Name -> Bool | .str _ _, .num _ _ => false | .str p m, .str q n => m < n || m == n && lexNameLt p q -private def appendMatchingConstants (msg : MessageData) (opts : PrintPrefixConfig) (pre : Name) - : MetaM MessageData := do +private def matchingConstants (opts : PrintPrefixConfig) (pre : Name) + : MetaM (Array MessageData) := do let cinfos ← getMatchingConstants (matchName opts pre) opts.imported let cinfos := cinfos.qsort fun p q => lexNameLt (reverseName p.name) (reverseName q.name) - let mut msg := msg - let ppInfo cinfo : MetaM MessageData := do + cinfos.mapM fun cinfo => do if opts.showTypes then pure <| .ofPPFormat { pp := fun | some ctx => ctx.runMetaM <| @@ -87,9 +86,6 @@ private def appendMatchingConstants (msg : MessageData) (opts : PrintPrefixConfi } ++ "\n" else pure m!"{ppConst (← mkConstWithLevelParams cinfo.name)}\n" - for cinfo in cinfos do - msg := msg ++ (← ppInfo cinfo) - pure msg /-- The command `#print prefix foo` will print all definitions that start with @@ -122,9 +118,8 @@ elab (name := printPrefix) "#print" tk:"prefix" cfg:(Lean.Parser.Tactic.config)? name:ident : command => liftTermElabM do let nameId := name.getId let opts ← elabPrintPrefixConfig (mkOptionalNode cfg) - let mut msg ← appendMatchingConstants "" opts nameId - if msg.isEmpty then + let mut msgs ← matchingConstants opts nameId + if msgs.isEmpty then if let [name] ← resolveGlobalConst name then - msg ← appendMatchingConstants msg opts name - if !msg.isEmpty then - logInfoAt tk msg + msgs ← matchingConstants opts name + logInfoAt tk (.joinSep msgs.toList "") From 2101c899839ff7abd7edbd668bd07e6482189a3c Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Fri, 19 Apr 2024 12:53:38 +0000 Subject: [PATCH 200/213] Trigger CI for https://github.com/leanprover/lean4/pull/3951 From b7b1a63d47187fb55f50987857c0e316bf42f332 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 20 Apr 2024 17:38:15 +1000 Subject: [PATCH 201/213] fix test --- test/simpa.lean | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/test/simpa.lean b/test/simpa.lean index 0c2d7c6aea..9528b26382 100644 --- a/test/simpa.lean +++ b/test/simpa.lean @@ -14,12 +14,18 @@ def foo (n : α) := [n] section unnecessarySimpa -/-- warning: try 'simp' instead of 'simpa' [linter.unnecessarySimpa] -/ +/-- +warning: try 'simp' instead of 'simpa' +note: this linter can be disabled with `set_option linter.unnecessarySimpa false` +-/ #guard_msgs in example : foo n = [n] := by simpa only [foo] -/-- warning: try 'simp at h' instead of 'simpa using h' [linter.unnecessarySimpa] -/ +/-- +warning: try 'simp at h' instead of 'simpa using h' +note: this linter can be disabled with `set_option linter.unnecessarySimpa false` +-/ #guard_msgs in example (h : foo n ≠ [n]) : False := by simpa [foo] using h From 3db0ad2bb349f2b6d7c8ba03acaf5a8f1444f4e1 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 20 Apr 2024 17:38:30 +1000 Subject: [PATCH 202/213] fix test --- test/case.lean | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/test/case.lean b/test/case.lean index ab0b664218..2c0c5ff552 100644 --- a/test/case.lean +++ b/test/case.lean @@ -183,11 +183,14 @@ example : True ∧ ∀ x : Nat, x = x := by -- Test focusing by full match, suffix match, and prefix match /-- -warning: unused variable `x` [linter.unusedVariables] +warning: unused variable `x` +note: this linter can be disabled with `set_option linter.unusedVariables false` --- -warning: unused variable `y` [linter.unusedVariables] +warning: unused variable `y` +note: this linter can be disabled with `set_option linter.unusedVariables false` --- -warning: unused variable `z` [linter.unusedVariables] +warning: unused variable `z` +note: this linter can be disabled with `set_option linter.unusedVariables false` -/ #guard_msgs in example : True := by From fa755eb94adc8721361ec1eb4ddaf9b2fdd42e06 Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Sat, 20 Apr 2024 17:39:06 +1000 Subject: [PATCH 203/213] fix tests --- test/lintTC.lean | 5 ++++- test/lint_unreachableTactic.lean | 5 ++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/test/lintTC.lean b/test/lintTC.lean index deee02378c..74d8f861b1 100644 --- a/test/lintTC.lean +++ b/test/lintTC.lean @@ -5,7 +5,10 @@ open Std.Tactic.Lint namespace A -/-- warning: unused variable `β` [linter.unusedVariables] -/ +/-- +warning: unused variable `β` +note: this linter can be disabled with `set_option linter.unusedVariables false` +-/ #guard_msgs in local instance impossible {α β : Type} [Inhabited α] : Nonempty α := ⟨default⟩ diff --git a/test/lint_unreachableTactic.lean b/test/lint_unreachableTactic.lean index 86938a12f9..ec10da4a3a 100644 --- a/test/lint_unreachableTactic.lean +++ b/test/lint_unreachableTactic.lean @@ -1,6 +1,9 @@ import Std.Linter.UnreachableTactic -/-- warning: this tactic is never executed [linter.unreachableTactic] -/ +/-- +warning: this tactic is never executed +note: this linter can be disabled with `set_option linter.unreachableTactic false` +-/ #guard_msgs in example : 1 = 1 := by rfl <;> simp From 51b853dc7a1b51ca1719d610bb400b08f45238e3 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sat, 20 Apr 2024 09:04:47 +0000 Subject: [PATCH 204/213] chore: bump to nightly-2024-04-20 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index c4046b46ed..98a9ab2c0c 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-19 +leanprover/lean4:nightly-2024-04-20 From 46d1879de7bf6ab1f3561f8d232d038055f2f86d Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Sun, 21 Apr 2024 09:04:44 +0000 Subject: [PATCH 205/213] chore: bump to nightly-2024-04-21 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 98a9ab2c0c..56bf95b8c1 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-20 +leanprover/lean4:nightly-2024-04-21 From 48e361941ab4e6e4847ed68430c09f27877d090c Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 22 Apr 2024 09:52:22 +1000 Subject: [PATCH 206/213] fix --- Std/Data/UInt.lean | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index d94c11ae26..cd22ff48f2 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -13,14 +13,11 @@ Authors: François G. Dorais theorem UInt8.toNat_lt (x : UInt8) : x.toNat < 2 ^ 8 := x.val.isLt -@[simp] theorem UInt8.toUInt16_toNat (x : UInt8) : x.toUInt16.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt8.toUInt16_toNat (x : UInt8) : x.toUInt16.toNat = x.toNat := rfl -@[simp] theorem UInt8.toUInt32_toNat (x : UInt8) : x.toUInt32.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt8.toUInt32_toNat (x : UInt8) : x.toUInt32.toNat = x.toNat := rfl -@[simp] theorem UInt8.toUInt64_toNat (x : UInt8) : x.toUInt64.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt8.toUInt64_toNat (x : UInt8) : x.toUInt64.toNat = x.toNat := rfl /-! ### UInt16 -/ @@ -33,11 +30,9 @@ theorem UInt16.toNat_lt (x : UInt16) : x.toNat < 2 ^ 16 := x.val.isLt @[simp] theorem UInt16.toUInt8_toNat (x : UInt16) : x.toUInt8.toNat = x.toNat % 2 ^ 8 := rfl -@[simp] theorem UInt16.toUInt32_toNat (x : UInt16) : x.toUInt32.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt16.toUInt32_toNat (x : UInt16) : x.toUInt32.toNat = x.toNat := rfl -@[simp] theorem UInt16.toUInt64_toNat (x : UInt16) : x.toUInt64.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt16.toUInt64_toNat (x : UInt16) : x.toUInt64.toNat = x.toNat := rfl /-! ### UInt32 -/ @@ -97,5 +92,4 @@ theorem USize.toNat_lt (x : USize) : x.toNat < 2 ^ System.Platform.numBits := by @[simp] theorem USize.toUInt64_toNat (x : USize) : x.toUInt64.toNat = x.toNat := by simp only [USize.toUInt64, UInt64.toNat]; rfl -@[simp] theorem UInt32.toUSize_toNat (x : UInt32) : x.toUSize.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt USize.le_size) +@[simp] theorem UInt32.toUSize_toNat (x : UInt32) : x.toUSize.toNat = x.toNat := rfl From d90cfcd9cb889f7ea4d335026d869ee4c990f21e Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 22 Apr 2024 09:54:18 +1000 Subject: [PATCH 207/213] rest --- Std/Data/UInt.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Std/Data/UInt.lean b/Std/Data/UInt.lean index cd22ff48f2..a2f422f1a4 100644 --- a/Std/Data/UInt.lean +++ b/Std/Data/UInt.lean @@ -47,8 +47,7 @@ theorem UInt32.toNat_lt (x : UInt32) : x.toNat < 2 ^ 32 := x.val.isLt @[simp] theorem UInt32.toUInt16_toNat (x : UInt32) : x.toUInt16.toNat = x.toNat % 2 ^ 16 := rfl -@[simp] theorem UInt32.toUInt64_toNat (x : UInt32) : x.toUInt64.toNat = x.toNat := - Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.toNat_lt (by decide)) +@[simp] theorem UInt32.toUInt64_toNat (x : UInt32) : x.toUInt64.toNat = x.toNat := rfl /-! ### UInt64 -/ From 925794abfb1ccb2c973560a1e41d8d8c3c0f49b8 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Mon, 22 Apr 2024 09:05:13 +0000 Subject: [PATCH 208/213] chore: bump to nightly-2024-04-22 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index 56bf95b8c1..b96d89db4d 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-21 +leanprover/lean4:nightly-2024-04-22 From 9913768eaebd975b356614aaa389ba346b6c140d Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Mon, 22 Apr 2024 20:50:59 +1000 Subject: [PATCH 209/213] fix test --- test/print_prefix.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/test/print_prefix.lean b/test/print_prefix.lean index 7b9cdaada3..6677469882 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -12,8 +12,7 @@ TEmpty.recOn.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t #guard_msgs in #print prefix TEmpty -- Test type that probably won't change much. -/-- --/ +/-- info: -/ #guard_msgs in #print prefix (config := {imported := false}) Empty From aefb007b09fb74fe5e887bcf5521609208379c0d Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 23 Apr 2024 10:35:58 +1000 Subject: [PATCH 210/213] cleanup imports in Data/Array --- Std/Data/Array/Lemmas.lean | 1 - Std/Data/ByteArray.lean | 1 + Std/Data/List/Lemmas.lean | 1 - Std/Data/List/Perm.lean | 2 -- 4 files changed, 1 insertion(+), 4 deletions(-) diff --git a/Std/Data/Array/Lemmas.lean b/Std/Data/Array/Lemmas.lean index cb017deaab..f96220a4b1 100644 --- a/Std/Data/Array/Lemmas.lean +++ b/Std/Data/Array/Lemmas.lean @@ -5,7 +5,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Gabriel Ebner -/ import Std.Data.List.Lemmas -import Std.Data.Array.Init.Lemmas import Std.Data.Array.Basic import Std.Tactic.SeqFocus import Std.Util.ProofWanted diff --git a/Std/Data/ByteArray.lean b/Std/Data/ByteArray.lean index 1a6d6b5df2..dcee0d4948 100644 --- a/Std/Data/ByteArray.lean +++ b/Std/Data/ByteArray.lean @@ -3,6 +3,7 @@ Copyright (c) 2023 François G. Dorais. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: François G. Dorais -/ +import Std.Data.Array.Init.Lemmas import Std.Data.Array.Lemmas namespace ByteArray diff --git a/Std/Data/List/Lemmas.lean b/Std/Data/List/Lemmas.lean index 9a032f99b3..545fd8f769 100644 --- a/Std/Data/List/Lemmas.lean +++ b/Std/Data/List/Lemmas.lean @@ -4,7 +4,6 @@ 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 -/ import Std.Control.ForInStep.Lemmas -import Std.Data.Nat.Basic import Std.Data.List.Init.Lemmas import Std.Data.List.Basic import Std.Tactic.Init diff --git a/Std/Data/List/Perm.lean b/Std/Data/List/Perm.lean index 9b74cccaec..d4522bee2f 100644 --- a/Std/Data/List/Perm.lean +++ b/Std/Data/List/Perm.lean @@ -6,8 +6,6 @@ Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro import Std.Tactic.Alias import Std.Data.List.Init.Attach import Std.Data.List.Pairwise --- Adaptation note: nightly-2024-03-18. We should be able to remove this after nightly-2024-03-19. -import Lean.Elab.Tactic.Rfl /-! # List Permutations From 91cba9bda68df58a72e5c770070f9c9d77ba561d Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Tue, 23 Apr 2024 11:09:25 +1000 Subject: [PATCH 211/213] fix test --- test/print_prefix.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/test/print_prefix.lean b/test/print_prefix.lean index 625ba47b2e..6677469882 100644 --- a/test/print_prefix.lean +++ b/test/print_prefix.lean @@ -12,6 +12,7 @@ TEmpty.recOn.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t #guard_msgs in #print prefix TEmpty -- Test type that probably won't change much. +/-- info: -/ #guard_msgs in #print prefix (config := {imported := false}) Empty From 84e3acc30eeeb4be1da535afa1c54b9d5b341dc0 Mon Sep 17 00:00:00 2001 From: leanprover-community-mathlib4-bot Date: Tue, 23 Apr 2024 09:05:07 +0000 Subject: [PATCH 212/213] chore: bump to nightly-2024-04-23 --- lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean-toolchain b/lean-toolchain index b96d89db4d..021fc88cef 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2024-04-22 +leanprover/lean4:nightly-2024-04-23 From 48643957cb394f0740a292b14954747c96bcd00e Mon Sep 17 00:00:00 2001 From: Scott Morrison Date: Wed, 24 Apr 2024 13:39:03 +1000 Subject: [PATCH 213/213] fix --- Std/Data/Array/Merge.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Std/Data/Array/Merge.lean b/Std/Data/Array/Merge.lean index 2c71ea6eaf..250ab760e1 100644 --- a/Std/Data/Array/Merge.lean +++ b/Std/Data/Array/Merge.lean @@ -3,6 +3,7 @@ Copyright (c) 2022 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ +import Std.Tactic.Alias namespace Array