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

Lemma While_SpecTReg' (sig : finType) (n : nat) (F : finType) {inF : inhabitedC F} (pM : pTM _ (option F) n)
(X : Type) (f g : X -> nat)
P' Q' R' (P : X -> SpecV sig n) (Q : X -> option F -> SpecV sig n) (R : X -> F -> SpecV sig n) :
(forall x, TripleT ≃≃( P' x, P x) (g x) pM (fun y => ≃≃( Q' x y, Q x y))) ->
(forall x , implList (P' x)
(forall yout, implList (Q' x (Some yout)) (Entails ≃≃( [],Q x (Some yout)) ≃≃( R' x yout,R x yout) /\ g x <= f x))
/\ (implList (Q' x None) (exists x', Entails ≃≃( [],Q x None) ≃≃( P' x', P x') /\ 1 + g x + f x' <= f x
/\ (forall yout, Entails ≃≃( R' x' yout,R x' yout) ≃≃( R' x yout,R x yout))))) ->
forall (x : X), TripleT ≃≃( P' x,P x) (f x) (While pM) (fun y => ≃≃( R' x y,R x y)).