Local Notation power := (mscal mult 1).Local Notation "⇧" := (fun r n f e => msum nat_join 0 n (fun i => f i * power (e i) r)).(* if n and m are written in binary, LSB first:
       n = n0 n1 n2 ...
       m = m0 m1 m2 ...
    then n ≲ m means forall any i, n[i] <= m[i] *)

Inductive binary_le : nat -> nat -> Prop :=
 | in_ble_0 : forall n, 0 ≲ n
 | in_ble_1 : forall n m, rem n 2 <= rem m 2 -> div n 2 ≲ div m 2 -> n ≲ m
where "x ≲ y" := (binary_le x y).(* if n and m are written in binary, LSB first:
       n = n0 n1 n2 ...
       m = m0 m1 m2 ...
    then n ≲ m means forall any i, n[i] <= m[i] *)

Inductive binary_le : nat -> nat -> Prop :=
 | in_ble_0 : forall n, 0 ≲ n
 | in_ble_1 : forall n m, rem n 2 <= rem m 2 -> div n 2 ≲ div m 2 -> n ≲ m
where "x ≲ y" := (binary_le x y).(* if n and m are written in binary, LSB first:
       n = n0 n1 n2 ...
       m = m0 m1 m2 ...
    then n ≲ m means forall any i, n[i] <= m[i] *)

Inductive binary_le : nat -> nat -> Prop :=
 | in_ble_0 : forall n, 0 ≲ n
 | in_ble_1 : forall n m, rem n 2 <= rem m 2 -> div n 2 ≲ div m 2 -> n ≲ m
where "x ≲ y" := (binary_le x y).(* if n and m are written in binary, LSB first:
       n = n0 n1 n2 ...
       m = m0 m1 m2 ...
    then n ≲ m means forall any i, n[i] <= m[i] *)

Inductive binary_le : nat -> nat -> Prop :=
 | in_ble_0 : forall n, 0 ≲ n
 | in_ble_1 : forall n m, rem n 2 <= rem m 2 -> div n 2 ≲ div m 2 -> n ≲ m
