English
Let M be a two-to-one machine translation M: Λ → TM2.Stmt and ss a witness that S is supported by M. Then the translated machine tr(M) supports the translated set trSupp(M,S): TM1.Supports(tr(M), trSupp(M,S)). In particular, the translation preserves the (support) relation.
Русский
Пусть M : Λ → TM2.Stmt задаёт перевод машины двустороннего типа, и ss—доказательство того, что S поддерживается M. Тогда переводенная машина tr(M) поддерживает множество trSupp(M,S); то есть TM1.Supports(tr(M), trSupp(M,S)). Перевод сохраняет отношение поддержки.
LaTeX
$$$\\forall S,\\; TM2.\\mathrm{Supports}(M,S) \\Rightarrow TM1.\\mathrm{Supports}(\\mathrm{tr}\\,M,\\mathrm{trSupp}\\,M\\,S)$$$
Lean4
theorem tr_supports {S} (ss : TM2.Supports M S) : TM1.Supports (tr M) (trSupp M S) :=
⟨Finset.mem_biUnion.2 ⟨_, ss.1, Finset.mem_insert.2 <| Or.inl rfl⟩, fun l' h ↦
by
suffices
∀ (q) (_ : TM2.SupportsStmt S q) (_ : ∀ x ∈ trStmts₁ q, x ∈ trSupp M S),
TM1.SupportsStmt (trSupp M S) (trNormal q) ∧ ∀ l' ∈ trStmts₁ q, TM1.SupportsStmt (trSupp M S) (tr M l')
by
rcases Finset.mem_biUnion.1 h with ⟨l, lS, h⟩
have := this _ (ss.2 l lS) fun x hx ↦ Finset.mem_biUnion.2 ⟨_, lS, Finset.mem_insert_of_mem hx⟩
rcases Finset.mem_insert.1 h with (rfl | h) <;> [exact this.1; exact this.2 _ h]
clear h l'
refine stmtStRec ?_ ?_ ?_ ?_ ?_
· intro _ s _ IH ss' sub
rw [TM2to1.supports_run] at ss'
simp only [TM2to1.trStmts₁_run, Finset.mem_union, Finset.mem_insert, Finset.mem_singleton] at sub
have hgo := sub _ (Or.inl <| Or.inl rfl)
have hret := sub _ (Or.inl <| Or.inr rfl)
obtain ⟨IH₁, IH₂⟩ := IH ss' fun x hx ↦ sub x <| Or.inr hx
refine ⟨by simp only [trNormal_run, TM1.SupportsStmt]; intros; exact hgo, fun l h ↦ ?_⟩
rw [trStmts₁_run] at h
simp only [Finset.mem_union, Finset.mem_insert, Finset.mem_singleton] at h
rcases h with (⟨rfl | rfl⟩ | h)
· cases s
· exact ⟨fun _ _ ↦ hret, fun _ _ ↦ hgo⟩
· exact ⟨fun _ _ ↦ hret, fun _ _ ↦ hgo⟩
· exact ⟨⟨fun _ _ ↦ hret, fun _ _ ↦ hret⟩, fun _ _ ↦ hgo⟩
· unfold TM1.SupportsStmt TM2to1.tr
exact ⟨IH₁, fun _ _ ↦ hret⟩
· exact IH₂ _ h
· intro _ _ IH ss' sub
unfold TM2to1.trStmts₁ at sub ⊢
exact IH ss' sub
· intro _ _ _ IH₁ IH₂ ss' sub
unfold TM2to1.trStmts₁ at sub
obtain ⟨IH₁₁, IH₁₂⟩ := IH₁ ss'.1 fun x hx ↦ sub x <| Finset.mem_union_left _ hx
obtain ⟨IH₂₁, IH₂₂⟩ := IH₂ ss'.2 fun x hx ↦ sub x <| Finset.mem_union_right _ hx
refine ⟨⟨IH₁₁, IH₂₁⟩, fun l h ↦ ?_⟩
rw [trStmts₁] at h
rcases Finset.mem_union.1 h with (h | h) <;> [exact IH₁₂ _ h; exact IH₂₂ _ h]
· intro _ ss'
_ -- goto
simp only [trStmts₁, Finset.notMem_empty]; refine ⟨?_, fun _ ↦ False.elim⟩
exact fun _ v ↦ Finset.mem_biUnion.2 ⟨_, ss' v, Finset.mem_insert_self _ _⟩
· intro _
_ -- halt
simp only [trStmts₁, Finset.notMem_empty]
exact ⟨trivial, fun _ ↦ False.elim⟩⟩