Section Correctness.
(* The first parameter of [bisimilar] is unnecessary for this development. The return type is heterogeneous, the singleton type [F 1] on one side and [unit] on the other, hence we instantiate the parameter with the trivial relation. *)
Definition TT {A B}: A -> B -> Prop  := fun _ _ => True.
Hint Unfold TT.
Definition equivalent (s:stmt) (t:asm 1 1) : Prop :=
bisimilar TT (denote_imp s) (denote_asm t f0).
Inductive RI : (unit + unit) -> (unit + unit + unit) -> Prop :=
| RI_inl : RI (inl tt) (inl (inl tt))
| RI_inr : RI (inr tt) (inr tt).

(* Utility: slight rephrasing of [while] to facilitate rewriting in the main theorem.*)
Lemma while_is_loop {E} (body : itree E (unit+unit)) :
while body
≈ KTree.iter (fun l : unit + unit =>
match l with
| inl _ => x <- body;; match x with inl _ => Ret (inl (inl tt)) | inr _ => Ret (inr tt) end
| inr _ => Ret (inl (inl tt))   (* Enter loop *)
end) (inr tt).