diff --git a/src/Lean/Elab/Tactic/RCases.lean b/src/Lean/Elab/Tactic/RCases.lean index 84ac7b7985..b69e3a0a6f 100644 --- a/src/Lean/Elab/Tactic/RCases.lean +++ b/src/Lean/Elab/Tactic/RCases.lean @@ -348,7 +348,7 @@ partial def rcasesCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (e 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 + (r, ·) <$> g.cases e.fvarId! altVarNames (useNatCasesAuxOn := true) | _, _ => failK () (·.2) <$> subgoals.foldlM (init := (r, a)) fun (r, a) ⟨goal, ctorName⟩ => do let rec diff --git a/src/Lean/Meta/Tactic/Cases.lean b/src/Lean/Meta/Tactic/Cases.lean index e25f39aae8..96e25398b2 100644 --- a/src/Lean/Meta/Tactic/Cases.lean +++ b/src/Lean/Meta/Tactic/Cases.lean @@ -222,15 +222,17 @@ private def unifyCasesEqs (numEqs : Nat) (subgoals : Array CasesSubgoal) : MetaM } private def inductionCasesOn (mvarId : MVarId) (majorFVarId : FVarId) (givenNames : Array AltVarNames) (ctx : Context) - : MetaM (Array CasesSubgoal) := mvarId.withContext do + (useNatCasesAuxOn : Bool := false) : MetaM (Array CasesSubgoal) := mvarId.withContext do let majorType ← inferType (mkFVar majorFVarId) let (us, params) ← getInductiveUniverseAndParams majorType - let casesOn := mkCasesOnName ctx.inductiveVal.name + let mut casesOn := mkCasesOnName ctx.inductiveVal.name + if useNatCasesAuxOn && ctx.inductiveVal.name == ``Nat && (← getEnv).contains ``Nat.casesAuxOn then + casesOn := ``Nat.casesAuxOn let ctors := ctx.inductiveVal.ctors.toArray let s ← mvarId.induction majorFVarId casesOn givenNames return toCasesSubgoals s ctors majorFVarId us params -def cases (mvarId : MVarId) (majorFVarId : FVarId) (givenNames : Array AltVarNames := #[]) : MetaM (Array CasesSubgoal) := do +def cases (mvarId : MVarId) (majorFVarId : FVarId) (givenNames : Array AltVarNames := #[]) (useNatCasesAuxOn : Bool := false) : MetaM (Array CasesSubgoal) := do try mvarId.withContext do mvarId.checkNotAssigned `cases @@ -243,7 +245,7 @@ def cases (mvarId : MVarId) (majorFVarId : FVarId) (givenNames : Array AltVarNam allow callers to specify whether they want the `FVarSubst` or not. -/ if ctx.inductiveVal.numIndices == 0 then -- Simple case - inductionCasesOn mvarId majorFVarId givenNames ctx + inductionCasesOn mvarId majorFVarId givenNames ctx (useNatCasesAuxOn := useNatCasesAuxOn) else let s₁ ← generalizeIndices mvarId majorFVarId trace[Meta.Tactic.cases] "after generalizeIndices\n{MessageData.ofGoal s₁.mvarId}" @@ -258,9 +260,14 @@ end Cases /-- Apply `casesOn` using the free variable `majorFVarId` as the major premise (aka discriminant). `givenNames` contains user-facing names for each alternative. + +- `useNatCasesAuxOn` is a temporary hack for the `rcases` family of tactics. + Do not use it, as it is subject to removal. + It enables using `Nat.casesAuxOn` instead of `Nat.casesOn`, + which causes case splits on `n : Nat` to be represented as `0` and `n' + 1` rather than as `Nat.zero` and `Nat.succ n'`. -/ -def _root_.Lean.MVarId.cases (mvarId : MVarId) (majorFVarId : FVarId) (givenNames : Array AltVarNames := #[]) : MetaM (Array CasesSubgoal) := - Cases.cases mvarId majorFVarId givenNames +def _root_.Lean.MVarId.cases (mvarId : MVarId) (majorFVarId : FVarId) (givenNames : Array AltVarNames := #[]) (useNatCasesAuxOn : Bool := false) : MetaM (Array CasesSubgoal) := + Cases.cases mvarId majorFVarId givenNames (useNatCasesAuxOn := useNatCasesAuxOn) @[deprecated MVarId.cases] def cases (mvarId : MVarId) (majorFVarId : FVarId) (givenNames : Array AltVarNames := #[]) : MetaM (Array CasesSubgoal) := diff --git a/tests/lean/run/rcases.lean b/tests/lean/run/rcases.lean index 466d5508ba..263720da04 100644 --- a/tests/lean/run/rcases.lean +++ b/tests/lean/run/rcases.lean @@ -38,10 +38,10 @@ example : cond false Nat Int → cond true Int Nat → Nat ⊕ Unit → True := 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 h :ₛ 0 = y; trivial + · guard_hyp h :ₛ 0 + 1 = y; trivial · guard_hyp z : Nat - guard_hyp h : Nat.succ (Nat.succ z) = y; trivial + guard_hyp h :ₛ z + 1 + 1 = y; trivial example (h : x = 3) (h₂ : x < 4) : x < 4 := by rcases h with ⟨⟩ @@ -188,8 +188,8 @@ example (h : a ≤ 2 ∨ 2 < a) : True := by example (a : Nat) : True := by rcases h : a with _ | n - · guard_hyp h : a = 0; trivial - · guard_hyp h : a = n + 1; trivial + · guard_hyp h :ₛ a = 0; trivial + · guard_hyp h :ₛ a = n + 1; trivial inductive BaseType : Type where | one