(* Definition of the trees and operations on them *)

  Inductive ShareTree : Set :=
  | Leaf : bool -> ShareTree
  | Node : ShareTree -> ShareTree -> ShareTree
  .(* Definition of the trees and operations on them *)

  Inductive ShareTree : Set :=
  | Leaf : bool -> ShareTree
  | Node : ShareTree -> ShareTree -> ShareTree
  .(* Definition of the trees and operations on them *)

  Inductive ShareTree : Set :=
  | Leaf : bool -> ShareTree
  | Node : ShareTree -> ShareTree -> ShareTree
  .Fixpoint nonFullTree (x:ShareTree) : Prop :=
   match x with
   | Leaf b   => b = false
   | Node l r => nonFullTree l \/ nonFullTree r
   end.Fixpoint nonEmptyTree (x:ShareTree) : Prop :=
   match x with
   | Leaf b   => b = true
   | Node l r => nonEmptyTree l \/ nonEmptyTree r
   end.Fixpoint canonicalTree (x:ShareTree) : Prop :=
   match x with
   | Leaf _   => True
   | Node l r => nonFullTree x /\ nonEmptyTree x /\
                 canonicalTree l /\ canonicalTree r
   end.Fixpoint union_tree (x y:ShareTree) { struct x } : ShareTree :=
    match x with
    | Leaf true  => Leaf true
    | Leaf false => y
    | Node l1 r1 =>
       match y with
       | Leaf true  => Leaf true
       | Leaf false => x
       | Node l2 r2 =>
            Node (union_tree l1 l2) (union_tree r1 r2)
       end
    end.Fixpoint intersect_tree (x y:ShareTree) { struct x } : ShareTree :=
    match x with
    | Leaf false => Leaf false
    | Leaf true  => y
    | Node l1 r1 =>
       match y with
       | Leaf false => Leaf false
       | Leaf true  => x
       | Node l2 r2 =>
            Node (intersect_tree l1 l2) (intersect_tree r1 r2)
       end
    end.Fixpoint comp_tree (x:ShareTree) : ShareTree :=
    match x with
    | Leaf b => Leaf (negb b)
    | Node l r => Node (comp_tree l) (comp_tree r)
    end.Fixpoint mkCanon (x:ShareTree) : ShareTree :=
    match x with
    | Leaf b => Leaf b
    | Node l r =>
       let l' := mkCanon l in
       let r' := mkCanon r in
       match l', r' with
       | Leaf b1, Leaf b2 =>
          if bool_dec b1 b2
             then Leaf b1
             else Node l' r'
       | _, _ => Node l' r'
       end
    end.Fixpoint relativ_tree (z a:ShareTree) {struct z} : ShareTree :=
    match z with
    | Leaf true  => a
    | Leaf false => Leaf false
    | Node l r   => Node (relativ_tree l a) (relativ_tree r a)
    end.(* The ordering relation on trees, and its induced isomorphism. *)

  Inductive shareTreeOrd : ShareTree -> ShareTree -> Prop :=
  | Leaf_Ord : forall b1 b2, implb b1 b2 = true ->
       shareTreeOrd (Leaf b1) (Leaf b2)
  | LeafNode_Ord : forall b l r,
       shareTreeOrd (Node (Leaf b) (Leaf b)) (Node l r) ->
       shareTreeOrd (Leaf b) (Node l r)
  | NodeLeaf_Ord : forall b l r,
       shareTreeOrd (Node l r) (Node (Leaf b) (Leaf b)) ->
       shareTreeOrd (Node l r) (Leaf b)
  | Node_Ord : forall l1 l2 r1 r2,
       shareTreeOrd l1 l2 ->
       shareTreeOrd r1 r2 ->
       shareTreeOrd (Node l1 r1) (Node l2 r2)
  .(* The ordering relation on trees, and its induced isomorphism. *)

  Inductive shareTreeOrd : ShareTree -> ShareTree -> Prop :=
  | Leaf_Ord : forall b1 b2, implb b1 b2 = true ->
       shareTreeOrd (Leaf b1) (Leaf b2)
  | LeafNode_Ord : forall b l r,
       shareTreeOrd (Node (Leaf b) (Leaf b)) (Node l r) ->
       shareTreeOrd (Leaf b) (Node l r)
  | NodeLeaf_Ord : forall b l r,
       shareTreeOrd (Node l r) (Node (Leaf b) (Leaf b)) ->
       shareTreeOrd (Node l r) (Leaf b)
  | Node_Ord : forall l1 l2 r1 r2,
       shareTreeOrd l1 l2 ->
       shareTreeOrd r1 r2 ->
       shareTreeOrd (Node l1 r1) (Node l2 r2)
  .(* The ordering relation on trees, and its induced isomorphism. *)

  Inductive shareTreeOrd : ShareTree -> ShareTree -> Prop :=
  | Leaf_Ord : forall b1 b2, implb b1 b2 = true ->
       shareTreeOrd (Leaf b1) (Leaf b2)
  | LeafNode_Ord : forall b l r,
       shareTreeOrd (Node (Leaf b) (Leaf b)) (Node l r) ->
       shareTreeOrd (Leaf b) (Node l r)
  | NodeLeaf_Ord : forall b l r,
       shareTreeOrd (Node l r) (Node (Leaf b) (Leaf b)) ->
       shareTreeOrd (Node l r) (Leaf b)
  | Node_Ord : forall l1 l2 r1 r2,
       shareTreeOrd l1 l2 ->
       shareTreeOrd r1 r2 ->
       shareTreeOrd (Node l1 r1) (Node l2 r2)
  .(* The ordering relation on trees, and its induced isomorphism. *)

  Inductive shareTreeOrd : ShareTree -> ShareTree -> Prop :=
  | Leaf_Ord : forall b1 b2, implb b1 b2 = true ->
       shareTreeOrd (Leaf b1) (Leaf b2)
  | LeafNode_Ord : forall b l r,
       shareTreeOrd (Node (Leaf b) (Leaf b)) (Node l r) ->
       shareTreeOrd (Leaf b) (Node l r)
  | NodeLeaf_Ord : forall b l r,
       shareTreeOrd (Node l r) (Node (Leaf b) (Leaf b)) ->
       shareTreeOrd (Node l r) (Leaf b)
  | Node_Ord : forall l1 l2 r1 r2,
       shareTreeOrd l1 l2 ->
       shareTreeOrd r1 r2 ->
       shareTreeOrd (Node l1 r1) (Node l2 r2)
  .(* The ordering relation on trees, and its induced isomorphism. *)

  Inductive shareTreeOrd : ShareTree -> ShareTree -> Prop :=
  | Leaf_Ord : forall b1 b2, implb b1 b2 = true ->
       shareTreeOrd (Leaf b1) (Leaf b2)
  | LeafNode_Ord : forall b l r,
       shareTreeOrd (Node (Leaf b) (Leaf b)) (Node l r) ->
       shareTreeOrd (Leaf b) (Node l r)
  | NodeLeaf_Ord : forall b l r,
       shareTreeOrd (Node l r) (Node (Leaf b) (Leaf b)) ->
       shareTreeOrd (Node l r) (Leaf b)
  | Node_Ord : forall l1 l2 r1 r2,
       shareTreeOrd l1 l2 ->
       shareTreeOrd r1 r2 ->
       shareTreeOrd (Node l1 r1) (Node l2 r2)
  .Definition shareTreeEq (x y:ShareTree) :=
      shareTreeOrd x y /\ shareTreeOrd y x.Ltac destruct_bool :=
    repeat (match goal with [ b:bool |- _ ] => destruct b end).Ltac invert_ord :=
    repeat (
    match goal with
    | [ H:shareTreeEq _ _ |- _ ] => destruct H
    | [ H:shareTreeOrd (Leaf _) (Leaf _) |- _ ] => inversion H; clear H
    | [ H:shareTreeOrd (Leaf _) (Node _ _) |- _ ] => inversion H; clear H
    | [ H:shareTreeOrd (Node _ _) (Leaf _) |- _ ] => inversion H; clear H
    | [ H:shareTreeOrd (Node _ _) (Node _ _) |- _ ] => inversion H; clear H
    end; subst).

