Section lb_mask_nat.
Let lb_mask_nat_1 l : ⟬ ⟦l⟧⟭  ⪯  l.
Let lb_mask_nat_2 l : l ⪯  ⟬ ⟦l⟧⟭  .
Fact lb_mask_nat l : ⟬ ⟦l⟧⟭ ≂ l.
Hint Resolve lb_mask_eq_binary_le binary_le_eq_lb_mask : core.
Fact binary_le_trans x y z : x ≲ y -> y ≲ z -> x ≲ z.
Fact lb_mask_equiv_equal l m : l ≂ m <-> ⟦l⟧ = ⟦m⟧.
Fact equal_lb_mask_equiv x y : x = y <-> ⟬ x⟭ ≂⟬ y⟭.
Local Notation lbeq := lb_mask_equiv (only parsing).
Add Parametric Morphism: (lb_nat) with signature (lbeq) ==> (eq) as lb_nat_eq.
End binary_le_dio.
Definition lb_dio (R : (nat -> lb) -> Prop) := { f | forall v, df_pred f (fun n => ⟦v n⟧) <-> R v }.
*)
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 lb_succ_spec_1 l : ⟦lb_succ ⟙ l⟧ = S ⟦l⟧.
Fact lb_succ_spec a l : ⟦lb_succ a l⟧ = bool2nat a + ⟦l⟧.
Fact lb_succ_bot l : lb_succ ⟘ l ≂ 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.
Local Infix "⊕" := (lb_plus ⟘ ) (at level 41, left associativity).
Fact lb_plus_spec_0 l m : ⟦l⊕m⟧ = ⟦l⟧ + ⟦m⟧.
Fact lb_ortho_plus l m : l ⟂ m <-> l ⪯ l⊕m.
(*  Theorem lb_ortho_diophantine x y : lb_dio (fun v => v x ⟂ v y).  *)
Fact lb_ortho_plus_join x y : x ⟂ y -> x⊕y ≂ x↑y.
Fact lb_ortho_plus_id a x y : a ⟂ x -> a ⟂ y -> x ⟂ y <-> (a⊕x)↓(a⊕y) ≂ a.
(* A purely Boolean algebraic proof *)
Fact lb_minus_plus a b : a ⪯ b -> exists x, b ≂ a⊕x /\ a ⪯  a⊕x.
(* A diophantine representation of bitwise and *)
(* A diophantine representation of bitwise or *)
Fact lb_join_dio a b c : a ≂ b↑c <-> exists x, a ≂ b⊕x /\ b ⪯  b⊕x /\ x ⪯ c /\ c ⪯ a.
(* 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_meet n l m : lb_shift n (l↓m) = (lb_shift n l)↓(lb_shift n m).
Fact lb_shift_join n l m : lb_shift n (l↑m) = (lb_shift n l)↑(lb_shift n m).
Fact lb_shift_ortho n l m : length l <= n -> l ⟂ lb_shift n m.
Fact lb_shift_ortho_meet n l m : length l <= n -> l ↓ lb_shift n m ≂ nil.
Fact nat_pow2_lb_shift n q : ⟬q*power n 2⟭ ≂ lb_shift n ⟬q⟭ .
Fact nat_euclid_pow2_lb n r q : r < power n 2 -> ⟬r+q*power n 2⟭ ≂ ⟬r⟭ ↑lb_shift n ⟬q⟭ .
Definition nat_meet n m := ⟦ ⟬n⟭↓⟬m⟭ ⟧.
Local Infix "⇣" := nat_meet (at level 40, left associativity).
Fact nat_meet_comm n m : n⇣m = m⇣n.
Fact nat_meet_left n m : n⇣m ≲ n.
Fact nat_meet_right n m : n⇣m ≲ m.
Hint Resolve nat_meet_left nat_meet_right : core.
Fact binary_le_nat_meet n m : n ≲ m <-> n⇣m = n.
(* This is how we compute the meet by division by powers of 2 *)

Lemma nat_meet_euclid_2 r1 d1 r2 d2 :
r1 < 2
-> r2 < 2
-> (r1+2*d1) ⇣ (r2+2*d2)
= (r1⇣r2) + 2*(d1⇣d2).