l3lab/ntp-mathlib huggingface dataset:
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  

Proof state:
α : Type u
β : Type v
γ : Type w
SS : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h✝ : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
h :
  ∃ s S SS,
    c1 = destruct (append s (join (append S (join SS)))) ∧
      c2 = destruct (append s (append (join S) (join (map join SS))))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct c1) (Computation.destruct c2)

Next tactic:
exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> simp
      · induction' S using WSeq.recOn with s S S <;> simp
        · induction' SS using WSeq.recOn with S SS SS <;> simp
          · refine' ⟨nil, S, SS, _, _⟩ <;> simp
          · refine' ⟨nil, nil, SS, _, _⟩ <;> simp
        · exact ⟨s, S, SS, rfl, rfl⟩
        · refine' ⟨nil, S, SS, _, _⟩ <;> simp
      · exact ⟨s, S, SS, rfl, rfl⟩
      · exact ⟨s, S, SS, rfl, rfl⟩
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      

Proof state:
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h✝ : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
h :
  ∃ s S SS,
    c1 = destruct (append s (join (append S (join SS)))) ∧
      c2 = destruct (append s (append (join S) (join (map join SS))))
s : WSeq α
S : WSeq (WSeq α)
SS : WSeq (WSeq (WSeq α))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (append s (join (append S (join SS))))))
    (Computation.destruct (destruct (append s (append (join S) (join (map join SS))))))

Next tactic:
clear h
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      

Proof state:
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
s : WSeq α
S : WSeq (WSeq α)
SS : WSeq (WSeq (WSeq α))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (append s (join (append S (join SS))))))
    (Computation.destruct (destruct (append s (append (join S) (join (map join SS))))))

Next tactic:
induction' s using WSeq.recOn with a s s
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> 

Proof state:
case h1
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
S : WSeq (WSeq α)
SS : WSeq (WSeq (WSeq α))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (append nil (join (append S (join SS))))))
    (Computation.destruct (destruct (append nil (append (join S) (join (map join SS))))))

Next tactic:
simp
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> 

Proof state:
case h2
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
S : WSeq (WSeq α)
SS : WSeq (WSeq (WSeq α))
a : α
s : WSeq α
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (append (cons a s) (join (append S (join SS))))))
    (Computation.destruct (destruct (append (cons a s) (append (join S) (join (map join SS))))))

Next tactic:
simp
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> 

Proof state:
case h3
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
S : WSeq (WSeq α)
SS : WSeq (WSeq (WSeq α))
s : WSeq α
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (append (think s) (join (append S (join SS))))))
    (Computation.destruct (destruct (append (think s) (append (join S) (join (map join SS))))))

Next tactic:
simp
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> simp
      · 

Proof state:
case h1
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
S : WSeq (WSeq α)
SS : WSeq (WSeq (WSeq α))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (join (append S (join SS)))))
    (Computation.destruct (destruct (append (join S) (join (map join SS)))))

Next tactic:
induction' S using WSeq.recOn with s S S
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> simp
      · induction' S using WSeq.recOn with s S S <;> 

Proof state:
case h1.h1
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
SS : WSeq (WSeq (WSeq α))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (join (append nil (join SS)))))
    (Computation.destruct (destruct (append (join nil) (join (map join SS)))))

Next tactic:
simp
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> simp
      · induction' S using WSeq.recOn with s S S <;> 

Proof state:
case h1.h2
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
SS : WSeq (WSeq (WSeq α))
s : WSeq α
S : WSeq (WSeq α)
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (join (append (cons s S) (join SS)))))
    (Computation.destruct (destruct (append (join (cons s S)) (join (map join SS)))))

Next tactic:
simp
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> simp
      · induction' S using WSeq.recOn with s S S <;> 

Proof state:
case h1.h3
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
SS : WSeq (WSeq (WSeq α))
S : WSeq (WSeq α)
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (join (append (think S) (join SS)))))
    (Computation.destruct (destruct (append (join (think S)) (join (map join SS)))))

Next tactic:
simp
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> simp
      · induction' S using WSeq.recOn with s S S <;> simp
        · 

Proof state:
case h1.h1
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
SS : WSeq (WSeq (WSeq α))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (join (join SS)))) (Computation.destruct (destruct (join (map join SS))))

Next tactic:
induction' SS using WSeq.recOn with S SS SS
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> simp
      · induction' S using WSeq.recOn with s S S <;> simp
        · induction' SS using WSeq.recOn with S SS SS <;> 

Proof state:
case h1.h1.h1
α : Type u
β : Type v
γ : Type w
SS : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (join (join nil)))) (Computation.destruct (destruct (join (map join nil))))

Next tactic:
simp
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> simp
      · induction' S using WSeq.recOn with s S S <;> simp
        · induction' SS using WSeq.recOn with S SS SS <;> 

Proof state:
case h1.h1.h2
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
S : WSeq (WSeq α)
SS : WSeq (WSeq (WSeq α))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (join (join (cons S SS)))))
    (Computation.destruct (destruct (join (map join (cons S SS)))))

Next tactic:
simp
@[simp]
theorem join_join (SS : WSeq (WSeq (WSeq α))) : join (join SS) ~ʷ join (map join SS) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S SS,
        s1 = append s (join (append S (join SS))) ∧
          s2 = append s (append (join S) (join (map join SS))),
      ⟨nil, nil, SS, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ s S SS,
          c1 = destruct (append s (join (append S (join SS)))) ∧
            c2 = destruct (append s (append (join S) (join (map join SS)))))
      _ (destruct s1) (destruct s2)
      (let ⟨s, S, SS, h1, h2⟩ := h
      ⟨s, S, SS, by simp [h1], by simp [h2]⟩)
  intro c1 c2 h
  exact
    match c1, c2, h with
    | _, _, ⟨s, S, SS, rfl, rfl⟩ => by
      clear h
      induction' s using WSeq.recOn with a s s <;> simp
      · induction' S using WSeq.recOn with s S S <;> simp
        · induction' SS using WSeq.recOn with S SS SS <;> 

Proof state:
case h1.h1.h3
α : Type u
β : Type v
γ : Type w
SS✝ : WSeq (WSeq (WSeq α))
s1 s2 : WSeq α
h : ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS)))
c1 c2 : Computation (Option (α × WSeq α))
SS : WSeq (WSeq (WSeq α))
⊢ LiftRelAux
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S SS, s1 = append s (join (append S (join SS))) ∧ s2 = append s (append (join S) (join (map join SS))))
    (fun c1 c2 =>
      ∃ s S SS,
        c1 = destruct (append s (join (append S (join SS)))) ∧
          c2 = destruct (append s (append (join S) (join (map join SS)))))
    (Computation.destruct (destruct (join (join (think SS)))))
    (Computation.destruct (destruct (join (map join (think SS)))))

Next tactic:
simp