(* * Machine for comparing two [positive] binary numbers *)
(* Declare discreteness of [comparison] *)
Global Instance comparison_eq_dec : eq_dec comparison.
Global Instance comparison_inhabited : inhabitedC comparison.
Definition Compare_Loop : comparison -> pTM sigPos^+ comparison 2 := StateWhile Compare_Step.
Definition Compare_Loop_Rel (r : comparison) : pRel sigPos^+ comparison 2 :=
fun tin '(yout, tout) =>
(forall (p0 : positive) (b0 : bool) (bits0 : list bool) (p1 : positive) (b1 : bool) (bits1 : list bool),
atBit tin[@Fin0] p0 b0 bits0 ->
atBit tin[@Fin1] p1 b1 bits1 ->
atHSB tout[@Fin0] (append_bits p0 (b0 :: bits0)) /\
atHSB tout[@Fin1] (append_bits p1 (b1 :: bits1)) /\
yout = Pos.compare_cont r (p0 ~~ b0) (p1 ~~ b1)) /\
(forall (p0 : positive) (b0 : bool) (bits0 : list bool) (p1 : positive),
atBit tin[@Fin0] p0 b0 bits0 ->
atHSB tin[@Fin1] p1 ->
atHSB tout[@Fin0] (append_bits p0 (b0 :: bits0)) /\
atHSB tout[@Fin1] p1 /\
yout = Gt) /\
(forall (p0 : positive) (p1 : positive) (b1 : bool) (bits1 : list bool),
atHSB tin[@Fin0] p0 ->
atBit tin[@Fin1] p1 b1 bits1 ->
atHSB tout[@Fin0] p0 /\
atHSB tout[@Fin1] (append_bits p1 (b1 :: bits1)) /\
yout = Lt) /\
(forall (p0 p1 : positive),
atHSB tin[@Fin0] p0 ->
atHSB tin[@Fin1] p1 ->
tout = tin /\ yout = r).

Lemma Compare_Loop_Realise (r : comparison) : Compare_Loop r ⊨ Compare_Loop_Rel r.