(* * Copyright (c) 2009-2016, Andrew Appel, Robert Dockins, Aquinas Hobor, and Le Xuan Bach * *)
(** This module implements a share model via binary trees with boolean-labeled leaves.  The development is complicated somewhat by the fact the ordering used defines multiple isomorphic representations of a share.  We must therefore chose one to be a canonical representation of the equivalence class in order to get strong antisymmetry (i.e., antisymmetry up to identity).  The canonical tree is the one that contains no nonleaf full or empty subtrees. A full subtree has all leaves labeled with true, whereas an empty subtree has all leaves labeled with false.  Canonical trees always exists and are unique.  Furthermore, they can be straightforwardly calculated.  Tree union and intersection may generate noncanonical trees, so the result must be canonicalized.  However, split always generates canonical trees when given a canonical tree, as does complement. **)
Module Share <: SHARE_MODEL.
(* 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)
.
Hint Constructors shareTreeOrd.
Definition shareTreeEq (x y:ShareTree) :=
shareTreeOrd x y /\ shareTreeOrd y x.
Hint Unfold shareTreeEq.
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).
(* Utility lemmas about full and empty trees, and the top and bottom elements. *)

(* Specifications: *)
Lemma nonEmpty_dec : forall x, {nonEmptyTree x}+{~nonEmptyTree 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).