Definition create_token (n:nat) (fac:t) : t*t :=
      match n with
      | O => (fac,bot)
      | S n' =>
         (exist (fun x => canonicalTree x) (mkCanon (create_tok1 n' (proj1_sig fac))) (mkCanon_correct _),
          exist (fun x => canonicalTree x) (mkCanon (create_tok2 n' (proj1_sig fac))) (mkCanon_correct _))
      end.

(* Specifications: *)
Lemma create_token_correct : forall fac fac' tok x n, create_token n fac = (fac',tok) -> isTokenFactory fac x -> isTokenFactory fac' (n+x) /\ isToken tok n /\ join fac' tok fac.
Lemma fac_tok_classification : forall fac n, isTokenFactory' fac n -> forall tok m, isToken' tok m -> shareTreeOrd (intersect_tree fac tok) (Leaf false) -> ( n = m -> shareTreeEq (union_tree tok fac) (Leaf true)) /\ ( n < m -> False ) /\ ( n > m -> shareTreeEq (union_tree tok fac) (Leaf true) -> False).
Lemma token_nonbot : forall tok n, isToken' tok n -> n > 0 -> shareTreeOrd tok (Leaf false) -> False.
Lemma tokens_nonfull : forall tok1 n, isToken' tok1 n -> forall tok2 m, isToken' tok2 m -> shareTreeOrd (Leaf true) (union_tree tok1 tok2) -> False.
Lemma tokenFactory_nonbot : forall fac n, isTokenFactory' fac n -> shareTreeOrd fac (Leaf false) -> False.
Lemma absorbToken : forall fac fac' tok x n, isTokenFactory fac' (n+x) -> isToken tok n -> join fac' tok fac -> isTokenFactory fac x.
Lemma mergeToken : forall tok1 n1 tok2 n2 tok', isToken tok1 n1 -> isToken tok2 n2 -> join tok1 tok2 tok' -> isToken tok' (n1+n2).
Lemma factoryOverlap : forall f1 f2 n1 n2, isTokenFactory f1 n1 -> isTokenFactory f2 n2 -> glb f1 f2 <> bot.
Lemma fullFactory : forall x, isTokenFactory x 0 <-> x = top.
Lemma identityToken : forall x, isToken x 0 <-> x = bot.
Lemma nonidentityToken : forall x n, (n > 0)%nat -> isToken x n -> x <> bot.
Lemma nonidentityFactory : forall x n, isTokenFactory x n -> x <> bot.