(* ** 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. *)

(* Termination rule: We additionally have an abstract running time function [f : X -> nat]. The machine [M] terminates in time [g x] for every abstract [x]. We have to show that [f x] also decreases by [1 + g x] whenever [While M] repeats the loop. *)
Lemma While_SpecT (sig : finType) (n : nat) (F : finType) {inF : inhabitedC F} (pM : pTM sig (option F) n)
(X : Type) (f g : X -> nat)
(P : X -> Assert sig n) (Q : X -> option F -> Assert sig n) (R : X -> F -> Assert sig n) :
(forall x, TripleT (P x) (g x) pM (Q x)) ->
(forall x yout tmid tout, P x tmid -> Q x (Some yout) tout -> R x yout tout /\ g x <= f x) ->
(forall x tin tmid, P x tin -> Q x None tmid -> exists x', P x' tmid /\ 1 + g x + f x' <= f x /\ forall yout tout, R x' yout tout -> R x yout tout) ->
forall (x : X), TripleT (P x) (f x) (While pM) (R x).