(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

Require Import Bool.
Require Import Sumbool.
Require Import Arith.
Require Import ZArith NArith Nnat Ndec Ndigits.
From IntMap Require Import Allmaps.
Require Import Wf_nat.

Require Import BDDvar_ad_nat.
Require Import bdd1.
Require Import bdd2.

Lemma bool_fun_one_zero_eq : ~ bool_fun_eq bool_fun_one bool_fun_zero.
Proof.
  unfold bool_fun_eq, bool_fun_zero, bool_fun_one in |- *.  unfold not in |- *.  intro H.  unfold bool_fun_eval in H.
  cut (true = false).  intro; discriminate.  apply H.  exact (fun x : BDDvar => true).
Qed.

Lemma bool_fun_zero_one_eq : ~ bool_fun_eq bool_fun_zero bool_fun_one.
Proof.
  unfold bool_fun_eq, bool_fun_zero, bool_fun_one in |- *.  unfold not in |- *.  intro H.  unfold bool_fun_eval in H.
  cut (false = true).  intro; discriminate.  apply H.  exact (fun x : BDDvar => true).
Qed.

Definition augment (vb : var_binding) (x : BDDvar)
  (b : bool) (y : BDDvar) := if BDDvar_eq x y then b else vb y.

Definition bool_fun_restrict (bf : bool_fun) (x : BDDvar)
  (b : bool) (vb : var_binding) := bool_fun_eval bf (augment vb x b).

Lemma bool_fun_restrict_zero :
 forall (x : BDDvar) (b : bool),
 bool_fun_eq (bool_fun_restrict bool_fun_zero x b) bool_fun_zero.
Proof.
  intros x b.  unfold bool_fun_eq, bool_fun_restrict, bool_fun_zero, bool_fun_one in |- *.
  intros vb.  unfold bool_fun_eval, augment in |- *.  reflexivity.
Qed.

Lemma bool_fun_restrict_one :
 forall (x : BDDvar) (b : bool),
 bool_fun_eq (bool_fun_restrict bool_fun_one x b) bool_fun_one.
Proof.
  intros x b.  unfold bool_fun_eq, bool_fun_restrict, bool_fun_zero, bool_fun_one in |- *.
  intros vb.  unfold bool_fun_eval, augment in |- *.  reflexivity.
Qed.

Lemma bool_fun_restrict_eq :
 forall (bf bf' : bool_fun) (x : BDDvar) (b : bool),
 bool_fun_eq bf bf' ->
 bool_fun_eq (bool_fun_restrict bf x b) (bool_fun_restrict bf' x b).
Proof.
  intros bf bf' x b H.  unfold bool_fun_eq in |- *.  unfold bool_fun_restrict in |- *.  unfold bool_fun_eval at 1 3 in |- *.
  intro vb.  apply H.
Qed.

Definition var_binding_eq (vb vb' : var_binding) :=
  forall x : BDDvar, vb x = vb' x.

Definition bool_fun_ext (bf : bool_fun) :=
  forall vb vb' : var_binding,
  var_binding_eq vb vb' -> bool_fun_eval bf vb = bool_fun_eval bf vb'.

Lemma bool_fun_of_BDD_1_ext :
 forall (bound : nat) (cfg : BDDconfig) (node : ad),
 bool_fun_ext (bool_fun_of_BDD_1 cfg node bound).
Proof.
  simple induction bound.  intro cfg.  elim cfg.  clear cfg.  intros bs y.  elim y.  clear y.
  intros share counter.  intros node.  simpl in |- *.  elim (MapGet (BDDvar * (ad * ad)) bs node).
  2:{ elim (N.eqb node BDDzero).  unfold bool_fun_ext in |- *.  unfold bool_fun_eval, bool_fun_zero in |- *; reflexivity.
  unfold bool_fun_ext in |- *.  unfold bool_fun_eval, bool_fun_one in |- *; reflexivity. }
  unfold bool_fun_ext in |- *.  unfold bool_fun_eval in |- *.  unfold bool_fun_zero in |- *.  intro a.
  intro vb.  intro vb'.  intro H.  elim a.  intros y y0.  elim y0.  reflexivity. intro n.
  intro H.  intro cfg.  elim cfg.  clear cfg.  intros bs y.  elim y.  clear y.  intros share counter.
  intros node.  simpl in |- *.  elim (MapGet (BDDvar * (ad * ad)) bs node). 2:{ elim (N.eqb node BDDzero).
  unfold bool_fun_ext, bool_fun_zero in |- *.  unfold bool_fun_eval in |- *; reflexivity.
  unfold bool_fun_ext, bool_fun_one in |- *.  unfold bool_fun_eval in |- *; reflexivity. } intros a.
  elim a.  intros y y0.  elim y0. intros y1 y2.  cut (bool_fun_ext (bool_fun_of_BDD_1 (bs, (share, counter)) y2 n)).
  intro H0.  cut (bool_fun_ext (bool_fun_of_BDD_1 (bs, (share, counter)) y1 n)).  intro H1.
  unfold bool_fun_ext in |- *.  intros vb vb' H2.  unfold bool_fun_eval in |- *.  unfold bool_fun_ext in H0, H1.
  unfold bool_fun_eval in H0, H1.  rewrite (H1 vb vb' H2).  rewrite (H0 vb vb' H2).
  unfold var_binding_eq in H2.  rewrite (H2 y).  reflexivity.  apply H.  apply H.
Qed.

Lemma bool_fun_of_BDD_ext :
 forall (cfg : BDDconfig) (node : ad),
 bool_fun_ext (bool_fun_of_BDD cfg node).
Proof.
  unfold bool_fun_of_BDD in |- *.  intros cfg node.  apply bool_fun_of_BDD_1_ext.
Qed.

Lemma augment_eq :
 forall (vb : var_binding) (x : BDDvar) (b : bool),
 vb x = b -> var_binding_eq (augment vb x b) vb.
Proof.
  unfold var_binding_eq in |- *.  intros vb x b H x0.  unfold augment in |- *.  elim (sumbool_of_bool (BDDvar_eq x x0)).
  intro y.  rewrite y.  cut (x = x0).  intro H0.  rewrite <- H0.  rewrite H; reflexivity.
  apply Neqb_complete.  exact y.  intro y.  rewrite y.  reflexivity.
Qed.

Definition bool_fun_independent (bf : bool_fun) (x : BDDvar) :=
  forall vb : var_binding,
  bool_fun_eval bf (augment vb x true) =
  bool_fun_eval bf (augment vb x false).

Lemma bool_fun_independent_lemma :
 forall (bf : bool_fun) (x : BDDvar) (vb : var_binding) (b : bool),
 bool_fun_ext bf ->
 bool_fun_independent bf x ->
 bool_fun_eval bf (augment vb x b) = bool_fun_eval bf vb.
Proof.
  intros bf x vb b H H0.  elim (sumbool_of_bool (vb x)).  intro y.  elim b.  cut (var_binding_eq (augment vb x true) vb).
  intro H1.  rewrite (H (augment vb x true) vb H1).  cut (bool_fun_eval bf (augment vb x true) = bool_fun_eval bf vb).
  unfold bool_fun_eval in |- *.  intro H2.  reflexivity.  rewrite (H (augment vb x true) vb H1).
  reflexivity.  apply augment_eq.  assumption.  rewrite <- (H0 vb).  cut (var_binding_eq (augment vb x true) vb).
  intro H1.  rewrite (H (augment vb x true) vb H1).  cut (bool_fun_eval bf (augment vb x true) = bool_fun_eval bf vb).
  unfold bool_fun_eval in |- *.  intro H2.  reflexivity.  rewrite (H (augment vb x true) vb H1).
  reflexivity.  apply augment_eq.  assumption.  intro y.  elim b.  cut (var_binding_eq (augment vb x false) vb).
  intro H1.  cut (bool_fun_eval bf (augment vb x false) = bool_fun_eval bf vb).
  intro H2.  rewrite <- H2.  apply H0.  apply H.  assumption.  apply augment_eq.
  assumption.  cut (var_binding_eq (augment vb x false) vb).  intro H1.  apply H.
  assumption.  apply augment_eq.  assumption.
Qed.

Lemma bool_fun_independent_zero :
 forall (cfg : BDDconfig) (x : BDDvar),
 BDDconfig_OK cfg -> bool_fun_independent (bool_fun_of_BDD cfg BDDzero) x.
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros x H.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)).
  unfold bool_fun_independent in |- *.  intro vb.  unfold bool_fun_eval, bool_fun_zero in |- *.  reflexivity.
Qed.

Lemma bool_fun_independent_one :
 forall (cfg : BDDconfig) (x : BDDvar),
 BDDconfig_OK cfg -> bool_fun_independent (bool_fun_of_BDD cfg BDDone) x.
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros x H.  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
   .
  unfold bool_fun_independent in |- *.  intro vb.  unfold bool_fun_eval, bool_fun_one in |- *.  reflexivity.
Qed.

Lemma in_dom_is_internal :
 forall (cfg : BDDconfig) (node : ad),
 in_dom _ node (fst cfg) = true -> is_internal_node cfg node.
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros node H.  elim (option_sum _ (MapGet _ (fst (bs, (share, counter))) node)).  intros y.
  elim y. intro x.  elim x. intro y0. intro y1.  elim y1. intros y2 y3 y4.  split with y0; split with y2; split with y3; assumption.
  intro y.  unfold in_dom in H.  rewrite y in H.  discriminate H.
Qed.

Lemma internal_node_lemma :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 N.eqb (low cfg node) (high cfg node) = false /\
 BDDbounded (fst cfg) (low cfg node) (var cfg node) /\
 BDDbounded (fst cfg) (high cfg node) (var cfg node).
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros node H H0.  elim H.  intros H1 H2.  elim H1.  intros H3 H4.  inversion H0.  inversion H5.
  inversion H6.  cut (BDD_OK bs node).  unfold BDD_OK in |- *.  unfold BDDordered in |- *.  simpl in H7; rewrite H7.
  intro H8.  unfold var, high, low in |- *.  simpl in |- *.  rewrite H7.  cut
   (node = BDDzero \/
    node = BDDone \/
    (exists x' : BDDvar,
       (exists l' : BDDvar,
          (exists r' : BDDvar,
             MapGet _ bs node = Some (x', (l', r')) /\
             BDDcompare x' (ad_S x) = Datatypes.Lt /\
             N.eqb l' r' = false /\
             BDDbounded bs l' x' /\ BDDbounded bs r' x')))).
  intros H9.  elim H9; intros.  rewrite H10 in H7; rewrite H3 in H7; discriminate.
  elim H10; intros.  rewrite H11 in H7; rewrite (proj1 H4) in H7; discriminate.
  inversion H11.  inversion H12.  inversion H13.  inversion H14.  rewrite H7 in H15.
  injection H15.  intros H17 H18 H19.  rewrite <- H17 in H16.  rewrite <- H18 in H16.  rewrite <- H19 in H16.
  exact (proj2 H16).  apply BDDbounded_lemma.  assumption.  apply (proj2 H4).
  unfold in_dom in |- *; simpl in H7; rewrite H7; reflexivity.
Qed.

Lemma high_bounded :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 BDDbounded (fst cfg) (high cfg node) (var cfg node).
Proof.
intros cfg node H H0.  exact (proj2 (proj2 (internal_node_lemma cfg node H H0))).
Qed.

Lemma low_bounded :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 BDDbounded (fst cfg) (low cfg node) (var cfg node).
Proof.
intros cfg node H H0.  exact (proj1 (proj2 (internal_node_lemma cfg node H H0))).
Qed.

Lemma high_OK :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node -> config_node_OK cfg (high cfg node).
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros node H H0.  inversion H0.  inversion H1.  inversion H2.  unfold high in |- *.  rewrite H3.
  cut
   (BDDbounded (fst (bs, (share, counter)))
      (high (bs, (share, counter)) node) (var (bs, (share, counter)) node)).
  unfold var, high in |- *.  rewrite H3.  intro H4.  unfold config_node_OK in |- *.  apply BDDbounded_node_OK with (n := x).
  assumption.  apply high_bounded.  assumption.  assumption.
Qed.

Lemma low_OK :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node -> config_node_OK cfg (low cfg node).
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros node H H0.  inversion H0.  inversion H1.  inversion H2.  unfold low in |- *.  rewrite H3.
  cut
   (BDDbounded (fst (bs, (share, counter))) (low (bs, (share, counter)) node)
      (var (bs, (share, counter)) node)).
  unfold var, low in |- *.  rewrite H3.  intro H4.  unfold config_node_OK in |- *.  apply BDDbounded_node_OK with (n := x).
  assumption.  apply low_bounded.  assumption.  assumption.
Qed.

Lemma low_high_neq :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node -> N.eqb (low cfg node) (high cfg node) = false.
Proof.
  intros cfg node H H0.  exact (proj1 (internal_node_lemma cfg node H H0)).
Qed.

Lemma BDDvar_independent_1 :
 forall (cfg : BDDconfig) (n : nat) (node : ad) (x : BDDvar),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 n = nat_of_N (var cfg node) ->
 BDDcompare (var cfg node) x = Datatypes.Lt ->
 bool_fun_independent (bool_fun_of_BDD cfg node) x.
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intro n.  apply
   lt_wf_ind
    with
      (P := fun n : nat =>
            forall (node : ad) (x : BDDvar),
            BDDconfig_OK (bs, (share, counter)) ->
            is_internal_node (bs, (share, counter)) node ->
            n = nat_of_N (var (bs, (share, counter)) node) ->
            BDDcompare (var (bs, (share, counter)) node) x = Datatypes.Lt ->
            bool_fun_independent
              (bool_fun_of_BDD (bs, (share, counter)) node) x).
  intros n0 H node x H0 H1 H2 H3.  cut
   (bool_fun_independent
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node)) x).
  cut
   (bool_fun_independent
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node)) x).
  intros H4 H5.  rewrite
   (proj2 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H0)) node
      H1).
  unfold bool_fun_independent in |- *.  unfold bool_fun_eval in |- *.  intro vb.  unfold bool_fun_independent in H4, H5.
  unfold bool_fun_eval in H4, H5.  inversion H1.  inversion H6.  inversion H7.
  unfold var, high, low in |- *.  rewrite H8.  unfold augment at 1 4 in |- *.  cut (BDDvar_eq x x0 = false).
  intro H9.  rewrite H9.  unfold var, high, low in H5, H4.  rewrite H8 in H4.  rewrite H8 in H5.
  rewrite (H4 vb).  rewrite (H5 vb).  reflexivity.  unfold BDDvar_eq in |- *.  cut (N.eqb x x0 <> true).
  elim (N.eqb x x0).  intro H9.  absurd (true = true).  assumption.  reflexivity.  reflexivity.
  unfold not in |- *.  intro H9.  unfold var in H3.  rewrite H8 in H3.  cut (nat_of_N x0 < nat_of_N x).
  cut (x = x0).  intro H10.  rewrite H10.  exact (lt_irrefl (nat_of_N x0)).  apply Neqb_complete.
  assumption.  apply BDDcompare_lt.  assumption.  cut (node_OK bs (high (bs, (share, counter)) node)).
  intro H4.  elim H4.  intro H5.  rewrite H5.  apply bool_fun_independent_zero.  assumption.
  intro H5.  elim H5; intro H6.  rewrite H6.  apply bool_fun_independent_one.  assumption.
  apply
   H
    with
      (m := nat_of_N
              (var (bs, (share, counter)) (high (bs, (share, counter)) node))).
  rewrite H2.  apply BDDcompare_lt.  apply BDDvar_ordered_high.  assumption.
  assumption.  unfold is_internal_node in |- *.  elim
   (option_sum _
      (MapGet (BDDvar * (ad * ad)) (fst (bs, (share, counter)))
         (high (bs, (share, counter)) node))).
  intro y.  elim y.  intro x0.  elim x0. intro y0. intro y1.  elim y1. intro y2. intro y3.
  split with y0.  split with y2.  split with y3.  assumption.  intro y.  unfold in_dom in H6.
  simpl in y.  rewrite y in H6.  discriminate H6.  assumption.  apply in_dom_is_internal.
  assumption.  reflexivity.  apply BDDcompare_trans with (y := var (bs, (share, counter)) node).
  apply BDDvar_ordered_high.  assumption.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  exact (high_OK (bs, (share, counter)) node H0 H1).
  cut (node_OK bs (low (bs, (share, counter)) node)).  intro H4.  elim H4.  intro H5.
  rewrite H5.  apply bool_fun_independent_zero.  assumption.  intro H5.  elim H5; intro H6.
  rewrite H6.  apply bool_fun_independent_one.  assumption.  apply
   H
    with
      (m := nat_of_N
              (var (bs, (share, counter)) (low (bs, (share, counter)) node))).
  rewrite H2.  apply BDDcompare_lt.  apply BDDvar_ordered_low.  assumption.
  assumption.  apply in_dom_is_internal.  assumption.  assumption.  apply in_dom_is_internal.
  assumption.  reflexivity.  apply BDDcompare_trans with (y := var (bs, (share, counter)) node).
  apply BDDvar_ordered_low.  assumption.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  exact (low_OK (bs, (share, counter)) node H0 H1).
