l3lab/ntp-mathlib huggingface dataset:
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  

Proof state:
α : Type u
β : Type v
γ : Type w
s : WSeq α
⊢ ∀ {s t : WSeq α},
    (fun s1 s2 => join (map ret s2) = s1) s t →
      Computation.LiftRel (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 => join (map ret s2) = s1) (destruct s)
        (destruct t)

Next tactic:
intro s' s h
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; 

Proof state:
α : Type u
β : Type v
γ : Type w
s✝ s' s : WSeq α
h : join (map ret s) = s'
⊢ Computation.LiftRel (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 => join (map ret s2) = s1) (destruct s') (destruct s)

Next tactic:
rw [← h]
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; rw [← h]
  

Proof state:
α : Type u
β : Type v
γ : Type w
s✝ s' s : WSeq α
h : join (map ret s) = s'
⊢ Computation.LiftRel (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 => join (map ret s2) = s1)
    (destruct (join (map ret s))) (destruct s)

Next tactic:
apply liftRel_rec fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; rw [← h]
  apply liftRel_rec fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s
  · 

Proof state:
case H
α : Type u
β : Type v
γ : Type w
s✝ s' s : WSeq α
h : join (map ret s) = s'
⊢ ∀ {ca cb : Computation (Option (α × WSeq α))},
    (∃ s, ca = destruct (join (map ret s)) ∧ cb = destruct s) →
      LiftRelAux (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 => join (map ret s2) = s1)
        (fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s) (Computation.destruct ca)
        (Computation.destruct cb)

Next tactic:
exact fun {c1 c2} h =>
      match c1, c2, h with
      | _, _, ⟨s, rfl, rfl⟩ => by
        clear h
        -- Porting note: `ret` is simplified in `simp` so `ret`s become `fun a => cons a nil` here.
        have : ∀ s, ∃ s' : WSeq α,
            (map (fun a => cons a nil) s).join.destruct =
              (map (fun a => cons a nil) s').join.destruct ∧ destruct s = s'.destruct :=
          fun s => ⟨s, rfl, rfl⟩
        induction' s using WSeq.recOn with a s s <;>
          simp (config := { unfoldPartialApp := true }) [ret, ret_mem, this, Option.exists]
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; rw [← h]
  apply liftRel_rec fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s
  · exact fun {c1 c2} h =>
      match c1, c2, h with
      | _, _, ⟨s, rfl, rfl⟩ => by
        

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

Next tactic:
clear h
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; rw [← h]
  apply liftRel_rec fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s
  · exact fun {c1 c2} h =>
      match c1, c2, h with
      | _, _, ⟨s, rfl, rfl⟩ => by
        clear h
        -- Porting note: `ret` is simplified in `simp` so `ret`s become `fun a => cons a nil` here.
        

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

Next tactic:
have : ∀ s, ∃ s' : WSeq α,
            (map (fun a => cons a nil) s).join.destruct =
              (map (fun a => cons a nil) s').join.destruct ∧ destruct s = s'.destruct :=
          fun s => ⟨s, rfl, rfl⟩
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; rw [← h]
  apply liftRel_rec fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s
  · exact fun {c1 c2} h =>
      match c1, c2, h with
      | _, _, ⟨s, rfl, rfl⟩ => by
        clear h
        -- Porting note: `ret` is simplified in `simp` so `ret`s become `fun a => cons a nil` here.
        have : ∀ s, ∃ s' : WSeq α,
            (map (fun a => cons a nil) s).join.destruct =
              (map (fun a => cons a nil) s').join.destruct ∧ destruct s = s'.destruct :=
          fun s => ⟨s, rfl, rfl⟩
        

Proof state:
α : Type u
β : Type v
γ : Type w
s✝¹ s' s✝ : WSeq α
h : join (map ret s✝) = s'
c1 c2 : Computation (Option (α × WSeq α))
s : WSeq α
this :
  ∀ (s : WSeq α),
    ∃ s',
      destruct (join (map (fun a => cons a nil) s)) = destruct (join (map (fun a => cons a nil) s')) ∧
        destruct s = destruct s'
⊢ LiftRelAux (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 => join (map ret s2) = s1)
    (fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s)
    (Computation.destruct (destruct (join (map ret s)))) (Computation.destruct (destruct s))

Next tactic:
induction' s using WSeq.recOn with a s s
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; rw [← h]
  apply liftRel_rec fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s
  · exact fun {c1 c2} h =>
      match c1, c2, h with
      | _, _, ⟨s, rfl, rfl⟩ => by
        clear h
        -- Porting note: `ret` is simplified in `simp` so `ret`s become `fun a => cons a nil` here.
        have : ∀ s, ∃ s' : WSeq α,
            (map (fun a => cons a nil) s).join.destruct =
              (map (fun a => cons a nil) s').join.destruct ∧ destruct s = s'.destruct :=
          fun s => ⟨s, rfl, rfl⟩
        induction' s using WSeq.recOn with a s s <;>
          

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

Next tactic:
simp (config := { unfoldPartialApp := true }) [ret, ret_mem, this, Option.exists]
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; rw [← h]
  apply liftRel_rec fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s
  · exact fun {c1 c2} h =>
      match c1, c2, h with
      | _, _, ⟨s, rfl, rfl⟩ => by
        clear h
        -- Porting note: `ret` is simplified in `simp` so `ret`s become `fun a => cons a nil` here.
        have : ∀ s, ∃ s' : WSeq α,
            (map (fun a => cons a nil) s).join.destruct =
              (map (fun a => cons a nil) s').join.destruct ∧ destruct s = s'.destruct :=
          fun s => ⟨s, rfl, rfl⟩
        induction' s using WSeq.recOn with a s s <;>
          

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

Next tactic:
simp (config := { unfoldPartialApp := true }) [ret, ret_mem, this, Option.exists]
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; rw [← h]
  apply liftRel_rec fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s
  · exact fun {c1 c2} h =>
      match c1, c2, h with
      | _, _, ⟨s, rfl, rfl⟩ => by
        clear h
        -- Porting note: `ret` is simplified in `simp` so `ret`s become `fun a => cons a nil` here.
        have : ∀ s, ∃ s' : WSeq α,
            (map (fun a => cons a nil) s).join.destruct =
              (map (fun a => cons a nil) s').join.destruct ∧ destruct s = s'.destruct :=
          fun s => ⟨s, rfl, rfl⟩
        induction' s using WSeq.recOn with a s s <;>
          

Proof state:
case h3
α : Type u
β : Type v
γ : Type w
s✝¹ s' s✝ : WSeq α
h : join (map ret s✝) = s'
c1 c2 : Computation (Option (α × WSeq α))
this :
  ∀ (s : WSeq α),
    ∃ s',
      destruct (join (map (fun a => cons a nil) s)) = destruct (join (map (fun a => cons a nil) s')) ∧
        destruct s = destruct s'
s : WSeq α
⊢ LiftRelAux (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 => join (map ret s2) = s1)
    (fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s)
    (Computation.destruct (destruct (join (map ret (think s))))) (Computation.destruct (destruct (think s)))

Next tactic:
simp (config := { unfoldPartialApp := true }) [ret, ret_mem, this, Option.exists]
@[simp]
theorem join_map_ret (s : WSeq α) : join (map ret s) ~ʷ s := by
  refine' ⟨fun s1 s2 => join (map ret s2) = s1, rfl, _⟩
  intro s' s h; rw [← h]
  apply liftRel_rec fun c1 c2 => ∃ s, c1 = destruct (join (map ret s)) ∧ c2 = destruct s
  · exact fun {c1 c2} h =>
      match c1, c2, h with
      | _, _, ⟨s, rfl, rfl⟩ => by
        clear h
        -- Porting note: `ret` is simplified in `simp` so `ret`s become `fun a => cons a nil` here.
        have : ∀ s, ∃ s' : WSeq α,
            (map (fun a => cons a nil) s).join.destruct =
              (map (fun a => cons a nil) s').join.destruct ∧ destruct s = s'.destruct :=
          fun s => ⟨s, rfl, rfl⟩
        induction' s using WSeq.recOn with a s s <;>
          simp (config := { unfoldPartialApp := true }) [ret, ret_mem, this, Option.exists]
  · 

Proof state:
case Hc
α : Type u
β : Type v
γ : Type w
s✝ s' s : WSeq α
h : join (map ret s) = s'
⊢ ∃ s_1, destruct (join (map ret s)) = destruct (join (map ret s_1)) ∧ destruct s = destruct s_1

Next tactic:
exact ⟨s, rfl, rfl⟩
@[simp]
theorem join_append (S T : WSeq (WSeq α)) : join (append S T) ~ʷ append (join S) (join T) := by
  

Proof state:
α : Type u
β : Type v
γ : Type w
S T : WSeq (WSeq α)
⊢ join (append S T) ~ʷ append (join S) (join T)

Next tactic:
refine'
    ⟨fun s1 s2 =>
      ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)),
      ⟨nil, S, T, by simp, by simp⟩, _⟩
@[simp]
theorem join_append (S T : WSeq (WSeq α)) : join (append S T) ~ʷ append (join S) (join T) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)),
      ⟨nil, S, T, by 

Proof state:
α : Type u
β : Type v
γ : Type w
S T : WSeq (WSeq α)
⊢ join (append S T) = append nil (join (append S T))

Next tactic:
simp
@[simp]
theorem join_append (S T : WSeq (WSeq α)) : join (append S T) ~ʷ append (join S) (join T) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)),
      ⟨nil, S, T, by simp, by 

Proof state:
α : Type u
β : Type v
γ : Type w
S T : WSeq (WSeq α)
⊢ append (join S) (join T) = append nil (append (join S) (join T))

Next tactic:
simp
@[simp]
theorem join_append (S T : WSeq (WSeq α)) : join (append S T) ~ʷ append (join S) (join T) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)),
      ⟨nil, S, T, by simp, by simp⟩, _⟩
  

Proof state:
α : Type u
β : Type v
γ : Type w
S T : WSeq (WSeq α)
⊢ ∀ {s t : WSeq α},
    (fun s1 s2 => ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T))) s t →
      Computation.LiftRel
        (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
          ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)))
        (destruct s) (destruct t)

