(* * 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).
Definition Compare := GoToLSB_start@[|Fin0|];; GoToLSB_start@[|Fin1|];;
Switch (Compare_Loop Eq) (fun (r : comparison) => Return ((Move Lmove)@[|Fin0|];; (Move Lmove)@[|Fin1|]) r).
Definition Compare_Rel : pRel sigPos^+ comparison 2 :=
fun tin '(yout, tout) =>
forall (p0 p1 : positive),
tin[@Fin0] ≃ p0 ->
tin[@Fin1] ≃ p1 ->
tout[@Fin0] ≃ p0 /\
tout[@Fin1] ≃ p1 /\
yout = Pos.compare p0 p1.

Lemma Compare_Realise : Compare ⊨ Compare_Rel.