Qed.

Lemma BDDvar_independent_high :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 bool_fun_independent (bool_fun_of_BDD cfg (high cfg node)) (var cfg node).
Proof.
  intros cfg node H H0.  cut (config_node_OK cfg (high cfg node)).  intros H1.  elim H1.  intro H2.
  rewrite H2.  apply bool_fun_independent_zero.  assumption.  intro H2.  elim H2; intro.
  rewrite H3; apply bool_fun_independent_one; assumption.  cut (is_internal_node cfg (high cfg node)).
  intro H4.  apply BDDvar_independent_1 with (n := nat_of_N (var cfg (high cfg node))).
  assumption.  apply in_dom_is_internal.  assumption.  reflexivity.  apply BDDvar_ordered_high.
  assumption.  assumption.  assumption.  apply in_dom_is_internal.  assumption.
  apply high_OK.  assumption.  assumption.
Qed.

Lemma BDDvar_independent_low :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 bool_fun_independent (bool_fun_of_BDD cfg (low cfg node)) (var cfg node).
Proof.
  intros cfg node H H0.  cut (config_node_OK cfg (low cfg node)).  intros H1.  elim H1.  intro H2.
  rewrite H2.  apply bool_fun_independent_zero.  assumption.  intro H2.  elim H2; intro.
  rewrite H3; apply bool_fun_independent_one; assumption.  cut (is_internal_node cfg (low cfg node)).
  intro H4.  apply BDDvar_independent_1 with (n := nat_of_N (var cfg (low cfg node))).
  assumption.  apply in_dom_is_internal.  assumption.  reflexivity.  apply BDDvar_ordered_low.
  assumption.  assumption.  assumption.  apply in_dom_is_internal.  assumption.
  apply low_OK.  assumption.  assumption.
Qed.

Lemma bool_fun_of_BDDzero :
 forall cfg : BDDconfig,
 BDDconfig_OK cfg -> bool_fun_eq (bool_fun_of_BDD cfg BDDzero) bool_fun_zero.
Proof.
  intros cfg H.  unfold bool_fun_eq in |- *.  unfold bool_fun_eval in |- *.  intro vb.
  rewrite (proj1 (bool_fun_of_BDD_semantics cfg H)).  reflexivity.
Qed.

Lemma bool_fun_of_BDDone :
 forall cfg : BDDconfig,
 BDDconfig_OK cfg -> bool_fun_eq (bool_fun_of_BDD cfg BDDone) bool_fun_one.
Proof.
  intros cfg H.  unfold bool_fun_eq in |- *.  unfold bool_fun_eval in |- *.  intro vb.
  rewrite (proj1 (proj2 (bool_fun_of_BDD_semantics cfg H))).  reflexivity.
Qed.

Lemma bool_fun_of_BDDhigh :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 bool_fun_eq (bool_fun_of_BDD cfg (high cfg node))
   (bool_fun_restrict (bool_fun_of_BDD cfg node) (var cfg node) true).
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros node H H0.  rewrite
   (proj2 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)) node
      H0).
  unfold bool_fun_restrict in |- *.  unfold bool_fun_eval in |- *.  unfold bool_fun_eq in |- *.  unfold bool_fun_eval in |- *.
  unfold augment at 1 in |- *.  unfold BDDvar_eq in |- *.  cut
   (N.eqb (var (bs, (share, counter)) node) (var (bs, (share, counter)) node) =
    true).
  intro H1.  rewrite H1.  intro vb.  cut
   (bool_fun_of_BDD (bs, (share, counter)) (high (bs, (share, counter)) node)
      (augment vb (var (bs, (share, counter)) node) true) =
    bool_fun_of_BDD (bs, (share, counter)) (high (bs, (share, counter)) node)
      vb).
  intro H2.  rewrite H2.  reflexivity.  change
    (bool_fun_eval
       (bool_fun_of_BDD (bs, (share, counter))
          (high (bs, (share, counter)) node))
       (augment vb (var (bs, (share, counter)) node) true) =
     bool_fun_eval
       (bool_fun_of_BDD (bs, (share, counter))
          (high (bs, (share, counter)) node)) vb) in |- *.
  apply bool_fun_independent_lemma.  apply bool_fun_of_BDD_ext.  apply BDDvar_independent_high.
  assumption.  assumption.  apply Neqb_correct.
Qed.

Lemma bool_fun_of_BDDlow :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 bool_fun_eq (bool_fun_of_BDD cfg (low cfg node))
   (bool_fun_restrict (bool_fun_of_BDD cfg node) (var cfg node) false).
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros node H H0.  rewrite
   (proj2 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)) node
      H0).
  unfold bool_fun_restrict in |- *.  unfold bool_fun_eval in |- *.  unfold bool_fun_eq in |- *.  unfold bool_fun_eval in |- *.
  unfold augment at 1 in |- *.  unfold BDDvar_eq in |- *.  cut
   (N.eqb (var (bs, (share, counter)) node) (var (bs, (share, counter)) node) =
    true).
  intro H1.  rewrite H1.  intro vb.  cut
   (bool_fun_of_BDD (bs, (share, counter)) (low (bs, (share, counter)) node)
      (augment vb (var (bs, (share, counter)) node) false) =
    bool_fun_of_BDD (bs, (share, counter)) (low (bs, (share, counter)) node)
      vb).
  intro H2.  rewrite H2.  reflexivity.  change
    (bool_fun_eval
       (bool_fun_of_BDD (bs, (share, counter))
          (low (bs, (share, counter)) node))
       (augment vb (var (bs, (share, counter)) node) false) =
     bool_fun_eval
       (bool_fun_of_BDD (bs, (share, counter))
          (low (bs, (share, counter)) node)) vb) in |- *.
  apply bool_fun_independent_lemma.  apply bool_fun_of_BDD_ext.  apply BDDvar_independent_low.
  assumption.  assumption.  apply Neqb_correct.
Qed.

Lemma internal_node_not_constant_1 :
 forall cfg : BDDconfig,
 BDDconfig_OK cfg ->
 forall (n : nat) (node : ad),
 is_internal_node cfg node ->
 n = nat_of_N (var cfg node) ->
 ~ bool_fun_eq (bool_fun_of_BDD cfg node) bool_fun_zero /\
 ~ bool_fun_eq (bool_fun_of_BDD cfg node) bool_fun_one.
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intro H.  intro n.  apply
   lt_wf_ind
    with
      (P := fun n : nat =>
            forall node : ad,
            is_internal_node (bs, (share, counter)) node ->
            n = nat_of_N (var (bs, (share, counter)) node) ->
            ~
            bool_fun_eq (bool_fun_of_BDD (bs, (share, counter)) node)
              bool_fun_zero /\
            ~
            bool_fun_eq (bool_fun_of_BDD (bs, (share, counter)) node)
              bool_fun_one).
  intros n0 H0 node H1 H2.  inversion H1.  inversion H3.  inversion H4.  cut
   (config_node_OK (bs, (share, counter)) (high (bs, (share, counter)) node)).
  cut
   (config_node_OK (bs, (share, counter)) (low (bs, (share, counter)) node)).
  intros H6 H7.  elim H6.  intro H8.  elim H7.  intro H9.  cut
   (N.eqb (low (bs, (share, counter)) node)
      (high (bs, (share, counter)) node) = true).