(* Specifications: *)
Lemma nonEmpty_dec : forall x, {nonEmptyTree x}+{~nonEmptyTree x}.
Lemma nonFull_dec : forall x, {nonFullTree x}+{~nonFullTree x}.
Lemma geTrueFull : forall x, shareTreeOrd (Leaf true) x -> ~nonFullTree x.
Lemma leFalseEmpty : forall x, shareTreeOrd x (Leaf false) -> ~nonEmptyTree x.
Lemma emptyLeFalse : forall x, ~nonEmptyTree x -> shareTreeOrd x (Leaf false).
Lemma fullGeTrue : forall x, ~nonFullTree x -> shareTreeOrd (Leaf true) x.
Lemma falseLeaf_bottom : forall x, shareTreeOrd (Leaf false) x.
Lemma trueLeaf_top : forall x, shareTreeOrd x (Leaf true).
Lemma eqFalseLeaf_empty : forall x, shareTreeEq (Leaf false) x -> ~nonEmptyTree x.
Lemma eqTrueLeaf_full : forall x, shareTreeEq (Leaf true) x -> ~nonFullTree x.
Lemma emptyTree_canonical_falseLeaf : forall x, ~nonEmptyTree x -> canonicalTree x -> x = Leaf false.
Lemma fullTree_canonical_trueLeaf : forall x, ~nonFullTree x -> canonicalTree x -> x = Leaf true.
Lemma shareTreeOrd_refl : forall x, shareTreeOrd x x.
Lemma shareTreeOrd_trans_leaf : forall x1 b x3, shareTreeOrd x1 (Leaf b) -> shareTreeOrd (Leaf b) x3 -> shareTreeOrd x1 x3.
Lemma shareTreeOrd_trans : forall x1 x2 x3, shareTreeOrd x1 x2 -> shareTreeOrd x2 x3 -> shareTreeOrd x1 x3.
Lemma shareTreeEq_refl : forall x, shareTreeEq x x.
Lemma shareTreeEq_sym : forall x y, shareTreeEq x y -> shareTreeEq y x.
Lemma shareTreeEq_trans : forall x y z, shareTreeEq x y -> shareTreeEq y z -> shareTreeEq x z.
Lemma mkCanon_correct : forall x, canonicalTree (mkCanon x).
Lemma mkCanon_eq : forall x, shareTreeEq x (mkCanon x).
Lemma mkCanon_test : forall x y, mkCanon x = mkCanon y -> shareTreeEq x y.
Lemma mkCanon_nonEmpty : forall x, nonEmptyTree x -> nonEmptyTree (mkCanon x).
Lemma union_commute : forall x y, union_tree x y = union_tree y x.
Lemma intersect_commute : forall x y, intersect_tree x y = intersect_tree y x.
Lemma union_upper_bound : forall x y, shareTreeOrd x (union_tree x y).
Lemma intersection_lower_bound: forall x y, shareTreeOrd (intersect_tree x y) x.
Lemma union_least_bound : forall x y z, shareTreeOrd x z -> shareTreeOrd y z -> shareTreeOrd (union_tree x y) z.
Lemma intersection_greatest_bound : forall x y z, shareTreeOrd z x -> shareTreeOrd z y -> shareTreeOrd z (intersect_tree x y).
Lemma union_idem : forall x, x = union_tree x x.
Lemma intersect_idem : forall x, x = intersect_tree x x.
Lemma union_absorb : forall x y, x = union_tree x (intersect_tree x y).
Lemma intersect_absorb : forall x y, x = intersect_tree x (union_tree x y).
Lemma intersect_distrib : forall x y z, intersect_tree x (union_tree y z) = union_tree (intersect_tree x y) (intersect_tree x z).
Lemma union_distrib : forall x y z, union_tree x (intersect_tree y z) = intersect_tree (union_tree x y) (union_tree x z).
Lemma Node_Eq : forall x x' y y', shareTreeEq x x' -> shareTreeEq y y' -> shareTreeEq (Node x y) (Node x' y').
Lemma intersect_cong0 : forall y x x', shareTreeOrd x x' -> shareTreeOrd (intersect_tree x y) (intersect_tree x' y).
Lemma union_cong0 : forall y x x', shareTreeOrd x x' -> shareTreeOrd (union_tree x y) (union_tree x' y).
Lemma intersect_cong1 : forall x x' y, shareTreeEq x x' -> shareTreeEq (intersect_tree x y) (intersect_tree x' y).
Lemma union_cong1 : forall x x' y, shareTreeEq x x' -> shareTreeEq (union_tree x y) (union_tree x' y).
Lemma intersect_cong : forall x x' y y', shareTreeEq x x' -> shareTreeEq y y' -> shareTreeEq (intersect_tree x y) (intersect_tree x' y').
Lemma union_cong : forall x x' y y', shareTreeEq x x' -> shareTreeEq y y' -> shareTreeEq (union_tree x y) (union_tree x' y').
Lemma comp_cong0 : forall x x', shareTreeOrd x x' -> shareTreeOrd (comp_tree x') (comp_tree x).
Lemma comp_cong : forall x x', shareTreeEq x x' -> shareTreeEq (comp_tree x') (comp_tree x).
Lemma tree_comp1 : forall x, shareTreeOrd (Leaf true) (union_tree x (comp_tree x)).
Lemma tree_comp2 : forall x, shareTreeOrd (intersect_tree x (comp_tree x)) (Leaf false).
Lemma canonicalUnique : forall c1 c2, shareTreeEq c1 c2 -> canonicalTree c1 -> canonicalTree c2 -> c1 = c2.
Lemma mkCanon_test2 : forall x y, shareTreeEq x y -> mkCanon x = mkCanon y.
Lemma relativ_inv : forall a x y, nonEmptyTree a -> shareTreeOrd (relativ_tree a x) (relativ_tree a y) -> shareTreeOrd x y.
Lemma relativ_empty : forall a x, nonEmptyTree a -> nonEmptyTree x -> nonEmptyTree (relativ_tree a x).
Lemma relativ_empty1 : forall a x, nonEmptyTree (relativ_tree a x) -> nonEmptyTree a.
Lemma relativ_empty2 : forall a x, nonEmptyTree (relativ_tree a x) -> nonEmptyTree x.
Lemma relativ_full1 : forall a x, nonFullTree a -> nonFullTree (relativ_tree a x).
Lemma relativ_full2 : forall a x, nonFullTree x -> nonFullTree (relativ_tree a x).
Lemma relativ_full : forall a, relativ_tree a (Leaf true) = a.
Lemma relativ_almost_canon : forall a x, canonicalTree a -> canonicalTree x -> nonEmptyTree x -> canonicalTree (relativ_tree a x).
Lemma relativ_cong : forall a x y, shareTreeOrd x y -> shareTreeOrd (relativ_tree a x) (relativ_tree a y).
Lemma relativ_canon_commute : forall a x, canonicalTree a -> nonEmptyTree x -> mkCanon (relativ_tree a x) = relativ_tree a (mkCanon x).
Lemma relativ_intersect : forall a x y, relativ_tree a (intersect_tree x y) = intersect_tree (relativ_tree a x) (relativ_tree a y).
Lemma relativ_union : forall a x y, relativ_tree a (union_tree x y) = union_tree (relativ_tree a x) (relativ_tree a y).
Lemma relativ_assoc : forall x y z, relativ_tree x (relativ_tree y z) = relativ_tree (relativ_tree x y) z.