Fixpoint new_fac (n:nat) {struct n} : ShareTree :=
match n with
| O => Node (Leaf false) (Leaf true)
| S n' => Node (Leaf false) (new_fac n')
end.
Fixpoint create_tok1 (n:nat) (x:ShareTree) {struct x} : ShareTree :=
match x with
| Node (Leaf true)  t2 =>
match n with
| O    => Node (Leaf false) t2
| S n' => Node (Leaf false) (create_tok1 n' t2)
end
| Node (Leaf false) t2 => Node (Leaf false) (create_tok1 n t2)
| Leaf true => new_fac n
| _  => x
end.
Fixpoint create_tok2 (n:nat) (x:ShareTree) {struct x} : ShareTree :=
match x with
| Node (Leaf true)  t2 =>
match n with
| O    => Node (Leaf true) (Leaf false)
| S n' => Node (Leaf true) (create_tok2 n' t2)
end
| Node (Leaf false) t2 => Node (Leaf false) (create_tok2 n t2)
| Leaf true => comp_tree (new_fac n)
| _ => Leaf false
end.

(* Specifications: *)
Lemma create_tok1_correct : forall fac m n,
isTokenFactory' fac n ->
isTokenFactory' (create_tok1 m fac) (S m + n).
Lemma create_tok2_correct : forall fac m n,
isTokenFactory' fac n ->
isToken' (create_tok2 m fac) (S m).
Lemma create_tok_lub : forall fac n,
shareTreeEq fac (union_tree (create_tok1 n fac) (create_tok2 n fac)).
Lemma create_tok_glb : forall fac n,
shareTreeOrd (intersect_tree (create_tok1 n fac) (create_tok2 n fac)) (Leaf false).