lean4-htt/tests/elab/getElemV.lean

/-!
# Preparations
-/

/-!
## General GetElemV
-/

class GetElemV (coll : Type u) (idx : Type v) (elem : outParam (Type w)) where
  getElemV [h : Nonempty elem] (xs : coll) (i : idx) : elem

export GetElemV (getElemV)

@[inherit_doc getElem]
syntax:max term noWs "｢" withoutPosition(term) "｣" : term
macro_rules | `($x｢$i｣) => `(getElemV $x $i (h := by first | assumption | infer_instance | exact ⟨by assumption⟩ | exact ⟨$x[$i]⟩))

class LawfulGetElemV (cont : Type u) (idx : Type v) (elem : outParam (Type w)) (dom : outParam (cont → idx → Prop))
    [GetElem? cont idx elem dom] [GetElemV cont idx elem] : Prop where
  getElemV_def {_ : Nonempty elem} (c : cont) (i : idx) :
    c｢i｣ = match c[i]? with | some e => e | none => Classical.ofNonempty

export LawfulGetElemV (getElemV_def)

@[simp, grind norm]
theorem getElem_eq_getElemV [GetElem? cont idx elem dom]
    [LawfulGetElem cont idx elem dom]
    [GetElemV cont idx elem] [LawfulGetElemV cont idx elem dom]
    (c : cont) (i : idx) (h : dom c i) :
    c[i] = c｢i｣ := by
  simp [getElemV_def, getElem?_pos, h]

attribute [- simp, - grind] getElem?_pos
attribute [- simp] some_getElem_eq_getElem?_iff

