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

(* For Register machines, we handle the pure part of the assertion differently for a more in-line rule. *)
Lemma While_SpecReg (sig : finType) (n : nat) (F : finType) {inF : inhabitedC F} (pM : pTM _ (option F) n)
(X : Type)
(P : X -> Spec sig n) (Q : X -> option F -> Spec sig n) (R : X -> F -> Spec sig n) :
(forall x, Triple ≃≃( P x) pM (fun y => ≃≃( Q x y))) ->
(forall x , implList (fst (P x))
(forall yout, implList (fst (Q x (Some yout))) (Entails ≃≃( [],snd (Q x (Some yout))) ≃≃( R x yout)))
/\ (implList (fst (Q x None)) (exists x', Entails ≃≃( [],snd (Q x None)) ≃≃( P x')
/\ (forall yout, Entails ≃≃( R x' yout) ≃≃( R x yout))))) ->
forall (x : X), Triple ≃≃( P x) (While pM) (fun y => ≃≃( R x y)).