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.

Lemma create_tok_glb : forall fac n, shareTreeOrd (intersect_tree (create_tok1 n fac) (create_tok2 n fac)) (Leaf false).