@[grind =, simp]
theorem getElem?_eq_some_getElemV [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
    [GetElemV cont idx elem] [LawfulGetElemV cont idx elem dom]
    (c : cont) (i : idx) (h : dom c i) :
    c[i]? = some c｢i｣ := by
  have : Decidable (dom c i) := .isTrue h
  simp only [getElem?_def, getElem_eq_getElemV]
  exact dif_pos h

theorem getElemV_pos [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
    [GetElemV cont idx elem] [LawfulGetElemV cont idx elem dom]
    (c : cont) (i : idx) (h : dom c i) :
    c｢i｣ = c[i]'h := by
  rw [getElemV_def, getElem?_pos]

theorem getElemV_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
    [GetElemV cont idx elem] [LawfulGetElemV cont idx elem dom] {_ : Nonempty elem}
    (c : cont) (i : idx) (h : ¬dom c i) :
    c｢i｣ = Classical.ofNonempty := by
  rw [getElemV_def, getElem?_neg _ _ h]

@[simp]
theorem some_getElemV_eq_getElem?_iff [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
    [GetElemV cont idx elem] [LawfulGetElemV cont idx elem dom]
    {c : cont} {i : idx} [Decidable (dom c i)] (h : dom c i) :
    (some c｢i｣ = c[i]?) ↔ True := by
  simp [h]

attribute [- simp] getElem?_eq_some_getElem_iff

@[simp] theorem getElem?_eq_some_getElemV_iff [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
    [GetElemV cont idx elem] [LawfulGetElemV cont idx elem dom]
    {c : cont} {i : idx} [Decidable (dom c i)] (h : dom c i) :
    haveI : Nonempty elem := ⟨c[i]⟩
    (c[i]? = some c｢i｣) ↔ True := by
  simp [h]

theorem getElem?_eq_some_iff_getElemV [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
    [GetElemV cont idx elem] [LawfulGetElemV cont idx elem dom]
    {c : cont} {i : idx} [Decidable (dom c i)] {a : elem} :
    c[i]? = some a ↔ dom c i ∧ c｢i｣ = a := by
  simp only [getElem?_eq_some_iff]
  simpa [getElem_eq_getElemV] using ⟨fun ⟨h₁, h₂⟩ => ⟨h₁, h₂⟩, fun ⟨h₁, h₂⟩ => ⟨h₁, h₂⟩⟩

/-!
## GetElemV for lists
-/

namespace List

noncomputable def getElemVInternal [Nonempty α] : (as : List α) → (i : Nat) → α
  | a::_,  0   => a
  | _::as, n+1 => getElemVInternal as n
  | _,     _   => Classical.ofNonempty

noncomputable instance : GetElemV (List α) Nat α where
  getElemV xs i := xs.getElemVInternal i

instance : LawfulGetElemV (List α) Nat α fun as i => i < as.length where
  getElemV_def as i := by
    simp only [getElemV, getElem?]
    induction as generalizing i with
    | nil => rfl
    | cons a as ih =>
      cases i with
      | zero => rfl
      | succ i => exact ih i

noncomputable def headV [Nonempty α] (l : List α) : α :=
  l.head?.getD Classical.ofNonempty

noncomputable def getLastV [Nonempty α] (l : List α) : α :=
  l.getLast?.getD Classical.ofNonempty

@[simp, grind norm]
theorem head_eq_headV {l : List α} (h : l ≠ []) : haveI : Nonempty α := ⟨l.head h⟩; l.head h = l.headV := by
  cases l with
  | nil => exact absurd rfl h
  | cons _ _ => unfold headV; simp

@[simp, grind norm]
theorem getLast_eq_getLastV {l : List α} (h : l ≠ []) :
    haveI : Nonempty α := ⟨l.getLast h⟩; l.getLast h = l.getLastV := by
  unfold getLastV
  rw [getLast?_eq_some_getLast h]
  rfl

attribute [- simp] getElem_mem

@[simp]
theorem getElemV_mem {l : List α} {n} (h : n < l.length) : l｢n｣ ∈ l :=
  match l, n with
  | _ :: _, 0 => .head ..
  | _ :: l, _+1 => .tail _ (getElemV_mem (l := l) (by simpa [Nat.add_one_lt_add_one_iff] using h) ..)

grind_pattern getElemV_mem => l｢n｣ ∈ l

attribute [- simp] getElem_cons_zero

@[simp] theorem getElemV_cons_zero {l : List α} :
    haveI : Nonempty α := ⟨a⟩
    (a::l)｢0｣ = a :=
  rfl

attribute [- simp] getElem_cons_succ

@[simp] theorem getElemV_cons_succ {l : List α} :
    haveI : Nonempty α := ⟨a⟩
    (a::l)｢i+1｣ = l｢i｣ :=
  rfl

attribute [- simp] getElem_cons_drop

@[simp]
theorem getElemV_cons_drop {as : List α} {i : Nat} {_ : Nonempty α} (h : i < as.length) :
    as｢i｣ :: as.drop (i+1) = as.drop i := by
  simp [getElemV_pos as i h, getElem_cons_drop, - getElem_eq_getElemV]

theorem getElem?_eq_getElemV {l : List α} {i} (h : i < l.length) :
    haveI : Nonempty α := ⟨l[i]⟩
    l[i]? = some l｢i｣ := by
  induction l generalizing i with
  | nil => cases h
  | cons a l ih =>
    cases i with
    | zero => rfl
    | succ i => simp [List.getElem?_eq_getElem h]

attribute [- simp] getElem_append_left

@[simp]
theorem getElemV_append_left {as bs : List α} (h : i < as.length) :
    haveI : Nonempty α := ⟨as[i]⟩
    (as ++ bs)｢i｣ = as｢i｣ := by
  induction as generalizing i with
  | nil => trivial
  | cons a as ih =>
    cases i with
    | zero => rfl
    | succ i =>
      apply ih
      simpa [Nat.add_one_lt_add_one_iff] using h

attribute [- simp] getElem_append_right

@[simp]
theorem getElemV_append_right {_ : Nonempty α} {as bs : List α} {i : Nat} (h₁ : as.length ≤ i) :
    (as ++ bs)｢i｣ =
      bs｢i - as.length｣ := by
  induction as generalizing i with
  | nil => trivial
  | cons a as ih =>
    cases i with simp [Nat.succ_sub_succ] <;> simp at h₁
    | succ i => apply ih; simp [h₁]

attribute [- grind] getElem_append

@[grind =] theorem getElemV_append {_ : Nonempty α} {l₁ l₂ : List α} {i : Nat} :
    (l₁ ++ l₂)｢i｣ = if i < l₁.length then l₁｢i｣ else l₂｢i - l₁.length｣ := by
  split <;> rename_i h
  · exact getElemV_append_left h
  · exact getElemV_append_right (by simpa using h)

attribute [- simp, - grind] getElem_map

@[simp, grind =] theorem getElemV_map (f : α → β) {l : List α} {i : Nat} (h : i < l.length) :
    haveI : Nonempty β := ⟨f l[i]⟩
    (map f l)｢i｣ = f l｢i｣ := by
  have := getElem_map f (l := l) (i := i) (h := by simpa using h)
  simpa using this

attribute [- grind] head_eq_getElem

@[grind =]
theorem headV_eq_getElemV {_ : Nonempty α} {l : List α} : headV l = l｢0｣ := by
  cases l <;> rfl

attribute [- grind] getElem_insert

@[grind =] theorem getElemV_insert [BEq α] [LawfulBEq α] {l : List α} {a : α} {i : Nat} :
    (l.insert a)｢i｣ = if a ∈ l then l｢i｣ else if i = 0 then a else l｢i - 1｣ := by
  rw [getElemV_def, getElem?_insert]
  by_cases a ∈ l
  · simp [*, getElemV_def]
  · match i with
    | 0 => simp [*]
    | i' + 1 => simp [*, getElemV_def]

set_option warn.sorry false in
protected theorem minIdxOn_le_of_apply_getElemV_le_apply_minOn {_ : Nonempty α} [LE β]
    [DecidableLE β] [Std.IsLinearPreorder β]
    {f : α → β} {xs : List α} (h : xs ≠ [])
    {k : Nat} (hle : f xs｢k｣ ≤ f (xs.minOn f h)) :
    xs.minIdxOn f h ≤ k := by
  sorry -- uses private lemmas

theorem getElemV_of_mem {l : List α} (h : a ∈ l) :
    ∃ (i : Nat), i < l.length ∧ l｢i｣ = a :=
  match l, h with
  | _ :: _, .head .. => ⟨0, Nat.succ_pos _, rfl⟩
  | _ :: _, .tail _ m => let ⟨i, h, e⟩ := getElemV_of_mem m; ⟨i+1, Nat.succ_lt_succ h, e⟩

theorem mem_iff_getElemV {a} {xs : List α} : a ∈ xs ↔ ∃ (i : Nat), i < xs.length ∧ xs｢i｣ = a :=
  ⟨getElemV_of_mem, fun ⟨_, _, e⟩ => e ▸ getElemV_mem ‹_› ..⟩

attribute [- simp, - grind] head_append_of_ne_nil

@[simp, grind =]
theorem headV_append_of_ne_nil {l : List α} (h : l ≠ []) :
    haveI : Nonempty α := ⟨l.head h⟩
    (l ++ l').headV = l.headV := by
  match l with
  | a :: l => rfl

attribute [- grind] head_append

@[grind =]
theorem headV_append {_ : Nonempty α} {l₁ l₂ : List α} :
    (l₁ ++ l₂).headV = if l₁.isEmpty then l₂.headV else l₁.headV := by
  split <;> rename_i h
  · simp only [isEmpty_iff] at h
    subst h
    simp
  · simp only [isEmpty_iff] at h
    simp [h]

@[simp] theorem getLastV_mem {l : List α} (h : l ≠ []) :
    haveI : Nonempty α := ⟨l.head h⟩
    l.getLastV ∈ l :=
  match l with
  | [] => absurd rfl h
  | [_] => .head ..
  | _::a::l => .tail _ <| getLastV_mem (cons_ne_nil a l)

end List

/-!
## GetElemV for arrays
-/

namespace Array

noncomputable instance : GetElemV (Array α) Nat α where
  getElemV xs i := xs.getD i Classical.ofNonempty

instance : LawfulGetElemV (Array α) Nat α fun xs i => i < xs.size where
  getElemV_def xs i := by
    simp only [getElemV, getElem?, decidableGetElem?, getD, getElem]
    split <;> rfl

attribute [- simp] getInternal_eq_getElem

@[simp]
theorem getInternal_eq_getElemV (a : Array α) (i : Nat) (h) :
    haveI : Nonempty α := ⟨a.getInternal i h⟩
    a.getInternal i h = a｢i｣ := by
  simp [getElemV_pos a i h, getInternal_eq_getElem, - getElem_eq_getElemV]

theorem getElemV_shrink {xs : Array α} {i j : Nat}
    (h : j < (xs.shrink i).size) :
    haveI : Nonempty α := ⟨(xs.shrink i)[j]⟩
    (xs.shrink i)｢j｣ = xs｢j｣ := by
  rwa [← getElem_eq_getElemV, getElem_shrink, getElem_eq_getElemV]

attribute [- simp, - grind] getElem_extract

/--
`getElem_extract` has a `(h : i < (xs.extract start stop).size)` hypothesis, but this is
unnecessarily strong for `getElemV_extract`.
-/
@[simp, grind =] theorem getElemV_extract {_ : Nonempty α} {xs : Array α} {start stop : Nat}
    (h : start + i < stop) :
    (xs.extract start stop)｢i｣ = xs｢start + i｣ := by
  by_cases start + i < xs.size
  · rw [← getElem_eq_getElemV, ← getElem_eq_getElemV, getElem_extract]
    simp; omega
  · rw [getElemV_neg, getElemV_neg]
    · simp; omega
    · simp; omega

theorem ext_getElemV {xs ys : Array α}
    (h₁ : xs.size = ys.size)
    (h₂ : (i : Nat) → (hi : i < xs.size) → haveI : Nonempty α := ⟨xs[i]⟩; xs｢i｣ = ys｢i｣)
    : xs = ys := by
  apply ext
  case h₁ => assumption
  case h₂ => simp +contextual [*]

attribute [- simp, - grind] getElem_toList

@[simp, grind =] theorem getElemV_toList {_ : Nonempty α} {xs : Array α} {i : Nat} : xs.toList｢i｣ = xs｢i｣ := by
  simp [getElemV_def, getElem?_toList]

attribute [- simp, - grind] _root_.List.getElem_toArray

@[simp, grind =] theorem _root_.List.getElemV_toArray [Nonempty α] {xs : List α} {i : Nat} :
    xs.toArray｢i｣ = xs｢i｣ := by
  simp [getElemV_def, _root_.List.getElem?_toArray]

attribute [- simp] getElem_append_left

@[simp] theorem getElemV_append_left {xs ys : Array α} {i : Nat} (hlt : i < xs.size) :
    haveI : Nonempty α := ⟨xs[i]⟩; (xs ++ ys)｢i｣ = xs｢i｣ := by
  simp only [← getElemV_toList, toList_append]
  rw [List.getElemV_append_left]
  simpa

theorem getElemV_push_lt {xs : Array α} {x : α} {i : Nat} (h : i < xs.size) :
    (xs.push x)｢i｣ = xs｢i｣ := by
  rw [Array.size] at h
  simp only [push, ← getElemV_toList, List.concat_eq_append, List.getElemV_append_left h]

attribute [- simp] getElem_push_eq

@[simp] theorem getElemV_push_eq {xs : Array α} {x : α} :
    (xs.push x)｢xs.size｣ = x := by
  simp only [push, ← getElemV_toList, List.concat_eq_append]
  rw [List.getElemV_append_right] <;> simp

attribute [- grind] getElem_push

@[grind =] theorem getElemV_push {xs : Array α} {x : α} {i : Nat} (h : i ≤ xs.size) :
    (xs.push x)｢i｣ = if i < xs.size then xs｢i｣ else x := by
  by_cases h' : i < xs.size
  · simp [getElemV_push_lt, h']
  · simp [Nat.le_antisymm (Nat.le_of_lt_succ (Nat.lt_succ_of_le h)) (Nat.ge_of_not_lt h')]

attribute [- grind] getElem_append

@[grind =] theorem getElemV_append {_ : Nonempty α} {xs ys : Array α} {i : Nat} :
    (xs ++ ys)｢i｣ = if i < xs.size then xs｢i｣ else ys｢i - xs.size｣ := by
  cases xs; cases ys
  simp [List.getElemV_append]

attribute [- simp] getElem_ofFn

@[simp] theorem getElemV_ofFn {f : Fin n → α} {i : Nat} (h : i < n) :
    haveI : Nonempty α := ⟨f ⟨i, h⟩⟩
    (ofFn f)｢i｣ = f ⟨i, h⟩ := by
  rw [← getElem_eq_getElemV, getElem_ofFn]
  simpa

attribute [- simp, - grind] getElem_finRange

@[simp, grind =] theorem getElemV_finRange {i : Nat} (h : i < n) :
    haveI : Nonempty (Fin n) := ⟨⟨0, by omega⟩⟩
    (Array.finRange n)｢i｣ = Fin.cast size_finRange ⟨i, by simpa using h⟩ := by
  simp [Array.finRange, getElemV_ofFn h]

attribute [- simp, - grind] getElem_map

@[simp, grind =] theorem getElemV_map (f : α → β) {xs : Array α} {i : Nat}
    (hi : i < xs.size) :
    haveI : Nonempty α := ⟨xs[i]⟩
    haveI : Nonempty β := ⟨f xs[i]⟩
    (xs.map f)｢i｣ = f xs｢i｣ := by
  cases xs
  simp [List.getElemV_map _ (by simpa using hi)]

end Array

/-!
# Tests
-/

/-!
## `simp` lemmas becoming less automatic
-/

namespace Array

/--
Original proof:
```lean
  apply List.ext_getElem
  · simp
  · intro i; cases i <;> simp
```
The new proof is much more manual.
-/
theorem finRange_succ_copy {n} : Array.finRange (n+1) = #[0] ++ (Array.finRange n).map Fin.succ := by
  ext i h₁ h₂
  · simp [Nat.add_comm]
  · simp [getElemV_append]
    split
    · rw [getElemV_finRange] <;> simp [*]
    · rw [getElemV_finRange, getElemV_map, getElemV_finRange]
      · simp only [Fin.cast_mk, Fin.succ_mk]; omega
      · have : 1 ≤ i := by omega
        simpa [Nat.sub_lt_iff_lt_add, *] using h₁
      · have : 1 ≤ i := by omega
        simpa [Nat.sub_lt_iff_lt_add, *] using h₁
      · simpa using h₁

attribute [- grind] getElem?_push

/--
The old proof was just:
```lean
simp [getElem?_def, getElem_push]
(repeat' split) <;> first | rfl | omega
```

The complication: The `simp` now needs to use `getElemV_push`, and the side condition needs `omega`.
We can't simply use `rw` before the `split` because the rewrite target is under a binder.

As an alternative, the old proof pattern would work if we used `(discharger := omega)`.
-/
@[grind =]
theorem getElem?_push_copy {xs : Array α} {x} : (xs.push x)[i]? = if i = xs.size then some x else xs[i]? := by
  simp only [getElem?_def, size_push, getElem_eq_getElemV]
  split
  · rw [getElemV_push (by omega)]
    (repeat' split) <;> first | rfl | omega
  · (repeat' split) <;> first | rfl | omega

attribute [- simp] shrink_eq_take

-- Previously, the proof was just `ext <;> simp [size_shrink, getElem_shrink]`.,
@[simp] theorem shrink_eq_take_copy {xs : Array α} {i : Nat} : xs.shrink i = xs.take i := by
  apply ext_getElemV -- we'll make this the default for `ext` in the future
  · simp [size_shrink]
  · intro i h
    -- We use `rw` here because `getElemV_extract` has a nontrivial side condition.
    rw [take_eq_extract, getElemV_shrink h, getElemV_extract, Nat.zero_add]
    simp [size_shrink] at *; omega -- side condition for `getElemV_extract`

attribute [- simp] extract_extract

/-
@[simp] theorem extract_extract {as : Array α} {i j k l : Nat} :
    (as.extract i j).extract k l = as.extract (i + k) (min (i + l) j) := by
  ext m h₁ h₂
  · simp
    omega
  · simp only [size_extract] at h₁ h₂
    simp [Nat.add_assoc]
-/

theorem extract_extract_copy {as : Array α} {i j k l : Nat} :
    (as.extract i j).extract k l = as.extract (i + k) (min (i + l) j) := by
  ext m h₁ h₂
  · simp
    omega
  · /-
    This block was:
    ```lean
    simp only [size_extract] at h₁ h₂
    simp [Nat.add_assoc]
    ```
    Now we need bounds proofs for `getElemV_extract`.
    -/
    simp only [getElem_eq_getElemV]
    rw [getElemV_extract, getElemV_extract, getElemV_extract (by simp at h₂; omega), Nat.add_assoc]
    · simp only [size_extract] at h₁ ⊢
      omega
    · simp only [size_extract] at h₁ ⊢
      omega

end Array

/-!
## Rewrite-in-proof anomaly
-/

set_option warn.sorry false in
example (xs : List α) (h : xs.length ≤ i) (hj : xs.length ≤ j) (hk : k < xs.length) :
    haveI : Nonempty α := ⟨(xs.set j xs｢k｣)[k]'(by simpa using hk)⟩
    xs｢i｣ = xs｢j｣ := by
  -- The second rewrite happens inside the `Nonempty` instance of `ofNonempty`.
  -- Expected: The second rewrite applies to the RHS.
  rw [getElemV_neg, getElemV_neg]
  · sorry
  · sorry
  · sorry

/-!
## Spurious dependencies
-/

namespace List

theorem headV_insert [BEq α] [LawfulBEq α] {l : List α} {a : α} :
    haveI : Nonempty α := ⟨a⟩
    (l.insert a).headV = if a ∈ l then l.headV else a := by
  simp [headV_eq_getElemV, getElemV_insert]

theorem head_insert_copy [BEq α] [LawfulBEq α] {l : List α} {a : α} (w) :
    (l.insert a).head w = if h : a ∈ l then l.head (ne_nil_of_mem h) else a := by
  -- RHS has a spurious dependency, preventing it to be rewritten to `ite`
  simp [headV_insert, ← dite_eq_ite]

theorem lex_eq_true_iff_exists_getElemV [Nonempty α] [BEq α] {lt : α → α → Bool}
    {l₁ l₂ : List α} :
    lex l₁ l₂ lt = true ↔
      (l₁.isEqv (l₂.take l₁.length) (· == ·) ∧ l₁.length < l₂.length) ∨
        (∃ (i : Nat), i < l₁.length ∧ i < l₂.length ∧
          (∀ j, j < i → l₁｢j｣ == l₂｢j｣) ∧ lt l₁｢i｣ l₂｢i｣) := by
  -- The given proof has a spurious dependency on the `i < ...` bounds proofs.
  simpa [← exists_prop] using lex_eq_true_iff_exists (l₁ := l₁) (l₂ := l₂) lt

protected theorem minIdxOn_le_of_apply_getElemV_le_apply_getElemV [LE β] [DecidableLE β] [Std.IsLinearPreorder β]
    {f : α → β} {xs : List α} (h : xs ≠ []) {i : Nat} (hi : i < xs.length)
    (hi' : ∀ j, (_ : j < xs.length) → f xs｢i｣ ≤ f xs｢j｣) :
    xs.minIdxOn f h ≤ i := by
  apply List.minIdxOn_le_of_apply_getElemV_le_apply_minOn h
  simp only [List.le_apply_minOn_iff, List.mem_iff_getElemV]
  /-
  The old proof used `rfl` place of `h : getElem xs j = x`.
  This doesn't work anymore because the `Nonempty` instance used by `getElemV` is `⟨x⟩`
  -> occurs check fails, `cases h` fails.

  The new proof uses `▸` and isn't less convenient, but the error message is a bad user experience.
  -/
  rintro _ ⟨j, hj, h⟩
  exact h ▸ hi' _ hj

theorem prefix_iff_getElemV [Nonempty α] {l₁ l₂ : List α} :
    l₁ <+: l₂ ↔ ∃ (_ : l₁.length ≤ l₂.length),
      ∀ i, i < l₁.length → l₁｢i｣ = l₂｢i｣ := by
  -- Have to disable `exists_prop` because the LHS has a spurious dependency on `l₁.length ≤ l₂.length`.
  simp [prefix_iff_getElem, - exists_prop]

theorem isEqv_eq_decide_getElemV {_ : Nonempty α} {as bs : List α} {r : α → α → Bool} :
    isEqv as bs r = if as.length = bs.length then
      decide (∀ (i : Nat), i < as.length → r as｢i｣ bs｢i｣) else false := by
  -- Have to disable `Bool.if_false_right` because of spurious dependency
  simpa [- Bool.if_false_right] using isEqv_eq_decide (as := as) (bs := bs) (r := r)

theorem head_append_copy {l₁ l₂ : List α} (w : l₁ ++ l₂ ≠ []) :
    head (l₁ ++ l₂) w =
      if h : l₁.isEmpty then
        head l₂ (by simp_all [isEmpty_iff])
      else
        head l₁ (by simp_all [isEmpty_iff]) := by
  -- `dite_eq_ite` doesn't trigger because of spurious dependency,
  -- so we must apply it in reverse to assimilate LHS and RHS
  simp [headV_append, ← dite_eq_ite]

end List