Next tactic:
intro s1 s2 h
@[simp]
theorem join_append (S T : WSeq (WSeq α)) : join (append S T) ~ʷ append (join S) (join T) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)),
      ⟨nil, S, T, by simp, by simp⟩, _⟩
  intro s1 s2 h
  

Proof state:
α : Type u
β : Type v
γ : Type w
S T : WSeq (WSeq α)
s1 s2 : WSeq α
h : ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T))
⊢ Computation.LiftRel
    (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
      ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)))
    (destruct s1) (destruct s2)

Next tactic:
apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ (s : WSeq α) (S T : _),
          c1 = destruct (append s (join (append S T))) ∧
            c2 = destruct (append s (append (join S) (join T))))
      _ _ _
      (let ⟨s, S, T, h1, h2⟩ := h
      ⟨s, S, T, congr_arg destruct h1, congr_arg destruct h2⟩)
@[simp]
theorem join_append (S T : WSeq (WSeq α)) : join (append S T) ~ʷ append (join S) (join T) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)),
      ⟨nil, S, T, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ (s : WSeq α) (S T : _),
          c1 = destruct (append s (join (append S T))) ∧
            c2 = destruct (append s (append (join S) (join T))))
      _ _ _
      (let ⟨s, S, T, h1, h2⟩ := h
      ⟨s, S, T, congr_arg destruct h1, congr_arg destruct h2⟩)
  