rewrite (low_high_neq (bs, (share, counter)) node H H1).
  intro H10.  discriminate H10.  rewrite H8.  rewrite H9.  apply Neqb_correct.  intro H9.
  elim H9; clear H9; intro.  cut
   (bool_fun_of_BDD (bs, (share, counter)) (high (bs, (share, counter)) node) =
    bool_fun_one).
  cut
   (bool_fun_of_BDD (bs, (share, counter)) (low (bs, (share, counter)) node) =
    bool_fun_zero).
  cut
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node))
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
         (var (bs, (share, counter)) node) true)).
  intros H10 H11 H12.  cut
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node))
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
         (var (bs, (share, counter)) node) false)).
  intros H13.  rewrite H12 in H10.  rewrite H11 in H13.  split; unfold not in |- *; intro.
  cut
   (bool_fun_eq
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
         (var (bs, (share, counter)) node) true)
      (bool_fun_restrict bool_fun_zero (var (bs, (share, counter)) node) true)).
  intro H15.  cut
   (bool_fun_eq bool_fun_one
      (bool_fun_restrict bool_fun_zero (var (bs, (share, counter)) node) true)).
  intro H16.  cut (bool_fun_eq bool_fun_one bool_fun_zero).  intro H17.  absurd (bool_fun_eq bool_fun_one bool_fun_zero).
  exact bool_fun_one_zero_eq.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_zero
                (var (bs, (share, counter)) node) true).
  assumption.  apply bool_fun_restrict_zero.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
                (var (bs, (share, counter)) node) true).
  assumption.  assumption.  apply bool_fun_restrict_eq.  assumption.
  cut
   (bool_fun_eq
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
         (var (bs, (share, counter)) node) false)
      (bool_fun_restrict bool_fun_one (var (bs, (share, counter)) node) false)).
  intro H15.  cut
   (bool_fun_eq bool_fun_zero
      (bool_fun_restrict bool_fun_one (var (bs, (share, counter)) node) false)).
  intro H16.  cut (bool_fun_eq bool_fun_zero bool_fun_one).  intro H17.  absurd (bool_fun_eq bool_fun_zero bool_fun_one).
  exact bool_fun_zero_one_eq.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_one
                (var (bs, (share, counter)) node) false).
  assumption.  apply bool_fun_restrict_one.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
                (var (bs, (share, counter)) node) false).
  assumption.  assumption.  apply bool_fun_restrict_eq.  assumption.  apply bool_fun_of_BDDlow.
  assumption.  assumption.  apply bool_fun_of_BDDhigh.  assumption.  assumption.
  rewrite H8.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)).
  reflexivity.  rewrite H9.  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
   .
  reflexivity.  cut
   (~
    bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node)) bool_fun_zero /\
    ~
    bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node)) bool_fun_one).
  intro H10.  split; unfold not in |- *; intro.  apply (proj1 H10).  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
                (var (bs, (share, counter)) node) true).
  apply bool_fun_of_BDDhigh.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_zero
                (var (bs, (share, counter)) node) true).
  apply bool_fun_restrict_eq.  assumption.  apply bool_fun_restrict_zero.  apply (proj2 H10).
  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
                (var (bs, (share, counter)) node) true).
  apply bool_fun_of_BDDhigh.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_one
                (var (bs, (share, counter)) node) true).
  apply bool_fun_restrict_eq.  assumption.  apply bool_fun_restrict_one.
  apply
   H0
    with
      (m := nat_of_N
              (var (bs, (share, counter)) (high (bs, (share, counter)) node))).
  rewrite H2.  apply BDDcompare_lt.  apply BDDvar_ordered_high.  assumption.
  assumption.  apply in_dom_is_internal.  assumption.  apply in_dom_is_internal.
  assumption.  reflexivity.  intro H8.  elim H8; intro.  elim H7; intro.  split; unfold not in |- *; intro.
  apply bool_fun_zero_one_eq.  apply
   bool_fun_eq_trans
    with
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
         (var (bs, (share, counter)) node) false).
  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_zero
                (var (bs, (share, counter)) node) false).
  apply bool_fun_eq_symm.  apply bool_fun_restrict_zero.  apply bool_fun_restrict_eq.
  apply bool_fun_eq_symm.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_of_BDD (bs, (share, counter))
                (low (bs, (share, counter)) node)).
  apply bool_fun_eq_symm.  apply bool_fun_of_BDDlow.  assumption.  assumption.
  rewrite H9.  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
   .
  unfold bool_fun_eq, bool_fun_one in |- *.  reflexivity.  apply bool_fun_zero_one_eq.
  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_of_BDD (bs, (share, counter))
                (high (bs, (share, counter)) node)).
  rewrite H10.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)).
  unfold bool_fun_eq in |- *; reflexivity.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
                (var (bs, (share, counter)) node) true).
  apply bool_fun_of_BDDhigh.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_one
                (var (bs, (share, counter)) node) true).
  apply bool_fun_restrict_eq.  assumption.  apply bool_fun_restrict_one.  elim H10; intro.
  cut
   (N.eqb (low (bs, (share, counter)) node)
      (high (bs, (share, counter)) node) = false).
  rewrite H9.  rewrite H11.  rewrite (Neqb_correct BDDone).  intro; discriminate.
  apply low_high_neq.  assumption.  assumption.  cut
   (~
    bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node)) bool_fun_zero /\
    ~
    bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node)) bool_fun_one).
  intro H12.  split; unfold not in |- *; intro.  apply (proj1 H12).  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
                (var (bs, (share, counter)) node) true).
  apply bool_fun_of_BDDhigh.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_zero
                (var (bs, (share, counter)) node) true).
  apply bool_fun_restrict_eq.  assumption.  apply bool_fun_restrict_zero.  apply (proj2 H12).
  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
                (var (bs, (share, counter)) node) true).
  apply bool_fun_of_BDDhigh.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_one
                (var (bs, (share, counter)) node) true).
  apply bool_fun_restrict_eq.  assumption.  apply bool_fun_restrict_one.  apply
   H0
    with
      (m := nat_of_N
              (var (bs, (share, counter)) (high (bs, (share, counter)) node))).
  rewrite H2.  apply BDDcompare_lt.  apply BDDvar_ordered_high.  assumption.
  assumption.  apply in_dom_is_internal.  assumption.  apply in_dom_is_internal.
  assumption.  reflexivity.  cut
   (~
    bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node)) bool_fun_zero /\
    ~
    bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node)) bool_fun_one).
  intro H10.  split; unfold not in |- *; intro.  apply (proj1 H10).  apply
   bool_fun_eq_trans
    with
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
         (var (bs, (share, counter)) node) false).
  apply bool_fun_of_BDDlow.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_zero
                (var (bs, (share, counter)) node) false).
  apply bool_fun_restrict_eq.  assumption.  apply bool_fun_restrict_zero.  apply (proj2 H10).
  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node)
                (var (bs, (share, counter)) node) false).
  apply bool_fun_of_BDDlow.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict bool_fun_one
                (var (bs, (share, counter)) node) false).
  apply bool_fun_restrict_eq.  assumption.  apply bool_fun_restrict_one.  apply
   H0
    with
      (m := nat_of_N
              (var (bs, (share, counter)) (low (bs, (share, counter)) node))).
  rewrite H2.  apply BDDcompare_lt.  apply BDDvar_ordered_low.  assumption.
  assumption.  apply in_dom_is_internal.  assumption.  apply in_dom_is_internal.
  assumption.  reflexivity.  apply low_OK.  assumption.  assumption.  apply high_OK.
  assumption.  assumption.
Qed.

Lemma internal_node_not_constant :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 ~ bool_fun_eq (bool_fun_of_BDD cfg node) bool_fun_zero /\
 ~ bool_fun_eq (bool_fun_of_BDD cfg node) bool_fun_one.
Proof.
  intros cfg node H H0.  apply internal_node_not_constant_1 with (n := nat_of_N (var cfg node)).
  assumption.  assumption.  reflexivity.
Qed.

Lemma bool_fun_neq_internal_zero :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 ~ bool_fun_eq (bool_fun_of_BDD cfg node) (bool_fun_of_BDD cfg BDDzero).
Proof.
  intros cfg node H H0.  rewrite (proj1 (bool_fun_of_BDD_semantics cfg H)).
  exact (proj1 (internal_node_not_constant cfg node H H0)).
Qed.

