(* ** Some Hoare Rules *)
From Undecidability Require Export TM.Compound.Multi TM.Combinators.Combinators.
From Undecidability.TM.Hoare Require Import HoareLogic HoareRegister.
(* *** Nop *)
(* A classic example for Hoare logic *)
(* *** [Relabel] *)
(* *** [Return] *)
(* *** Sequential Composition *)
(* *** Switch *)
(* *** While *)
(* Obviously, the rules for [While] are a bit more complicated. *)
(* We have an abstract specification [P x] for an (abstract) type [X]. As invariant, we require that there always exists an [x:X] such that [P x] holds for the input tape. At the end, we assert that the assertion [R] holds (without knowledge of the abstract [x]).  To apply this  have three proof-obligations: First, we show the correctness of the machine [M]. First, we show that whenever [M] terminates in [None], there must be another [x':X] such that the invariant still holds. Finally, if [M] terminated in [Some yout], the postcondition must hold. *)

(* In the correctness rule for [While], we share an "abstract" version of the state between the precondition [P x] and the postcondition [R x]. The first proof obligation is to instantiate the correctness of [M]: [forall x, {P x} pM {Q x}], where [Q x] is the (abstracted) postcondition of [M]. Then we have to show that whenever [M] terminates in [Some yout] for the abstract state [x], the postcondition [R yout x] is satisfied. For the loop invariant, when [M] terminates in [None], the abstract state [x] has changed. We choose a new abstract state [x'] and show that when the postcondition is satisfied for this abstract state [x'], then the postcondition is also satisfied for [x] and the input tape.  Note that this is similar to the way we proof realisation of a [While M]. There, we also share "abstract" variables in the "precondition" and the "postcondition" of the realisation. *)
Lemma While_Spec (sig : finType) (n : nat) (F : finType) {inF : inhabitedC F} (pM : pTM sig (option F) n)
(X : Type)
(P : X -> Assert sig n) (Q : X -> option F -> Assert sig n) (R : X -> F -> Assert sig n) :
(forall x, Triple (P x) pM (Q x)) ->
(forall x yout tmid tout, P x tmid -> Q x (Some yout) tout -> R x yout tout) ->
(forall x tin tmid, P x tin -> Q x None tmid -> exists x', P x' tmid /\ forall yout tout, R x' yout tout -> R x yout tout) ->
forall (x : X), Triple (P x) (While pM) (R x).