where "x ≲ y" := (binary_le x y).Fact binary_le_inv n m : n ≲ m -> n = 0 \/ div n 2 ≲ div m 2 /\ rem n 2 <= rem m 2.Fact binary_le_refl x : x ≲ x.Fact binary_le_le x y : x ≲ y -> x <= y.Fact binary_le_zero_inv n : n ≲ 0 -> n = 0.Fact binary_le_zero n : 0 ≲ n.Definition bool2nat x := 
  match x with 
    | ⟘ => 0 
    | ⟙ => 1 
  end.Fact rem_2_bool2nat b n : rem (bool2nat b+2*n) 2 = bool2nat b.Fact div_2_bool2nat b n : div (bool2nat b+2*n) 2 = n.Definition nat2bool x := 
  match x with 
    | 0 => ⟘ 
    | _ => ⟙ 
  end.Fact bool2nat2bool : forall x, x < 2 -> bool2nat (nat2bool x) = x.Fact nat2bool2nat : forall x, nat2bool (bool2nat x) = x.Local Notation lb := (list bool).(* Section lb_nat. *)

  Fixpoint lb_nat (l : lb) :=
    match l with
      | nil    => 0
      | x :: l => bool2nat x + 2*⟦l⟧
    end
  where "⟦ l ⟧" := (lb_nat l).(* Section lb_nat. *)

  Fixpoint lb_nat (l : lb) :=
    match l with
      | nil    => 0
      | x :: l => bool2nat x + 2*⟦l⟧
    end
  where "⟦ l ⟧" := (lb_nat l).Fact lb_nat_fix_0 : ⟦nil⟧ = 0.Fact lb_nat_fix_1 l : ⟦⟘::l⟧ = 2*⟦l⟧.Fact lb_nat_fix_2 l : ⟦⟙::l⟧ = 1+2*⟦l⟧.Fact lb_nat_fix_3 x l : ⟦x::l⟧ = bool2nat x+2*⟦l⟧.Fact lb_nat_app l m : lb_nat (l++m) = lb_nat l + (power (length l) 2)*(lb_nat m).Inductive g_nlb : nat -> lb -> Prop :=
      | in_gnlb_0 : g_nlb 0 nil
      | in_gnlb_1 : forall n l, n <> 0 -> rem n 2 = 0 -> g_nlb (div n 2) l -> g_nlb n (⟘::l)
      | in_gnlb_2 : forall n l, n <> 0 -> rem n 2 = 1 -> g_nlb (div n 2) l -> g_nlb n (⟙::l).Inductive g_nlb : nat -> lb -> Prop :=
      | in_gnlb_0 : g_nlb 0 nil
      | in_gnlb_1 : forall n l, n <> 0 -> rem n 2 = 0 -> g_nlb (div n 2) l -> g_nlb n (⟘::l)
      | in_gnlb_2 : forall n l, n <> 0 -> rem n 2 = 1 -> g_nlb (div n 2) l -> g_nlb n (⟙::l).Inductive g_nlb : nat -> lb -> Prop :=
      | in_gnlb_0 : g_nlb 0 nil
      | in_gnlb_1 : forall n l, n <> 0 -> rem n 2 = 0 -> g_nlb (div n 2) l -> g_nlb n (⟘::l)
      | in_gnlb_2 : forall n l, n <> 0 -> rem n 2 = 1 -> g_nlb (div n 2) l -> g_nlb n (⟙::l).Inductive g_nlb : nat -> lb -> Prop :=
      | in_gnlb_0 : g_nlb 0 nil
      | in_gnlb_1 : forall n l, n <> 0 -> rem n 2 = 0 -> g_nlb (div n 2) l -> g_nlb n (⟘::l)
      | in_gnlb_2 : forall n l, n <> 0 -> rem n 2 = 1 -> g_nlb (div n 2) l -> g_nlb n (⟙::l).Fact g_nlb_fun n l1 l2 : g_nlb n l1 -> g_nlb n l2 -> l1 = l2.Definition nat_lb n := proj1_sig (nat_lb_full n).Fact nat_lb_spec n : g_nlb n (nat_lb n).Fact nat_lb_fix_0 : ⟬ 0⟭ = nil.Fact nat_lb_fix_1 n : n <> 0 -> ⟬ 2*n⟭ = ⟘::⟬ n⟭ .Fact nat_lb_fix_2 n : ⟬1+2*n⟭ = ⟙::⟬ n⟭ .Fact nat_lb_1 : ⟬ 1⟭ = ⟙::nil.Fact lb_nat_lb n : ⟦⟬ n ⟭⟧ = n.Fact nat_lb_length x n : x < power n 2 -> length ⟬ x ⟭ <= n.Definition nat_lb_nat := lb_mask_nat.Fact binary_le_trans x y z : x ≲ y -> y ≲ z -> x ≲ z.Local Notation lbeq := lb_mask_equiv (only parsing).(*
  Hint Resolve dio_rel_binomial dio_rel_remainder.

  Section binary_le_dio.

    Let ble_equiv x y : x ≲ y <-> exists b, b = binomial y x /\ 1 = rem b 2.
    Proof.
      rewrite binary_le_binomial; split; eauto.
      intros (? & ? & ?); subst; auto.
    Qed.

    Theorem binary_le_diophatine x y : 
             dio_expression x
          -> dio_expression y
          -> dio_rel (fun v => x v ≲ y v).
    Proof.
      intros. 
      apply dio_rel_equiv with (1 := fun v => ble_equiv (x v) (y v)).
      dio_rel_auto.
    Qed.

  End binary_le_dio.

  Definition lb_dio (R : (nat -> lb) -> Prop) := { f | forall v, df_pred f (fun n => ⟦v n⟧) <-> R v }.

  Theorem lb_mask_diophantine x y : lb_dio (fun v => v x ⪯  v y).
  Proof.
    destruct (binary_le_diophatine (dio_expr_var x) (dio_expr_var y)) as (f & Hf).
    exists f; intros v; rewrite Hf, lb_mask_eq_binary_le; tauto.
  Qed.

*)

  Definition bool_add_with_rem a b c : bool * bool :=
    match a, b, c with 
     | ⟘, ⟘, ⟘ => (⟘,⟘)
     | ⟘, ⟘, ⟙ => (⟘,⟙)
     | ⟘, ⟙, ⟘ => (⟘,⟙)
     | ⟘, ⟙, ⟙ => (⟙,⟘)
     | ⟙, ⟘, ⟘ => (⟘,⟙)
     | ⟙, ⟘, ⟙ => (⟙,⟘)
     | ⟙, ⟙, ⟘ => (⟙,⟘)
     | ⟙, ⟙, ⟙ => (⟙,⟙)
    end.Notation bin_add := bool_add_with_rem.Fact bin_add_eq_00x x : bin_add ⟘ ⟘  x = (⟘,x).Fact bin_add_eq_0x0 x : bin_add ⟘ x ⟘  = (⟘,x).Fixpoint lb_succ a l :=
    match l with
      | nil  => a::nil
      | x::l => let (r,z) := bin_add ⟘ a x in z::lb_succ r l
    end.Fact lb_succ_spec_0 l : ⟦lb_succ ⟘ l⟧ = ⟦l⟧.Fact lb_succ_spec_1 l : ⟦lb_succ ⟙ l⟧ = S ⟦l⟧.Fact lb_succ_spec a l : ⟦lb_succ a l⟧ = bool2nat a + ⟦l⟧.Fixpoint lb_plus a l m :=
    match l, m with
      | nil,   m   => lb_succ a m
      | l,    nil  => lb_succ a l
      | x::l, y::m => let (r,z) := bin_add a x y in z::lb_plus r l m
    end.Fact lb_plus_fix_0 a l : lb_plus a nil l = lb_succ a l.Fact lb_plus_fix_1 a l : lb_plus a l nil = lb_succ a l.Fact lb_plus_fix_2 a x y l m : lb_plus a (x::l) (y::m) = let (r,z) := bin_add a x y in z::lb_plus r l m.Fact lb_plus_spec a l m : ⟦lb_plus a l m⟧ = bool2nat a + ⟦l⟧ + ⟦m⟧.(* End lb_nat. *)

  Fixpoint lb_bots n :=
    match n with 
      | 0   => nil
      | S n => ⟘ :: lb_bots n
    end.Definition lb_shift n l := lb_bots n ++ l.Fact lb_shift_0 l : lb_shift 0 l = l.Fact lb_shift_S n l : lb_shift (S n) l = ⟘ :: lb_shift n l.Fact lb_nat_shift n l : ⟦lb_shift n l⟧ = ⟦l⟧*power n 2.Fact power_2_minus_1 n : power (S n) 2 - 1 = 1 + 2*(power n 2 - 1).Fact power_2_minus_1_gt n x : x < power n 2 <-> x ≲ power n 2 - 1.

(* Specifications: *)
Lemma nat_join_monoid : monoid_theory nat_join 0.