Lemma bool_fun_neq_internal_one :
 forall (cfg : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node ->
 ~ bool_fun_eq (bool_fun_of_BDD cfg node) (bool_fun_of_BDD cfg BDDone).
Proof.
  intros cfg node H H0.  rewrite (proj1 (proj2 (bool_fun_of_BDD_semantics cfg H))).
  exact (proj2 (internal_node_not_constant cfg node H H0)).
Qed.

Lemma bool_fun_neq_zero_one :
 forall cfg : BDDconfig,
 BDDconfig_OK cfg ->
 ~ bool_fun_eq (bool_fun_of_BDD cfg BDDzero) (bool_fun_of_BDD cfg BDDone).
Proof.
  intros cfg H.  unfold bool_fun_eq, bool_fun_zero, bool_fun_one in |- *.  unfold bool_fun_eval in |- *.
  rewrite (proj1 (bool_fun_of_BDD_semantics cfg H)).  rewrite (proj1 (proj2 (bool_fun_of_BDD_semantics cfg H))).
  unfold not in |- *; intros.  absurd (true = false).  unfold not in |- *; discriminate.
  unfold bool_fun_zero, bool_fun_one in H0.  rewrite (H0 (fun x : BDDvar => true)).  reflexivity.
Qed.

Lemma bool_fun_neq_one_zero :
 forall cfg : BDDconfig,
 BDDconfig_OK cfg ->
 ~ bool_fun_eq (bool_fun_of_BDD cfg BDDone) (bool_fun_of_BDD cfg BDDzero).
Proof.
  intros cfg H.  unfold bool_fun_eq, bool_fun_zero, bool_fun_one in |- *.  unfold bool_fun_eval in |- *.
  rewrite (proj1 (bool_fun_of_BDD_semantics cfg H)).  rewrite (proj1 (proj2 (bool_fun_of_BDD_semantics cfg H))).
  unfold not in |- *; intros.  absurd (false = true).  unfold not in |- *; discriminate.
  unfold bool_fun_zero, bool_fun_one in H0.  rewrite (H0 (fun x : BDDvar => true)).  reflexivity.
Qed.

Lemma bool_fun_neq_lemma :
 forall bf1 bf2 : bool_fun, ~ bool_fun_eq bf1 bf2 -> ~ bool_fun_eq bf2 bf1.
Proof.
  unfold not in |- *; intros.  apply H.  apply bool_fun_eq_symm.  assumption.
Qed.

Lemma no_duplicate_node :
 forall (cfg : BDDconfig) (node1 node2 : ad),
 BDDconfig_OK cfg ->
 is_internal_node cfg node1 ->
 is_internal_node cfg node2 ->
 var cfg node1 = var cfg node2 ->
 high cfg node1 = high cfg node2 ->
 low cfg node1 = low cfg node2 -> node1 = node2.
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros node1 node2 H H0 H1 H2 H3 H4.  inversion H0.  inversion H5.  inversion H6.  inversion H1.  inversion H8.
  inversion H9.  unfold var in H2; rewrite H7 in H2; rewrite H10 in H2.
  unfold high in H3; rewrite H7 in H3; rewrite H10 in H3.  unfold low in H4; rewrite H7 in H4; rewrite H10 in H4.
  cut (BDDshare_lookup share x x0 x1 = Some node1).  cut (BDDshare_lookup share x2 x3 x4 = Some node2).
  intros H11 H12.  rewrite H2 in H12.  rewrite H3 in H12.  rewrite H4 in H12.  rewrite H11 in H12.
  injection H12.  intro H13.  rewrite H13; reflexivity.  elim H.  intros H11 H12.  apply (proj2 (proj1 H12 x2 x3 x4 node2)).
  assumption.  elim H; intros.  apply (proj2 (proj1 H12 x x0 x1 node1)).
assumption.
Qed.

Lemma BDDunique_1 :
 forall cfg : BDDconfig,
 BDDconfig_OK cfg ->
 forall (n : nat) (node1 node2 : ad),
 n = max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)) ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 bool_fun_eq (bool_fun_of_BDD cfg node1) (bool_fun_of_BDD cfg node2) ->
 node1 = node2.
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intros H n.  apply
   lt_wf_ind
    with
      (P := fun n : nat =>
            forall node1 node2 : ad,
            n =
            max (nat_of_N (var (bs, (share, counter)) node1))
              (nat_of_N (var (bs, (share, counter)) node2)) ->
            config_node_OK (bs, (share, counter)) node1 ->
            config_node_OK (bs, (share, counter)) node2 ->
            bool_fun_eq (bool_fun_of_BDD (bs, (share, counter)) node1)
              (bool_fun_of_BDD (bs, (share, counter)) node2) ->
            node1 = node2).
  intros n0 H00.  intros node1 node2 H0 H1 H2 H3.  elim H1; intro.  elim H2; intro.  rewrite H4; rewrite H5; reflexivity.
  elim H5; intro.  rewrite H4 in H3.  rewrite H6 in H3.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)) in H3.
  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
    in H3.
  absurd (bool_fun_eq bool_fun_zero bool_fun_one).  exact bool_fun_zero_one_eq.
  assumption.  absurd
   (bool_fun_eq (bool_fun_of_BDD (bs, (share, counter)) node2) bool_fun_zero).
  cut (is_internal_node (bs, (share, counter)) node2).  intro H7.  exact
   (proj1 (internal_node_not_constant (bs, (share, counter)) node2 H H7)).
  apply in_dom_is_internal.  assumption.  apply bool_fun_eq_trans with (bool_fun_of_BDD (bs, (share, counter)) node1).  apply bool_fun_eq_symm; assumption.
  rewrite H4.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)).
  unfold bool_fun_eq in |- *; reflexivity.  elim H4; intro.  elim H2; intro.
  rewrite H5 in H3; rewrite H6 in H3.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)) in H3.
  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
    in H3.
  absurd (bool_fun_eq bool_fun_one bool_fun_zero).  exact bool_fun_one_zero_eq.
  assumption.  elim H6; intro.  rewrite H5; rewrite H7; reflexivity.
  absurd
   (bool_fun_eq (bool_fun_of_BDD (bs, (share, counter)) node2) bool_fun_one).
  cut (is_internal_node (bs, (share, counter)) node2).  intro H8.  exact
   (proj2 (internal_node_not_constant (bs, (share, counter)) node2 H H8)).
  apply in_dom_is_internal.  assumption.  rewrite H5 in H3.  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
    in H3.
  apply bool_fun_eq_symm.  assumption.  elim H2; intro.  absurd
   (bool_fun_eq (bool_fun_of_BDD (bs, (share, counter)) node1) bool_fun_zero).
  cut (is_internal_node (bs, (share, counter)) node1).  intro H7.  exact
   (proj1 (internal_node_not_constant (bs, (share, counter)) node1 H H7)).
  apply in_dom_is_internal; assumption.  rewrite H6 in H3.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)) in H3.
  assumption.  elim H6; intro.  absurd
   (bool_fun_eq (bool_fun_of_BDD (bs, (share, counter)) node1) bool_fun_one).
  cut (is_internal_node (bs, (share, counter)) node1).  intro H8.  exact
   (proj2 (internal_node_not_constant (bs, (share, counter)) node1 H H8)).
  apply in_dom_is_internal; assumption.  rewrite H7 in H3.  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
    in H3.
  assumption.  cut (is_internal_node (bs, (share, counter)) node1).  cut (is_internal_node (bs, (share, counter)) node2).
  intros H8 H9.  elim
   (relation_sum
      (BDDcompare (var (bs, (share, counter)) node1)
         (var (bs, (share, counter)) node2))); intro y.
  elim y; clear y; intro y0.  cut
   (config_node_OK (bs, (share, counter)) (high (bs, (share, counter)) node1)).
  cut
   (config_node_OK (bs, (share, counter)) (high (bs, (share, counter)) node2)).
  cut
   (config_node_OK (bs, (share, counter)) (low (bs, (share, counter)) node1)).
  cut
   (config_node_OK (bs, (share, counter)) (low (bs, (share, counter)) node2)).
  intros H10 H11 H12 H13.  cut
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  cut
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))).
  intros H14 H15.  cut (high (bs, (share, counter)) node1 = high (bs, (share, counter)) node2).
  cut (low (bs, (share, counter)) node1 = low (bs, (share, counter)) node2).  intros H16 H17.
  apply no_duplicate_node with (cfg := (bs, (share, counter))).  assumption.  assumption.
  assumption.  apply BDDcompare_eq; assumption.  assumption.  assumption.
  elim H11; intro.  elim H10; intro.  rewrite H16; rewrite H17; reflexivity.
  elim H17; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))).
  rewrite H16; rewrite H18.  apply bool_fun_neq_zero_one.  assumption.  assumption.
  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))).
  apply bool_fun_neq_lemma.  rewrite H16.  apply bool_fun_neq_internal_zero.  assumption.
  apply in_dom_is_internal.  assumption.  assumption.  elim H16; intro.  elim H10; intro.
  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))).
  rewrite H17; rewrite H18.  apply bool_fun_neq_one_zero.  assumption.  assumption.
  elim H18; intro.  rewrite H17; rewrite H19; reflexivity.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))).
  rewrite H17.  apply bool_fun_neq_lemma.  apply bool_fun_neq_internal_one.  assumption.
  apply in_dom_is_internal.  assumption.  assumption.  elim H10; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))).
  rewrite H18.  apply bool_fun_neq_internal_zero.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  elim H18; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))).
  rewrite H19.  apply bool_fun_neq_internal_one.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  apply
   H00
    with
      (m := max
              (nat_of_N
                 (var (bs, (share, counter))
                    (low (bs, (share, counter)) node1)))
              (nat_of_N
                 (var (bs, (share, counter))
                    (low (bs, (share, counter)) node2)))).
  rewrite H0.  apply lt_max_1_2.  apply BDDcompare_lt.  apply BDDvar_ordered_low.
  assumption.  assumption.  apply in_dom_is_internal; assumption.  apply BDDcompare_lt.
  apply BDDvar_ordered_low.  assumption.  apply in_dom_is_internal; assumption.
  apply in_dom_is_internal; assumption.  reflexivity.  assumption.  assumption.
  assumption.  elim H13; intro.  elim H12; intro.  rewrite H16; rewrite H17; reflexivity.
  elim H17; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H16; rewrite H18; apply bool_fun_neq_zero_one.  assumption.  assumption.
  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H16.  apply bool_fun_neq_lemma.  apply bool_fun_neq_internal_zero.  assumption.
  apply in_dom_is_internal.  assumption.  assumption.  elim H16; intro.  rewrite H17 in H15.
  elim H12; intro.  rewrite H18 in H15.  absurd
   (bool_fun_eq (bool_fun_of_BDD (bs, (share, counter)) BDDone)
      (bool_fun_of_BDD (bs, (share, counter)) BDDzero)).
  apply bool_fun_neq_one_zero.  assumption.  assumption.  elim H18; intro.  rewrite H17; rewrite H19; reflexivity.
  absurd
   (bool_fun_eq (bool_fun_of_BDD (bs, (share, counter)) BDDone)
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  apply bool_fun_neq_lemma.  apply bool_fun_neq_internal_one.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  elim H12; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H18.  apply bool_fun_neq_internal_zero.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  elim H18; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H19.  apply bool_fun_neq_internal_one.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  apply
   H00
    with
      (m := max
              (nat_of_N
                 (var (bs, (share, counter))
                    (high (bs, (share, counter)) node1)))
              (nat_of_N
                 (var (bs, (share, counter))
                    (high (bs, (share, counter)) node2)))).
  rewrite H0.  apply lt_max_1_2.  apply BDDcompare_lt.  apply BDDvar_ordered_high.
  assumption.  assumption.  apply in_dom_is_internal.  assumption.  apply BDDcompare_lt.
  apply BDDvar_ordered_high.  assumption.  apply in_dom_is_internal.  assumption.
  apply in_dom_is_internal.  assumption.  reflexivity.  assumption.  assumption.
  assumption.  apply
   bool_fun_eq_trans
    with
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node1)
         (var (bs, (share, counter)) node1) false).
  apply bool_fun_of_BDDlow.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node2)
         (var (bs, (share, counter)) node2) false).
  cut (var (bs, (share, counter)) node1 = var (bs, (share, counter)) node2).  intro H14.
  rewrite H14.  apply bool_fun_restrict_eq.  assumption.  apply BDDcompare_eq.
  assumption.  apply bool_fun_eq_symm.  apply bool_fun_of_BDDlow.  assumption.
  assumption.  apply
   bool_fun_eq_trans
    with
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node1)
         (var (bs, (share, counter)) node1) true).
  apply bool_fun_of_BDDhigh.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node2)
         (var (bs, (share, counter)) node2) true).
  cut (var (bs, (share, counter)) node1 = var (bs, (share, counter)) node2).  intro H14.
  rewrite H14.  apply bool_fun_restrict_eq.  assumption.  apply BDDcompare_eq.
  assumption.  apply bool_fun_eq_symm.  apply bool_fun_of_BDDhigh.  assumption.
  assumption.  apply low_OK.  assumption.  assumption.  apply low_OK.  assumption.
  assumption.  apply high_OK.  assumption.  assumption.  apply high_OK.  assumption.
  assumption.  cut
   (config_node_OK (bs, (share, counter)) (high (bs, (share, counter)) node1)).
  cut
   (config_node_OK (bs, (share, counter)) (high (bs, (share, counter)) node2)).  cut
   (config_node_OK (bs, (share, counter)) (low (bs, (share, counter)) node1)).
  cut
   (config_node_OK (bs, (share, counter)) (low (bs, (share, counter)) node2)).  intros H10 H11 H12 H13.
  cut (low (bs, (share, counter)) node2 = high (bs, (share, counter)) node2).  intros H14.
  cut
   (N.eqb (low (bs, (share, counter)) node2)
      (high (bs, (share, counter)) node2) = false).
  rewrite H14.  rewrite (Neqb_correct (high (bs, (share, counter)) node2)).  intro H15.
  discriminate H15.  apply low_high_neq.  assumption.  assumption.  cut
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  intro H14.  elim H10; intro.  elim H12; intro.  rewrite H15; rewrite H16; reflexivity.
  elim H16; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H15; rewrite H17.  apply bool_fun_neq_zero_one.  assumption.  assumption.
  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H15.  apply bool_fun_neq_lemma.  apply bool_fun_neq_internal_zero.  assumption.
  apply in_dom_is_internal; assumption.  assumption.  elim H15; intro.  elim H12; intro.
  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H16; rewrite H17.  apply bool_fun_neq_one_zero.  assumption.  assumption.
  elim H17; intro.  rewrite H16; rewrite H18; reflexivity.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H16.  apply bool_fun_neq_lemma.  apply bool_fun_neq_internal_one.  assumption.
  apply in_dom_is_internal.  assumption.  assumption.  elim H12; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H17.  apply bool_fun_neq_internal_zero.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  elim H17; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node2))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node2))).
  rewrite H18.  apply bool_fun_neq_internal_one.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  apply
   H00
    with
      (m := max
              (nat_of_N
                 (var (bs, (share, counter))
                    (low (bs, (share, counter)) node2)))
              (nat_of_N
                 (var (bs, (share, counter))
                    (high (bs, (share, counter)) node2)))).
  rewrite H0.  apply lt_max_2.  apply BDDcompare_lt.  apply BDDvar_ordered_low.
  assumption.  assumption.  apply in_dom_is_internal; assumption.  apply BDDcompare_lt.
  apply BDDvar_ordered_high.  assumption.  apply in_dom_is_internal; assumption.
  apply in_dom_is_internal; assumption.  reflexivity.  assumption.  assumption.
  assumption.  cut
   (bool_fun_eq
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node2)
         (var (bs, (share, counter)) node2) false)
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node2)
         (var (bs, (share, counter)) node2) true)).
  intro H14.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict
                (bool_fun_of_BDD (bs, (share, counter)) node2)
                (var (bs, (share, counter)) node2) false).
  apply bool_fun_of_BDDlow.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict
                (bool_fun_of_BDD (bs, (share, counter)) node2)
                (var (bs, (share, counter)) node2) true).
  assumption.  apply bool_fun_eq_symm.  apply bool_fun_of_BDDhigh.  assumption.
  assumption.  cut
   (bool_fun_eq
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node1)
         (var (bs, (share, counter)) node2) false)
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node1)
         (var (bs, (share, counter)) node2) true)).
  intro H14.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict
                (bool_fun_of_BDD (bs, (share, counter)) node1)
                (var (bs, (share, counter)) node2) false).
  apply bool_fun_restrict_eq.  apply bool_fun_eq_symm.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict
                (bool_fun_of_BDD (bs, (share, counter)) node1)
                (var (bs, (share, counter)) node2) true).
  assumption.  apply bool_fun_restrict_eq.  assumption.  cut
   (bool_fun_independent (bool_fun_of_BDD (bs, (share, counter)) node1)
      (var (bs, (share, counter)) node2)).
  intro H14.  unfold bool_fun_independent in H14.  unfold bool_fun_eq in |- *.  unfold bool_fun_restrict in |- *.
  unfold bool_fun_eval at 1 3 in |- *.  intro vb.  rewrite (H14 vb); reflexivity.  apply
   BDDvar_independent_1
    with (n := nat_of_N (var (bs, (share, counter)) node1)).
  assumption.  assumption.  reflexivity.  assumption.  apply low_OK.  assumption.
  assumption.  apply low_OK.  assumption.  assumption.  apply high_OK.  assumption.
  assumption.  apply high_OK.  assumption.  assumption.  cut
   (BDDcompare (var (bs, (share, counter)) node2)
      (var (bs, (share, counter)) node1) = Datatypes.Lt).
  clear y; intro y.  cut
   (config_node_OK (bs, (share, counter)) (high (bs, (share, counter)) node1)).
  cut
   (config_node_OK (bs, (share, counter)) (high (bs, (share, counter)) node2)).
  cut
   (config_node_OK (bs, (share, counter)) (low (bs, (share, counter)) node1)).
  cut
   (config_node_OK (bs, (share, counter)) (low (bs, (share, counter)) node2)).
  intros H10 H11 H12 H13.  cut (low (bs, (share, counter)) node1 = high (bs, (share, counter)) node1).
  intros H14.  cut
   (N.eqb (low (bs, (share, counter)) node1)
      (high (bs, (share, counter)) node1) = false).
  rewrite H14.  rewrite (Neqb_correct (high (bs, (share, counter)) node1)).  intro H15.
  discriminate H15.  apply low_high_neq.  assumption.  assumption.  cut
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))).
  intro H14.  elim H11; intro.  elim H13; intro.  rewrite H15; rewrite H16; reflexivity.
  elim H16; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))).
  rewrite H15; rewrite H17.  apply bool_fun_neq_zero_one.  assumption.  assumption.
  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))).
  rewrite H15.  apply bool_fun_neq_lemma.  apply bool_fun_neq_internal_zero.  assumption.
  apply in_dom_is_internal; assumption.  assumption.  elim H15; intro.  elim H13; intro.
  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))).
  rewrite H16; rewrite H17.  apply bool_fun_neq_one_zero.  assumption.  assumption.
  elim H17; intro.  rewrite H16; rewrite H18; reflexivity.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))).
  rewrite H16.  apply bool_fun_neq_lemma.  apply bool_fun_neq_internal_one.  assumption.
  apply in_dom_is_internal.  assumption.  assumption.  elim H13; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))).
  rewrite H17.  apply bool_fun_neq_internal_zero.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  elim H17; intro.  absurd
   (bool_fun_eq
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node1))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node1))).
  rewrite H18.  apply bool_fun_neq_internal_one.  assumption.  apply in_dom_is_internal.
  assumption.  assumption.  apply
   H00
    with
      (m := max
              (nat_of_N
                 (var (bs, (share, counter))
                    (low (bs, (share, counter)) node1)))
              (nat_of_N
                 (var (bs, (share, counter))
                    (high (bs, (share, counter)) node1)))).
  rewrite H0.  apply lt_max_12.  apply BDDcompare_lt.  apply BDDvar_ordered_low.
  assumption.  assumption.  apply in_dom_is_internal; assumption.  apply BDDcompare_lt.
  apply BDDvar_ordered_high.  assumption.  apply in_dom_is_internal; assumption.
  apply in_dom_is_internal; assumption.  reflexivity.  assumption.  assumption.
  assumption.  cut
   (bool_fun_eq
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node1)
         (var (bs, (share, counter)) node1) false)
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node1)
         (var (bs, (share, counter)) node1) true)).
  intro H14.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict
                (bool_fun_of_BDD (bs, (share, counter)) node1)
                (var (bs, (share, counter)) node1) false).
  apply bool_fun_of_BDDlow.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict
                (bool_fun_of_BDD (bs, (share, counter)) node1)
                (var (bs, (share, counter)) node1) true).
  assumption.  apply bool_fun_eq_symm.  apply bool_fun_of_BDDhigh.  assumption.
  assumption.  cut
   (bool_fun_eq
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node2)
         (var (bs, (share, counter)) node1) false)
      (bool_fun_restrict (bool_fun_of_BDD (bs, (share, counter)) node2)
         (var (bs, (share, counter)) node1) true)).
  intro H14.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict
                (bool_fun_of_BDD (bs, (share, counter)) node2)
                (var (bs, (share, counter)) node1) false).
  apply bool_fun_restrict_eq.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_restrict
                (bool_fun_of_BDD (bs, (share, counter)) node2)
                (var (bs, (share, counter)) node1) true).
  assumption.  apply bool_fun_restrict_eq.  apply bool_fun_eq_symm.  assumption.
  cut
   (bool_fun_independent (bool_fun_of_BDD (bs, (share, counter)) node2)
      (var (bs, (share, counter)) node1)).
  intro H14.  unfold bool_fun_independent in H14.  unfold bool_fun_eq in |- *.  unfold bool_fun_restrict in |- *.
  unfold bool_fun_eval at 1 3 in |- *.  intro vb.  rewrite (H14 vb); reflexivity.  apply
   BDDvar_independent_1
    with (n := nat_of_N (var (bs, (share, counter)) node2)).
  assumption.  assumption.  reflexivity.  assumption.  apply low_OK.  assumption.
  assumption.  apply low_OK.  assumption.  assumption.  apply high_OK.  assumption.
  assumption.  apply high_OK.  assumption.  assumption.  apply BDDcompare_sup_inf.
  assumption.  apply in_dom_is_internal.  assumption.  apply in_dom_is_internal.
  assumption.