Proof state:
α : Type u
β : Type v
γ : Type w
S T : WSeq (WSeq α)
s1 s2 : WSeq α
h : ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T))
⊢ ∀ {ca cb : Computation (Option (α × WSeq α))},
    (fun c1 c2 =>
          ∃ s S T, c1 = destruct (append s (join (append S T))) ∧ c2 = destruct (append s (append (join S) (join T))))
        ca cb →
      LiftRelAux
        (LiftRelO (fun x x_1 => x = x_1) fun s1 s2 =>
          ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)))
        (fun c1 c2 =>
          ∃ s S T, c1 = destruct (append s (join (append S T))) ∧ c2 = destruct (append s (append (join S) (join T))))
        (Computation.destruct ca) (Computation.destruct cb)

Next tactic:
rintro c1 c2 ⟨s, S, T, rfl, rfl⟩
@[simp]
theorem join_append (S T : WSeq (WSeq α)) : join (append S T) ~ʷ append (join S) (join T) := by
  refine'
    ⟨fun s1 s2 =>
      ∃ s S T, s1 = append s (join (append S T)) ∧ s2 = append s (append (join S) (join T)),
      ⟨nil, S, T, by simp, by simp⟩, _⟩
  intro s1 s2 h
  apply
    liftRel_rec
      (fun c1 c2 =>
        ∃ (s : WSeq α) (S T : _),
          c1 = destruct (append s (join (append S T))) ∧
            c2 = destruct (append s (append (join S) (join T))))
      _ _ _
      (let ⟨s, S, T, h1, h2⟩ := h
      ⟨s, S, T, congr_arg destruct h1, congr_arg destruct h2⟩)
  rintro c1 c2 ⟨s, S, T, rfl, rfl⟩
  

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

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

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

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

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

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

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

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

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

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

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

Next tactic:
simp