Qed.

Lemma BDDunique :
 forall cfg : BDDconfig,
 BDDconfig_OK cfg ->
 forall node1 node2 : ad,
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 bool_fun_eq (bool_fun_of_BDD cfg node1) (bool_fun_of_BDD cfg node2) ->
 node1 = node2.
Proof.
  intros cfg H node1 node2 H0 H1 H2.  apply
   BDDunique_1
    with
      (cfg := cfg)
      (n := max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2))).
  assumption.  reflexivity.  assumption.  assumption.  assumption.
Qed.

Lemma bool_fun_eq_lemma :
 forall (bf1 bf2 : bool_fun) (x : BDDvar),
 bool_fun_ext bf1 ->
 bool_fun_ext bf2 ->
 bool_fun_eq (bool_fun_restrict bf1 x true) (bool_fun_restrict bf2 x true) ->
 bool_fun_eq (bool_fun_restrict bf1 x false) (bool_fun_restrict bf2 x false) ->
 bool_fun_eq bf1 bf2.
Proof.
  intros bf1 bf2 x H H0 H1 H2.  unfold bool_fun_eq in |- *.  intro vb.  elim (sumbool_of_bool (vb x)); intro.
  cut (var_binding_eq (augment vb x true) vb).  intro H3.  cut (bool_fun_eval bf2 (augment vb x true) = bool_fun_eval bf2 vb).
  cut (bool_fun_eval bf1 (augment vb x true) = bool_fun_eval bf1 vb).  intros H4 H5.
  rewrite <- H4.  rewrite <- H5.  unfold bool_fun_eq, bool_fun_restrict in H1.
  unfold bool_fun_eval at 1 3 in H1.  apply H1.  apply H.  assumption.  apply H0.
  assumption.  apply augment_eq.  assumption.  cut (var_binding_eq (augment vb x false) vb).
  intro H3.  cut (bool_fun_eval bf2 (augment vb x false) = bool_fun_eval bf2 vb).
  cut (bool_fun_eval bf1 (augment vb x false) = bool_fun_eval bf1 vb).  intros H4 H5.
  rewrite <- H4.  rewrite <- H5.  unfold bool_fun_eq, bool_fun_restrict in H2.
  unfold bool_fun_eval at 1 3 in H2.  apply H2.  apply H.  assumption.  apply H0.
  assumption.  apply augment_eq.  assumption.
Qed.

Lemma bool_fun_preservation_1 :
 forall cfg cfg' : BDDconfig,
 BDDconfig_OK cfg ->
 BDDconfig_OK cfg' ->
 (forall (x : BDDvar) (l r a : ad),
  MapGet _ (fst cfg) a = Some (x, (l, r)) ->
  MapGet _ (fst cfg') a = Some (x, (l, r))) ->
 forall (n : nat) (node : ad),
 n = nat_of_N (var cfg node) ->
 config_node_OK cfg node ->
 bool_fun_eq (bool_fun_of_BDD cfg' node) (bool_fun_of_BDD cfg node).
Proof.
  intro cfg.  elim cfg; clear cfg; intros bs y.  elim y; clear y; intros share counter.
  intro cfg'.  elim cfg'; clear cfg'; intros bs' y'.  elim y'; clear y'; intros share' counter'.
  intros H H0 H1 n.  apply
   lt_wf_ind
    with
      (P := fun n : nat =>
            forall node : ad,
            n = nat_of_N (var (bs, (share, counter)) node) ->
            config_node_OK (bs, (share, counter)) node ->
            bool_fun_eq (bool_fun_of_BDD (bs', (share', counter')) node)
              (bool_fun_of_BDD (bs, (share, counter)) node)).
  intros n0 H2 node H3 H4.  cut (config_node_OK (bs', (share', counter')) node).  intro H5.  elim H4; intro.
  rewrite H6.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)).
  rewrite (proj1 (bool_fun_of_BDD_semantics (bs', (share', counter')) H0)).
  unfold bool_fun_eq in |- *; reflexivity.  elim H6; intro.  rewrite H7.  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs', (share', counter')) H0)))
   .
  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
   .
  unfold bool_fun_eq in |- *; reflexivity.  cut (is_internal_node (bs, (share, counter)) node).
  cut (is_internal_node (bs', (share', counter')) node).  intros H8 H9.  cut
   (bool_fun_eq
      (bool_fun_of_BDD (bs', (share', counter'))
         (low (bs', (share', counter')) node))
      (bool_fun_of_BDD (bs, (share, counter))
         (low (bs, (share, counter)) node))).
  cut
   (bool_fun_eq
      (bool_fun_of_BDD (bs', (share', counter'))
         (high (bs', (share', counter')) node))
      (bool_fun_of_BDD (bs, (share, counter))
         (high (bs, (share, counter)) node))).
  intros H10 H11.  cut (var (bs, (share, counter)) node = var (bs', (share', counter')) node).
  intro H12.  apply bool_fun_eq_lemma with (x := var (bs, (share, counter)) node).  apply bool_fun_of_BDD_ext.
  apply bool_fun_of_BDD_ext.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_of_BDD (bs', (share', counter'))
                (high (bs', (share', counter')) node)).
  apply bool_fun_eq_symm.  rewrite H12.  apply bool_fun_of_BDDhigh.  assumption.
  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_of_BDD (bs, (share, counter))
                (high (bs, (share, counter)) node)).
  assumption.  apply bool_fun_of_BDDhigh.  assumption.  assumption.  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_of_BDD (bs', (share', counter'))
                (low (bs', (share', counter')) node)).
  rewrite H12.  apply bool_fun_eq_symm; apply bool_fun_of_BDDlow; assumption; assumption.
  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_of_BDD (bs, (share, counter))
                (low (bs, (share, counter)) node)).
  assumption.  apply bool_fun_of_BDDlow; assumption; assumption.  unfold var in |- *.
  inversion H9.  inversion H12.  inversion H13.  rewrite H14.  rewrite (H1 x x0 x1 node H14).
  reflexivity.  cut
   (config_node_OK (bs, (share, counter)) (high (bs, (share, counter)) node)).  cut
   (config_node_OK (bs', (share', counter'))
      (high (bs', (share', counter')) node)).
  intros H10 H11.  inversion H9.  inversion H12.  inversion H13.  cut
   (high (bs', (share', counter')) node = high (bs, (share, counter)) node).
  cut (low (bs', (share', counter')) node = low (bs, (share, counter)) node).  intros H15 H16.
  elim H11; intro.  rewrite H16; rewrite H17.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)).
  rewrite (proj1 (bool_fun_of_BDD_semantics (bs', (share', counter')) H0)).
  unfold bool_fun_eq in |- *; reflexivity.  elim H17; intro.  rewrite H16; rewrite H18.
  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs', (share', counter')) H0)))
   .
  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
   .
  unfold bool_fun_eq in |- *; reflexivity.  rewrite H16.  apply
   H2
    with
      (m := nat_of_N
              (var (bs, (share, counter)) (high (bs, (share, counter)) node))).
  rewrite H3.  apply BDDcompare_lt.  apply BDDvar_ordered_high.  assumption.
  assumption.  apply in_dom_is_internal.  assumption.  reflexivity.  assumption.
  unfold low in |- *.  rewrite H14.  rewrite (H1 x x0 x1 node H14).  reflexivity.  unfold high in |- *.
  rewrite H14.  rewrite (H1 x x0 x1 node H14).  reflexivity.  apply high_OK.  assumption.
  assumption.  apply high_OK.  assumption.  assumption.  cut (low (bs', (share', counter')) node = low (bs, (share, counter)) node).
  intro H10.  rewrite H10.  cut
   (config_node_OK (bs, (share, counter)) (low (bs, (share, counter)) node)).
  intro H11.  elim H11.  intro H12.  rewrite H12.  rewrite (proj1 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)).
  rewrite (proj1 (bool_fun_of_BDD_semantics (bs', (share', counter')) H0)).
  unfold bool_fun_eq in |- *; reflexivity.  intro H12.  elim H12; intro.  rewrite H13.
  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs, (share, counter)) H)))
   .
  rewrite
   (proj1 (proj2 (bool_fun_of_BDD_semantics (bs', (share', counter')) H0)))
   .
  unfold bool_fun_eq in |- *; reflexivity.  apply
   H2
    with
      (m := nat_of_N
              (var (bs, (share, counter)) (low (bs, (share, counter)) node))).
  rewrite H3.  apply BDDcompare_lt.  apply BDDvar_ordered_low.  assumption.
  assumption.  apply in_dom_is_internal.  assumption.  reflexivity.  apply low_OK.
  assumption.  assumption.  apply low_OK.  assumption.  assumption.  unfold low in |- *.
  inversion H9.  inversion H10.  inversion H11.  rewrite H12.  rewrite (H1 x x0 x1 node H12).
  reflexivity.  apply in_dom_is_internal.  elim (option_sum _ (MapGet _ (fst (bs, (share, counter))) node)).
  intro y.  elim y; intro x.  elim x; intros x0 x1.  elim x1; intros y0 y1 y2.  unfold in_dom in |- *.
  rewrite (H1 x0 y0 y1 node y2).  reflexivity.  intro y.  unfold in_dom in H7.
  rewrite y in H7; discriminate.  apply in_dom_is_internal.  assumption.  elim H4; intro.
  rewrite H5.  left; reflexivity.  elim H5; intro.  rewrite H6; right; left; reflexivity.
  right; right.  elim (option_sum _ (MapGet _ (fst (bs, (share, counter))) node)).
  intro y.  elim y; intro x.  elim x; intro y0.  intro y1.  elim y1; intros y2 y3 y4.  unfold in_dom in |- *; rewrite (H1 y0 y2 y3 node y4); reflexivity.
  intro y.  unfold in_dom in H6; rewrite y in H6; discriminate.
Qed.

Lemma bool_fun_preservation :
 forall (cfg cfg' : BDDconfig) (node : ad),
 BDDconfig_OK cfg ->
 BDDconfig_OK cfg' ->
 (forall (x : BDDvar) (l r a : ad),
  MapGet _ (fst cfg) a = Some (x, (l, r)) ->
  MapGet _ (fst cfg') a = Some (x, (l, r))) ->
 config_node_OK cfg node ->
 bool_fun_eq (bool_fun_of_BDD cfg' node) (bool_fun_of_BDD cfg node).
Proof.
  intros cfg cfg' node H H0 H1 H2.  apply bool_fun_preservation_1 with (n := nat_of_N (var cfg node)).  assumption.
  assumption.  assumption.  reflexivity.  assumption.
Qed.


(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

Require Import Termes.
Require Import Conv.
Require Export MyList.

Implicit Types i k m n p : nat.
Implicit Type s : sort.
Implicit Types A B M N T t u v : term.

  Definition env := list term.

  Implicit Types e f g : env.

  Definition item_lift t e n :=
    ex2 (fun u => t = lift (S n) u) (fun u => item term u (e:list term) n).

Section Typage.

  Inductive wf : env -> Prop :=
    | wf_nil : wf nil
    | wf_var : forall e T s, typ e T (Srt s) -> wf (T :: e)
with typ : env -> term -> term -> Prop :=
  | type_prop : forall e, wf e -> typ e (Srt prop) (Srt kind)
  | type_set : forall e, wf e -> typ e (Srt set) (Srt kind)
  | type_var :
      forall e,
      wf e -> forall (v : nat) t, item_lift t e v -> typ e (Ref v) t
  | type_abs :
      forall e T s1,
      typ e T (Srt s1) ->
      forall M (U : term) s2,
      typ (T :: e) U (Srt s2) ->
      typ (T :: e) M U -> typ e (Abs T M) (Prod T U)
  | type_app :
      forall e v (V : term),
      typ e v V ->
      forall u (Ur : term),
      typ e u (Prod V Ur) -> typ e (App u v) (subst v Ur)
  | type_prod :
      forall e T s1,
      typ e T (Srt s1) ->
      forall (U : term) s2,
      typ (T :: e) U (Srt s2) -> typ e (Prod T U) (Srt s2)
  | type_conv :
      forall e t (U V : term),
      typ e t U -> conv U V -> forall s, typ e V (Srt s) -> typ e t V.

  Hint Resolve wf_nil type_prop type_set type_var: coc.

  Lemma type_prop_set :
   forall s, is_prop s -> forall e, wf e -> typ e (Srt s) (Srt kind).
simple destruct 1; intros; rewrite H0.
apply type_prop; trivial.
apply type_set; trivial.
Qed.

  Lemma typ_free_db : forall e t T, typ e t T -> free_db (length e) t.
simple induction 1; intros; auto with coc core arith datatypes.
inversion_clear H1.
apply db_ref.
elim H3; simpl in |- *; intros; auto with coc core arith datatypes.
Qed.

  Lemma typ_wf : forall e t T, typ e t T -> wf e.
simple induction 1; auto with coc core arith datatypes.
Qed.

  Lemma wf_sort :
   forall n e f,
   trunc _ (S n) e f ->
   wf e -> forall t, item _ t e n -> exists s : sort, typ f t (Srt s).
simple induction n.
do 3 intro.
inversion_clear H.
inversion_clear H0.
intros.
inversion_clear H0.
inversion_clear H.
exists s; auto with coc core arith datatypes.

do 5 intro.
inversion_clear H0.
intros.
inversion_clear H2.
inversion_clear H0.
elim H with e0 f t; intros; auto with coc core arith datatypes.
exists x0; auto with coc core arith datatypes.

apply typ_wf with x (Srt s); auto with coc core arith datatypes.
Qed.

  Definition inv_type (P : Prop) e t T : Prop :=
    match t with
    | Srt prop => conv T (Srt kind) -> P
    | Srt set => conv T (Srt kind) -> P
    | Srt kind => True
    | Ref n => forall x : term, item _ x e n -> conv T (lift (S n) x) -> P
    | Abs A M =>
        forall s1 s2 (U : term),
        typ e A (Srt s1) ->
        typ (A :: e) M U -> typ (A :: e) U (Srt s2) -> conv T (Prod A U) -> P
    | App u v =>
        forall Ur V : term,
        typ e v V -> typ e u (Prod V Ur) -> conv T (subst v Ur) -> P
    | Prod A B =>
        forall s1 s2,
        typ e A (Srt s1) -> typ (A :: e) B (Srt s2) -> conv T (Srt s2) -> P
    end.

  Lemma inv_type_conv :
   forall (P : Prop) e t (U V : term),
   conv U V -> inv_type P e t U -> inv_type P e t V.
do 6 intro.
cut (forall x : term, conv V x -> conv U x).
intro.
case t; simpl in |- *; intros.
generalize H1.
elim s; auto with coc core arith datatypes; intros.

apply H1 with x; auto with coc core arith datatypes.

apply H1 with s1 s2 U0; auto with coc core arith datatypes.

apply H1 with Ur V0; auto with coc core arith datatypes.

apply H1 with s1 s2; auto with coc core arith datatypes.

intros.
apply trans_conv_conv with V; auto with coc core arith datatypes.
Qed.

  Theorem typ_inversion :
   forall (P : Prop) e t T, typ e t T -> inv_type P e t T -> P.
simple induction 1; simpl in |- *; intros.
auto with coc core arith datatypes.

auto with coc core arith datatypes.

elim H1; intros.
apply H2 with x; auto with coc core arith datatypes.
rewrite H3; auto with coc core arith datatypes.

apply H6 with s1 s2 U; auto with coc core arith datatypes.

apply H4 with Ur V; auto with coc core arith datatypes.

apply H4 with s1 s2; auto with coc core arith datatypes.

apply H1.
apply inv_type_conv with V; auto with coc core arith datatypes.
Qed.

  Lemma inv_typ_kind : forall e t, ~ typ e (Srt kind) t.
red in |- *; intros.
apply typ_inversion with e (Srt kind) t; simpl in |- *;
 auto with coc core arith datatypes.
Qed.

  Lemma inv_typ_prop : forall e T, typ e (Srt prop) T -> conv T (Srt kind).
intros.
apply typ_inversion with e (Srt prop) T; simpl in |- *;
 auto with coc core arith datatypes.
Qed.

  Lemma inv_typ_set : forall e T, typ e (Srt set) T -> conv T (Srt kind).
intros.
apply typ_inversion with e (Srt set) T; simpl in |- *;
 auto with coc core arith datatypes.
Qed.

  Lemma inv_typ_ref :
   forall (P : Prop) e T n,
   typ e (Ref n) T ->
   (forall U : term, item _ U e n -> conv T (lift (S n) U) -> P) -> P.
intros.
apply typ_inversion with e (Ref n) T; simpl in |- *; intros;
 auto with coc core arith datatypes.
apply H0 with x; auto with coc core arith datatypes.
Qed.

  Lemma inv_typ_abs :
   forall (P : Prop) e A M (U : term),
   typ e (Abs A M) U ->
   (forall s1 s2 T,
    typ e A (Srt s1) ->
    typ (A :: e) M T -> typ (A :: e) T (Srt s2) -> conv (Prod A T) U -> P) ->
   P.
intros.
apply typ_inversion with e (Abs A M) U; simpl in |- *;
 auto with coc core arith datatypes; intros.
apply H0 with s1 s2 U0; auto with coc core arith datatypes.
Qed.

  Lemma inv_typ_app :
   forall (P : Prop) e u v T,
   typ e (App u v) T ->
   (forall V Ur : term,
    typ e u (Prod V Ur) -> typ e v V -> conv T (subst v Ur) -> P) -> P.
intros.
apply typ_inversion with e (App u v) T; simpl in |- *;
 auto with coc core arith datatypes; intros.
apply H0 with V Ur; auto with coc core arith datatypes.
Qed.

  Lemma inv_typ_prod :
   forall (P : Prop) e T (U s : term),
   typ e (Prod T U) s ->
   (forall s1 s2,
    typ e T (Srt s1) -> typ (T :: e) U (Srt s2) -> conv (Srt s2) s -> P) -> P.
intros.
apply typ_inversion with e (Prod T U) s; simpl in |- *;
 auto with coc core arith datatypes; intros.
apply H0 with s1 s2; auto with coc core arith datatypes.
Qed.

  Lemma typ_mem_kind : forall e t T, mem_sort kind t -> ~ typ e t T.
red in |- *; intros.
apply typ_inversion with e t T; auto with coc core arith datatypes.
generalize e T.
clear H0.
elim H; simpl in |- *; auto with coc core arith datatypes; intros.
apply typ_inversion with e0 u (Srt s1); auto with coc core arith datatypes.

apply typ_inversion with (u :: e0) v (Srt s2);
 auto with coc core arith datatypes.

apply typ_inversion with e0 u (Srt s1); auto with coc core arith datatypes.

apply typ_inversion with (u :: e0) v U; auto with coc core arith datatypes.

apply typ_inversion with e0 u (Prod V Ur); auto with coc core arith datatypes.

apply typ_inversion with e0 v V; auto with coc core arith datatypes.
Qed.

  Lemma inv_typ_conv_kind : forall e t T, conv t (Srt kind) -> ~ typ e t T.
intros.
apply typ_mem_kind.
apply red_sort_mem.
elim church_rosser with t (Srt kind); intros;
 auto with coc core arith datatypes.
rewrite (red_normal (Srt kind) x); auto with coc core arith datatypes.
red in |- *; red in |- *; intros.
inversion_clear H2.
Qed.

  Inductive ins_in_env A : nat -> env -> env -> Prop :=
    | ins_O : forall e, ins_in_env A 0 e (A :: e)
    | ins_S :
        forall n e f t,
        ins_in_env A n e f ->
        ins_in_env A (S n) (t :: e) (lift_rec 1 t n :: f).

  Hint Resolve ins_O ins_S: coc.

  Lemma ins_item_ge :
   forall A n e f,
   ins_in_env A n e f ->
   forall v : nat, n <= v -> forall t, item _ t e v -> item _ t f (S v).
simple induction 1; auto with coc core arith datatypes.
simple destruct v; intros.
inversion_clear H2.

inversion_clear H3; auto with coc core arith datatypes.
Qed.

  Lemma ins_item_lt :
   forall A n e f,
   ins_in_env A n e f ->
   forall v : nat,
   n > v -> forall t, item_lift t e v -> item_lift (lift_rec 1 t n) f v.
simple induction 1.
intros.
inversion_clear H0.

simple destruct v; intros.
elim H3; intros.
rewrite H4.
exists (lift_rec 1 t n0); auto with coc core arith datatypes.
inversion_clear H5.
elim permute_lift with t n0; auto with coc core arith datatypes.

elim H3; intros.
rewrite H4.
inversion_clear H5.
elim H1 with n1 (lift (S n1) x); intros; auto with coc core arith datatypes.
exists x0; auto with coc core arith datatypes.
pattern (lift (S (S n1)) x0) at 1 in |- *.
rewrite simpl_lift; auto with coc core arith datatypes.
elim H5.
change
  (lift_rec 1 (lift (S (S n1)) x) (S n0) =
   lift 1 (lift_rec 1 (lift (S n1) x) n0)) in |- *.
rewrite (permute_lift (lift (S n1) x) n0).
unfold lift at 2 in |- *.
pattern (lift (S (S n1)) x) in |- *.
rewrite simpl_lift; auto with coc core arith datatypes.

exists x; auto with coc core arith datatypes.
Qed.

  Lemma typ_weak_weak :
   forall A e t T,
   typ e t T ->
   forall n f,
   ins_in_env A n e f -> wf f -> typ f (lift_rec 1 t n) (lift_rec 1 T n).
simple induction 1; simpl in |- *; intros; auto with coc core arith datatypes.
elim (le_gt_dec n v); intros; apply type_var;
 auto with coc core arith datatypes.
elim H1; intros.
exists x.
rewrite H4.
unfold lift in |- *.
rewrite simpl_lift_rec; simpl in |- *; auto with coc core arith datatypes.

apply ins_item_ge with A n e0; auto with coc core arith datatypes.

apply ins_item_lt with A e0; auto with coc core arith datatypes.

cut (wf (lift_rec 1 T0 n :: f)).
intro.
apply type_abs with s1 s2; auto with coc core arith datatypes.

apply wf_var with s1; auto with coc core arith datatypes.

rewrite distr_lift_subst.
apply type_app with (lift_rec 1 V n); auto with coc core arith datatypes.

cut (wf (lift_rec 1 T0 n :: f)).
intro.
apply type_prod with s1; auto with coc core arith datatypes.

apply wf_var with s1; auto with coc core arith datatypes.

apply type_conv with (lift_rec 1 U n) s; auto with coc core arith datatypes.
Qed.

  Theorem thinning :
   forall e t T,
   typ e t T -> forall A, wf (A :: e) -> typ (A :: e) (lift 1 t) (lift 1 T).
unfold lift in |- *.
intros.
inversion_clear H0.
apply typ_weak_weak with A e; auto with coc core arith datatypes.
apply wf_var with s; auto with coc core arith datatypes.
Qed.

  Lemma thinning_n :
   forall n e f,
   trunc _ n e f ->
   forall t T, typ f t T -> wf e -> typ e (lift n t) (lift n T).
simple induction n.
intros.
rewrite lift0.
rewrite lift0.
replace e with f; auto with coc core arith datatypes.
inversion_clear H; auto with coc core arith datatypes.

do 8 intro.
inversion_clear H0.
intro.
rewrite simpl_lift; auto with coc core arith datatypes.
pattern (lift (S n0) T) in |- *.
rewrite simpl_lift; auto with coc core arith datatypes.
inversion_clear H0.
change (typ (x :: e0) (lift 1 (lift n0 t)) (lift 1 (lift n0 T))) in |- *.
apply thinning; auto with coc core arith datatypes.
apply H with f; auto with coc core arith datatypes.
apply typ_wf with x (Srt s); auto with coc core arith datatypes.

apply wf_var with s; auto with coc core arith datatypes.
Qed.

  Lemma wf_sort_lift :
   forall n e t, wf e -> item_lift t e n -> exists s : sort, typ e t (Srt s).
simple induction n.
simple destruct e; intros.
elim H0; intros.
inversion_clear H2.

elim H0; intros.
rewrite H1.
inversion_clear H2.
inversion_clear H.
exists s.
replace (Srt s) with (lift 1 (Srt s)); auto with coc core arith datatypes.
apply thinning; auto with coc core arith datatypes.
apply wf_var with s; auto with coc core arith datatypes.

intros.
elim H1; intros.
rewrite H2.
generalize H0.
inversion_clear H3; intros.
rewrite simpl_lift; auto with coc core arith datatypes.
cut (wf l); intros.
elim H with l (lift (S n0) x); intros; auto with coc core arith datatypes.
inversion_clear H3.
exists x0.
change (typ (y :: l) (lift 1 (lift (S n0) x)) (lift 1 (Srt x0))) in |- *.
apply thinning; auto with coc core arith datatypes.
apply wf_var with s; auto with coc core arith datatypes.

exists x; auto with coc core arith datatypes.

inversion_clear H3.
apply typ_wf with y (Srt s); auto with coc core arith datatypes.
Qed.

  Inductive sub_in_env t T : nat -> env -> env -> Prop :=
    | sub_O : forall e, sub_in_env t T 0 (T :: e) e
    | sub_S :
        forall e f n u,
        sub_in_env t T n e f ->
        sub_in_env t T (S n) (u :: e) (subst_rec t u n :: f).

  Hint Resolve sub_O sub_S: coc.

  Lemma nth_sub_sup :
   forall t T n e f,
   sub_in_env t T n e f ->
   forall v : nat, n <= v -> forall u, item _ u e (S v) -> item _ u f v.
simple induction 1.
intros.
inversion_clear H1; auto with coc core arith datatypes.

simple destruct v; intros.
inversion_clear H2.

inversion_clear H3; auto with coc core arith datatypes.
Qed.

  Lemma nth_sub_eq : forall t T n e f, sub_in_env t T n e f -> item _ T e n.
simple induction 1; auto with coc core arith datatypes.
Qed.

  Lemma nth_sub_inf :
   forall t T n e f,
   sub_in_env t T n e f ->
   forall v : nat,
   n > v -> forall u, item_lift u e v -> item_lift (subst_rec t u n) f v.
simple induction 1.
intros.
inversion_clear H0.

simple destruct v; intros.
elim H3; intros.
rewrite H4.
inversion_clear H5.
exists (subst_rec t u n0); auto with coc core arith datatypes.
apply commut_lift_subst; auto with coc core arith datatypes.

elim H3; intros.
rewrite H4.
inversion_clear H5.
elim H1 with n1 (lift (S n1) x); intros; auto with coc core arith datatypes.
exists x0; auto with coc core arith datatypes.
rewrite simpl_lift; auto with coc core arith datatypes.
pattern (lift (S (S n1)) x0) in |- *.
rewrite simpl_lift; auto with coc core arith datatypes.
elim H5.
change
  (subst_rec t (lift 1 (lift (S n1) x)) (S n0) =
   lift 1 (subst_rec t (lift (S n1) x) n0)) in |- *.
apply commut_lift_subst; auto with coc core arith datatypes.

exists x; auto with coc core arith datatypes.
Qed.

  Lemma typ_sub_weak :
   forall g (d : term) t,
   typ g d t ->
   forall e u (U : term),
   typ e u U ->
   forall f n,
   sub_in_env d t n e f ->
   wf f -> trunc _ n f g -> typ f (subst_rec d u n) (subst_rec d U n).
simple induction 2; simpl in |- *; intros; auto with coc core arith datatypes.
elim (lt_eq_lt_dec n v); [ intro Hlt_eq | intro Hlt ].
elim H2.
elim Hlt_eq; clear Hlt_eq.
case v; [ intro Hlt | intros n0 Hlt ]; intros.
inversion_clear Hlt.

simpl in |- *.
rewrite H6.
rewrite simpl_subst; auto with coc core arith datatypes.
apply type_var; auto with coc core arith datatypes.
exists x; auto with coc core arith datatypes.
apply nth_sub_sup with d t n e0; auto with coc core arith datatypes.

intro Heq; intros.
rewrite H6.
elim Heq.
rewrite simpl_subst; auto with coc core arith datatypes.
replace x with t.
apply thinning_n with g; auto with coc core arith datatypes.

apply fun_item with e0 v; auto with coc core arith datatypes.
apply nth_sub_eq with d f; auto with coc core arith datatypes.
elim Heq; auto with coc core arith datatypes.

apply type_var; auto with coc core arith datatypes.
apply nth_sub_inf with t e0; auto with coc core arith datatypes.

cut (wf (subst_rec d T n :: f)); intros.
apply type_abs with s1 s2; auto with coc core arith datatypes.

apply wf_var with s1; auto with coc core arith datatypes.

rewrite distr_subst.
apply type_app with (subst_rec d V n); auto with coc core arith datatypes.

cut (wf (subst_rec d T n :: f)); intros.
apply type_prod with s1; auto with coc core arith datatypes.

apply wf_var with s1; auto with coc core arith datatypes.

apply type_conv with (subst_rec d U0 n) s; auto with coc core arith datatypes.
Qed.

  Theorem substitution :
   forall e t u (U : term),
   typ (t :: e) u U ->
   forall d : term, typ e d t -> typ e (subst d u) (subst d U).
intros.
unfold subst in |- *.
apply typ_sub_weak with e t (t :: e); auto with coc core arith datatypes.
apply typ_wf with d t; auto with coc core arith datatypes.
Qed.

  Theorem typ_unique :
   forall e t T, typ e t T -> forall U : term, typ e t U -> conv T U.
simple induction 1; intros.
apply sym_conv.
apply inv_typ_prop with e0; auto with coc core arith datatypes.

apply sym_conv.
apply inv_typ_set with e0; auto with coc core arith datatypes.

apply inv_typ_ref with e0 U v; auto with coc core arith datatypes; intros.
elim H1; intros.
rewrite H5.
elim fun_item with term U0 x e0 v; auto with coc core arith datatypes.

apply inv_typ_abs with e0 T0 M U0; auto with coc core arith datatypes; intros.
apply trans_conv_conv with (Prod T0 T1); auto with coc core arith datatypes.

apply inv_typ_app with e0 u v U; auto with coc core arith datatypes; intros.
apply trans_conv_conv with (subst v Ur0); auto with coc core arith datatypes.
unfold subst in |- *; apply conv_conv_subst;
 auto with coc core arith datatypes.
apply inv_conv_prod_r with V V0; auto with coc core arith datatypes.

apply inv_typ_prod with e0 T0 U U0; auto with coc core arith datatypes;
 intros.
apply trans_conv_conv with (Srt s3); auto with coc core arith datatypes.

apply trans_conv_conv with U; auto with coc core arith datatypes.
Qed.

  Theorem type_case :
   forall e t T,
   typ e t T -> (exists s : sort, typ e T (Srt s)) \/ T = Srt kind.
simple induction 1; intros; auto with coc core arith datatypes.
left.
elim wf_sort_lift with v e0 t0; auto with coc core arith datatypes; intros.
exists x; auto with coc core arith datatypes.

left.
exists s2.
apply type_prod with s1; auto with coc core arith datatypes.

left.
elim H3; intros.
elim H4; intros.
apply inv_typ_prod with e0 V Ur (Srt x); auto with coc core arith datatypes;
 intros.
exists s2.
replace (Srt s2) with (subst v (Srt s2)); auto with coc core arith datatypes.
apply substitution with V; auto with coc core arith datatypes.

discriminate H4.

case s2; auto with coc core arith datatypes.
left.
exists kind.
apply type_prop.
apply typ_wf with T0 (Srt s1); auto with coc core arith datatypes.

left.
exists kind.
apply type_set.
apply typ_wf with T0 (Srt s1); auto with coc core arith datatypes.

left.
exists s; auto with coc core arith datatypes.
Qed.

  Lemma type_kind_not_conv :
   forall e t T, typ e t T -> typ e t (Srt kind) -> T = Srt kind.
intros.
elim type_case with e t T; intros; auto with coc core arith datatypes.
elim H1; intros.
elim inv_typ_conv_kind with e T (Srt x); auto with coc core arith datatypes.
apply typ_unique with e t; auto with coc core arith datatypes.
Qed.

  Lemma type_free_db : forall e t T, typ e t T -> free_db (length e) T.
intros.
elim type_case with e t T; intros; auto with coc core arith datatypes.
inversion_clear H0.
apply typ_free_db with (Srt x); auto with coc core arith datatypes.

rewrite H0; auto with coc core arith datatypes.
Qed.

  Inductive red1_in_env : env -> env -> Prop :=
    | red1_env_hd : forall e t u, red1 t u -> red1_in_env (t :: e) (u :: e)
    | red1_env_tl :
        forall e f t, red1_in_env e f -> red1_in_env (t :: e) (t :: f).

  Hint Resolve red1_env_hd red1_env_tl: coc.

  Lemma red_item :
   forall n t e,
   item_lift t e n ->
   forall f,
   red1_in_env e f ->
   item_lift t f n \/
   (forall g, trunc _ (S n) e g -> trunc _ (S n) f g) /\
   ex2 (fun u => red1 t u) (fun u => item_lift u f n).
simple induction n.
do 3 intro.
elim H.
do 4 intro.
rewrite H0.
inversion_clear H1.
intros.
inversion_clear H1.
right.
split; intros.
inversion_clear H1; auto with coc core arith datatypes.

exists (lift 1 u).
unfold lift in |- *; auto with coc core arith datatypes.

exists u; auto with coc core arith datatypes.

left.
exists x; auto with coc core arith datatypes.

do 5 intro.
elim H0.
do 4 intro.
rewrite H1.
inversion_clear H2.
intros.
inversion_clear H2.
left.
exists x; auto with coc core arith datatypes.

elim H with (lift (S n0) x) l f0; auto with coc core arith datatypes; intros.
left.
elim H2; intros.
exists x0; auto with coc core arith datatypes.
rewrite simpl_lift.
pattern (lift (S (S n0)) x0) in |- *.
rewrite simpl_lift.
elim H5; auto with coc core arith datatypes.

right.
elim H2.
simple induction 2; intros.
split; intros.
inversion_clear H9; auto with coc core arith datatypes.

elim H8; intros.
exists (lift (S (S n0)) x1).
rewrite simpl_lift.
pattern (lift (S (S n0)) x1) in |- *.
rewrite simpl_lift.
elim H9; unfold lift at 1 3 in |- *; auto with coc core arith datatypes.

exists x1; auto with coc core arith datatypes.

exists x; auto with coc core arith datatypes.
Qed.

  Lemma typ_red_env :
   forall e t T, typ e t T -> forall f, red1_in_env e f -> wf f -> typ f t T.
simple induction 1; intros.
auto with coc core arith datatypes.

auto with coc core arith datatypes.

elim red_item with v t0 e0 f; auto with coc core arith datatypes; intros.
inversion_clear H4.
inversion_clear H6.
elim H1; intros.
elim item_trunc with term v e0 x0; intros; auto with coc core arith datatypes.
elim wf_sort with v e0 x1 x0; auto with coc core arith datatypes.
intros.
apply type_conv with x x2; auto with coc core arith datatypes.
rewrite H6.
replace (Srt x2) with (lift (S v) (Srt x2));
 auto with coc core arith datatypes.
apply thinning_n with x1; auto with coc core arith datatypes.

cut (wf (T0 :: f)); intros.
apply type_abs with s1 s2; auto with coc core arith datatypes.

apply wf_var with s1; auto with coc core arith datatypes.

apply type_app with V; auto with coc core arith datatypes.

cut (wf (T0 :: f)); intros.
apply type_prod with s1; auto with coc core arith datatypes.

apply wf_var with s1; auto with coc core arith datatypes.

apply type_conv with U s; auto with coc core arith datatypes.
Qed.

  Lemma subj_red : forall e t T, typ e t T -> forall u, red1 t u -> typ e u T.
simple induction 1; intros.
inversion_clear H1.

inversion_clear H1.

inversion_clear H2.

inversion_clear H6.
cut (wf (M' :: e0)); intros.
apply type_conv with (Prod M' U) s2; auto with coc core arith datatypes.
apply type_abs with s1 s2; auto with coc core arith datatypes.
apply typ_red_env with (T0 :: e0); auto with coc core arith datatypes.

apply typ_red_env with (T0 :: e0); auto with coc core arith datatypes.

apply type_prod with s1; auto with coc core arith datatypes.

apply wf_var with s1; auto with coc core arith datatypes.

apply type_abs with s1 s2; auto with coc core arith datatypes.

elim type_case with e0 u (Prod V Ur); intros;
 auto with coc core arith datatypes.
inversion_clear H5.
apply inv_typ_prod with e0 V Ur (Srt x); intros;
 auto with coc core arith datatypes.
generalize H2 H3.
clear H2 H3.
inversion_clear H4; intros.
apply inv_typ_abs with e0 T0 M (Prod V Ur); intros;
 auto with coc core arith datatypes.
apply type_conv with (subst v T1) s2; auto with coc core arith datatypes.
apply substitution with T0; auto with coc core arith datatypes.
apply type_conv with V s0; auto with coc core arith datatypes.
apply inv_conv_prod_l with Ur T1; auto with coc core arith datatypes.

unfold subst in |- *.
apply conv_conv_subst; auto with coc core arith datatypes.
apply inv_conv_prod_r with T0 V; auto with coc core arith datatypes.

replace (Srt s2) with (subst v (Srt s2)); auto with coc core arith datatypes.
apply substitution with V; auto with coc core arith datatypes.

apply type_app with V; auto with coc core arith datatypes.

apply type_conv with (subst N2 Ur) s2; auto with coc core arith datatypes.
apply type_app with V; auto with coc core arith datatypes.

unfold subst in |- *.
apply conv_conv_subst; auto with coc core arith datatypes.

replace (Srt s2) with (subst v (Srt s2)); auto with coc core arith datatypes.
apply substitution with V; auto with coc core arith datatypes.

discriminate H5.

inversion_clear H4.
apply type_prod with s1; auto with coc core arith datatypes.
apply typ_red_env with (T0 :: e0); auto with coc core arith datatypes.
apply wf_var with s1; auto with coc core arith datatypes.

apply type_prod with s1; auto with coc core arith datatypes.

apply type_conv with U s; auto with coc core arith datatypes.
Qed.

  Theorem subject_reduction :
   forall e t u, red t u -> forall T, typ e t T -> typ e u T.
simple induction 1; intros; auto with coc core arith datatypes.
apply subj_red with P; intros; auto with coc core arith datatypes.
Qed.

  Lemma type_reduction :
   forall e t T (U : term), red T U -> typ e t T -> typ e t U.
intros.
elim type_case with e t T; intros; auto with coc core arith datatypes.
inversion_clear H1.
apply type_conv with T x; auto with coc core arith datatypes.
apply subject_reduction with T; auto with coc core arith datatypes.

elim red_normal with T U; auto with coc core arith datatypes.
rewrite H1.
red in |- *; red in |- *; intros.
inversion_clear H2.
Qed.

  Lemma typ_conv_conv :
   forall e u (U : term) v (V : term),
   typ e u U -> typ e v V -> conv u v -> conv U V.
intros.
elim church_rosser with u v; auto with coc core arith datatypes; intros.
apply typ_unique with e x.
apply subject_reduction with u; auto with coc core arith datatypes.

apply subject_reduction with v; auto with coc core arith datatypes.
Qed.

End Typage.

  Hint Resolve ins_O ins_S: coc.
  Hint Resolve sub_O sub_S: coc.
  Hint Resolve red1_env_hd red1_env_tl: coc.