(* 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.
Require Import bdd3.
Require Import bdd4.
Require Import bdd5_1.
Require Import bdd5_2.
Require Import bdd6.
Require Import bdd7.
Require Import BDDdummy_lemma_2.
Require Import BDDdummy_lemma_3.
Require Import BDDdummy_lemma_4.
Require Import bdd8.
Require Import bdd9.

Definition BDDneg (cfg : BDDconfig) (memo : BDDneg_memo)
  (node : ad) :=
  match BDDneg_1_1 cfg memo node (S (nat_of_N (var cfg node))) with
  | ((cfg', node'), memo') => (cfg', (node', memo'))
  end.

Definition BDDor (cfg : BDDconfig) (memo : BDDor_memo)
  (node1 node2 : ad) :=
  BDDor_1_1 cfg memo node1 node2
    (S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))).

Definition BDDand (cfg : BDDconfig) (negm : BDDneg_memo)
  (orm : BDDor_memo) (node1 node2 : ad) :=
  match BDDneg cfg negm node1 with
  | (cfg', (node1', negm')) =>
      match BDDneg cfg' negm' node2 with
      | (cfg'', (node2', negm'')) =>
          match BDDor cfg'' orm node1' node2' with
          | (cfg''', (node, orm')) =>
              match BDDneg cfg''' negm'' node with
              | (cfg'''', (node', negm''')) =>
                  (cfg'''', (node', (negm''', orm')))
              end
          end
      end
  end.

Lemma nodes_preserved_orm_OK :
 forall (cfg cfg' : BDDconfig) (orm : BDDor_memo),
 BDDconfig_OK cfg ->
 BDDconfig_OK cfg' ->
 nodes_preserved cfg cfg' -> BDDor_memo_OK cfg orm -> BDDor_memo_OK cfg' orm.
Proof.
  intros.  unfold BDDor_memo_OK in |- *.  intros.  unfold BDDor_memo_OK in H2.  cut (config_node_OK cfg node1).
  cut (config_node_OK cfg node2).  cut (config_node_OK cfg node).  intros.
  cut
   (BDDvar_le (var cfg node) (BDDvar_max (var cfg node1) (var cfg node2)) =
    true).
  intro.  cut
   (bool_fun_eq (bool_fun_of_BDD cfg node)
      (bool_fun_or (bool_fun_of_BDD cfg node1) (bool_fun_of_BDD cfg node2))).
  intro.  split.  apply nodes_preserved_2 with (cfg := cfg).  assumption.  assumption.
  split.  apply nodes_preserved_2 with (cfg := cfg).  assumption.  assumption.  split.
  apply nodes_preserved_2 with (cfg := cfg).  assumption.  assumption.  split.
  cut (var cfg' node = var cfg node).  cut (var cfg' node1 = var cfg node1).
  cut (var cfg' node2 = var cfg node2).  intros.  rewrite H9.  rewrite H10.
  rewrite H11.  assumption.  apply nodes_preserved_var_1.  assumption.  assumption.
  assumption.  assumption.  apply nodes_preserved_var_1.  assumption.  assumption.
  assumption.  assumption.  apply nodes_preserved_var_1.  assumption.  assumption.
  assumption.  assumption.  apply bool_fun_eq_trans with (bf2 := bool_fun_of_BDD cfg node).
  apply nodes_preserved_3.  assumption.  assumption.  assumption.  assumption.
  apply
   bool_fun_eq_trans
    with
      (bf2 := bool_fun_or (bool_fun_of_BDD cfg node1)
                (bool_fun_of_BDD cfg node2)).
  assumption.  apply bool_fun_eq_symm.  apply bool_fun_or_preserves_eq.  apply nodes_preserved_3.
  assumption.  assumption.  assumption.  assumption.  apply nodes_preserved_3.
  assumption.  assumption.  assumption.  assumption.  exact (proj2 (proj2 (proj2 (proj2 (H2 node1 node2 node H3))))).
  exact (proj1 (proj2 (proj2 (proj2 (H2 node1 node2 node H3))))).
  exact (proj1 (proj2 (proj2 (H2 node1 node2 node H3)))).
  exact (proj1 (proj2 (H2 node1 node2 node H3))).
  exact (proj1 (H2 node1 node2 node H3)).
Qed.

Lemma nodes_preserved_negm_OK :
 forall (cfg cfg' : BDDconfig) (negm : BDDneg_memo),
 BDDconfig_OK cfg ->
 BDDconfig_OK cfg' ->
 nodes_preserved cfg cfg' ->
 BDDneg_memo_OK_2 cfg negm -> BDDneg_memo_OK_2 cfg' negm.
Proof.
  intros.  unfold BDDneg_memo_OK_2 in |- *.  unfold BDDneg_memo_OK_2 in H2.  intros.
  cut (is_internal_node cfg node -> nat_of_N (var cfg node) < bound).  intro.
  cut (config_node_OK cfg node).  cut (BDDneg_2 cfg node bound = (cfg, node')).
  intros.  cut (config_node_OK cfg node').  intro.  cut (config_node_OK cfg' node).
  cut (config_node_OK cfg' node').  intros.  split.  assumption.  apply BDDneg_memo_OK_1_lemma_1_1_1.
  assumption.  assumption.  assumption.  assumption.  apply bool_fun_eq_trans with (bf2 := bool_fun_of_BDD cfg node').
  apply nodes_preserved_3.  assumption.  assumption.  assumption.  assumption.
  apply
   bool_fun_eq_trans with (bf2 := bool_fun_neg (bool_fun_of_BDD cfg node)).
  replace (bool_fun_of_BDD cfg node') with
   (bool_fun_of_BDD (fst (BDDneg_2 cfg node bound))
      (snd (BDDneg_2 cfg node bound))).
  refine (proj2 (proj2 (proj2 (proj2 (BDDneg_2_lemma _ _ _ _ _ _))))).
  assumption.  assumption.  assumption.  rewrite H6.  reflexivity.  apply bool_fun_eq_symm.
  apply bool_fun_eq_neg_1.  apply nodes_preserved_3.  assumption.  assumption.
  assumption.  assumption.  apply nodes_preserved_2 with (cfg := cfg).  assumption.
  assumption.  apply nodes_preserved_2 with (cfg := cfg).  assumption.  assumption.
  replace cfg with (fst (BDDneg_2 cfg node bound)).  replace node' with (snd (BDDneg_2 cfg node bound)).  refine (proj1 (proj2 (proj2 (proj2 (BDDneg_2_lemma _ _ _ _ _ _))))).
  assumption.  assumption.  assumption.  rewrite H6; reflexivity.  rewrite H6; reflexivity.
  exact (proj2 (H2 node node' bound H3 H5)).  exact (proj1 (H2 node node' bound H3 H5)).
  intro.  cut (var cfg' node = var cfg node).  intro.  rewrite <- H6.  apply H4.
  inversion H5.  inversion H7.  inversion H8.  split with x.  split with x0.
  split with x1.  apply H1.  assumption.  apply nodes_preserved_var.  assumption.
  assumption.
Qed.

Lemma BDDneg_keeps_config_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (node : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 config_node_OK cfg node -> BDDconfig_OK (fst (BDDneg cfg negm node)).
Proof.
  intros.  unfold BDDneg in |- *.  elim
   (prod_sum _ _ (BDDneg_1_1 cfg negm node (S (nat_of_N (var cfg node))))).
  intro.  elim x; clear x.  intros cfg' node'.  intro.  elim H2; clear H2.
  intros negm' H2.  rewrite H2.  simpl in |- *.  rewrite (BDDneg_1_1_eq_1 (S (nat_of_N (var cfg node))) cfg negm node)
    in H2.
  cut
   (is_internal_node cfg node ->
    nat_of_N (var cfg node) < S (nat_of_N (var cfg node))).
  intro.  replace cfg' with
   (fst (fst (BDDneg_1 (cfg, node, negm) (S (nat_of_N (var cfg node)))))).
  rewrite
   (proj1
      (BDDneg_1_lemma' (S (nat_of_N (var cfg node)))
         (cfg, node, negm) H H1 H0 H3)).
  exact (proj1 (BDDneg_2_lemma _ _ _ H H1 H3)).  rewrite H2.  reflexivity.
  intro.  unfold lt in |- *.  apply le_n.
Qed.

Lemma BDDneg_node_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (node : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 config_node_OK cfg node ->
 config_node_OK (fst (BDDneg cfg negm node))
   (fst (snd (BDDneg cfg negm node))).
Proof.
  intros.  unfold BDDneg in |- *.  elim
   (prod_sum _ _ (BDDneg_1_1 cfg negm node (S (nat_of_N (var cfg node))))).
  intro.  elim x; clear x.  intros cfg' node'.  intro.  elim H2; clear H2.
  intros negm' H2.  rewrite H2.  simpl in |- *.  rewrite (BDDneg_1_1_eq_1 (S (nat_of_N (var cfg node))) cfg negm node)
    in H2.
  cut
   (is_internal_node cfg node ->
    nat_of_N (var cfg node) < S (nat_of_N (var cfg node))).  intro.  replace cfg' with
   (fst (fst (BDDneg_1 (cfg, node, negm) (S (nat_of_N (var cfg node)))))).
  replace node' with
   (snd (fst (BDDneg_1 (cfg, node, negm) (S (nat_of_N (var cfg node)))))).
  rewrite
   (proj1
      (BDDneg_1_lemma' (S (nat_of_N (var cfg node)))
         (cfg, node, negm) H H1 H0 H3)).
  exact
   (proj1
      (proj2
         (proj2
            (proj2
               (BDDneg_2_lemma (S (nat_of_N (var cfg node))) cfg node H H1
                  H3))))).
  rewrite H2; reflexivity.  rewrite H2; reflexivity.  intro.  unfold lt in |- *.  apply le_n.
Qed.

Lemma BDDneg_preserves_nodes :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (node : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 config_node_OK cfg node -> nodes_preserved cfg (fst (BDDneg cfg negm node)).
Proof.
  intros.  unfold BDDneg in |- *.  elim
   (prod_sum _ _ (BDDneg_1_1 cfg negm node (S (nat_of_N (var cfg node))))).
  intro.  elim x; clear x.  intros cfg' node'.  intro.  elim H2; clear H2.
  intros negm' H2.  rewrite H2.  simpl in |- *.  rewrite (BDDneg_1_1_eq_1 (S (nat_of_N (var cfg node))) cfg negm node)
    in H2.
  cut
   (is_internal_node cfg node ->
    nat_of_N (var cfg node) < S (nat_of_N (var cfg node))).  intro.  replace cfg' with
   (fst (fst (BDDneg_1 (cfg, node, negm) (S (nat_of_N (var cfg node)))))).
  unfold nodes_preserved in |- *.  rewrite
   (proj1
      (BDDneg_1_lemma' (S (nat_of_N (var cfg node)))
         (cfg, node, negm) H H1 H0 H3)).
  exact (proj1 (proj2 (BDDneg_2_lemma _ _ _ H H1 H3))).  rewrite H2; reflexivity.
  intro.  unfold lt in |- *.  apply le_n.
Qed.

Lemma BDDneg_keeps_neg_memo_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (node : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 config_node_OK cfg node ->
 BDDneg_memo_OK_2 (fst (BDDneg cfg negm node))
   (snd (snd (BDDneg cfg negm node))).
Proof.
  intros.  unfold BDDneg in |- *.  elim
   (prod_sum _ _ (BDDneg_1_1 cfg negm node (S (nat_of_N (var cfg node))))).
  intro.  elim x; clear x.  intros cfg' node'.  intro.  elim H2; clear H2.
  intros negm' H2.  rewrite H2.  simpl in |- *.  rewrite (BDDneg_1_1_eq_1 (S (nat_of_N (var cfg node))) cfg negm node)
    in H2.
  cut
   (is_internal_node cfg node ->
    nat_of_N (var cfg node) < S (nat_of_N (var cfg node))).
  intro.  replace cfg' with
   (fst (fst (BDDneg_1 (cfg, node, negm) (S (nat_of_N (var cfg node)))))).
  replace negm' with
   (snd (BDDneg_1 (cfg, node, negm) (S (nat_of_N (var cfg node))))).
  refine (proj2 (BDDneg_1_lemma' _ _ _ _ _ _)).  assumption.  assumption.
  assumption.  assumption.  rewrite H2; reflexivity.  rewrite H2; reflexivity.
  intro.  unfold lt in |- *.  apply le_n.
Qed.
Lemma BDDneg_keeps_or_memo_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo) (node : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 config_node_OK cfg node ->
 BDDor_memo_OK cfg orm -> BDDor_memo_OK (fst (BDDneg cfg negm node)) orm.
Proof.
  intros.  apply nodes_preserved_orm_OK with (cfg := cfg).  assumption.  apply BDDneg_keeps_config_OK.
  assumption.  assumption.  assumption.  apply BDDneg_preserves_nodes.  assumption.
  assumption.  assumption.  assumption.
Qed.

Lemma BDDneg_keeps_node_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (node : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 config_node_OK cfg node ->
 forall node' : ad,
 config_node_OK cfg node' ->
 config_node_OK (fst (BDDneg cfg negm node)) node'.
Proof.
  intros.  apply nodes_preserved_2 with (cfg := cfg).  assumption.  apply BDDneg_preserves_nodes.
  assumption.  assumption.  assumption.
Qed.

Lemma BDDneg_preserves_bool_fun :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (node : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 config_node_OK cfg node ->
 forall node' : ad,
 config_node_OK cfg node' ->
 bool_fun_eq (bool_fun_of_BDD (fst (BDDneg cfg negm node)) node')
   (bool_fun_of_BDD cfg node').
Proof.
  intros.  apply nodes_preserved_3.  assumption.  apply BDDneg_keeps_config_OK.
  assumption.  assumption.  assumption.  apply BDDneg_preserves_nodes.  assumption.
  assumption.  assumption.  assumption.
Qed.

Lemma BDDneg_is_neg :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (node : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 config_node_OK cfg node ->
 bool_fun_eq
   (bool_fun_of_BDD (fst (BDDneg cfg negm node))
      (fst (snd (BDDneg cfg negm node))))
   (bool_fun_neg (bool_fun_of_BDD cfg node)).
Proof.
  intros.  unfold BDDneg in |- *.  elim
   (prod_sum _ _ (BDDneg_1_1 cfg negm node (S (nat_of_N (var cfg node))))).
  intro.  elim x; clear x.  intros cfg' node'.  intro.  elim H2; clear H2.
  intros negm' H2.  rewrite H2.  simpl in |- *.  rewrite (BDDneg_1_1_eq_1 (S (nat_of_N (var cfg node))) cfg negm node)
    in H2.
  cut
   (is_internal_node cfg node ->
    nat_of_N (var cfg node) < S (nat_of_N (var cfg node))).
  intro.  replace cfg' with
   (fst (fst (BDDneg_1 (cfg, node, negm) (S (nat_of_N (var cfg node)))))).
  replace node' with
   (snd (fst (BDDneg_1 (cfg, node, negm) (S (nat_of_N (var cfg node)))))).
  rewrite
   (proj1
      (BDDneg_1_lemma' (S (nat_of_N (var cfg node)))
         (cfg, node, negm) H H1 H0 H3)).
  exact (proj2 (proj2 (proj2 (proj2 (BDDneg_2_lemma _ _ _ H H1 H3))))).
  rewrite H2; reflexivity.  rewrite H2; reflexivity.  intro.  unfold lt in |- *.  apply le_n.
Qed.

Lemma BDDor_keeps_config_OK :
 forall (cfg : BDDconfig) (orm : BDDor_memo) (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 -> BDDconfig_OK (fst (BDDor cfg orm node1 node2)).
Proof.
  intros.  unfold BDDor in |- *.  rewrite
   (BDDor_1_1_eq_1
      (S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))) cfg
      orm node1 node2).
  cut
   (is_internal_node cfg node1 ->
    is_internal_node cfg node2 ->
    max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)) <
    S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))).
  intros.  refine (proj1 (BDDor_1_lemma _ _ _ _ _ _ _ _ _ _)).  assumption.
  assumption.  assumption.  assumption.  assumption.  intros.  unfold lt in |- *.  apply le_n.
Qed.

Lemma BDDor_node_OK :
 forall (cfg : BDDconfig) (orm : BDDor_memo) (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 config_node_OK (fst (BDDor cfg orm node1 node2))
   (fst (snd (BDDor cfg orm node1 node2))).
Proof.
  intros.  unfold BDDor in |- *.  rewrite
   (BDDor_1_1_eq_1
      (S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))) cfg
      orm node1 node2).
  cut
   (is_internal_node cfg node1 ->
    is_internal_node cfg node2 ->
    max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)) <
    S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))).
  intros.  refine (proj1 (proj2 (proj2 (BDDor_1_lemma _ _ _ _ _ _ _ _ _ _)))).
  assumption.  assumption.  assumption.  assumption.  assumption.  intros.
  unfold lt in |- *.  apply le_n.
Qed.

Lemma BDDor_keeps_or_memo_OK :
 forall (cfg : BDDconfig) (orm : BDDor_memo) (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 BDDor_memo_OK (fst (BDDor cfg orm node1 node2))
   (snd (snd (BDDor cfg orm node1 node2))).
Proof.
  intros.  unfold BDDor in |- *.  rewrite
   (BDDor_1_1_eq_1
      (S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))) cfg
      orm node1 node2).
  cut
   (is_internal_node cfg node1 ->
    is_internal_node cfg node2 ->
    max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)) <
    S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))).
  intros.  refine (proj1 (proj2 (BDDor_1_lemma _ _ _ _ _ _ _ _ _ _))).
  assumption.  assumption.  assumption.  assumption.  assumption.  intros.
  unfold lt in |- *.  apply le_n.
Qed.

Lemma BDDor_preserves_nodes :
 forall (cfg : BDDconfig) (orm : BDDor_memo) (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 nodes_preserved cfg (fst (BDDor cfg orm node1 node2)).
Proof.
  intros.  unfold BDDor in |- *.  rewrite
   (BDDor_1_1_eq_1
      (S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))) cfg
      orm node1 node2).
  cut
   (is_internal_node cfg node1 ->
    is_internal_node cfg node2 ->
    max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)) <
    S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))).
  intros.  refine (proj1 (proj2 (proj2 (proj2 (BDDor_1_lemma _ _ _ _ _ _ _ _ _ _))))).
  assumption.  assumption.  assumption.  assumption.  assumption.  intros.  unfold lt in |- *.
  apply le_n.
Qed.

Lemma BDDor_keeps_node_OK :
 forall (cfg : BDDconfig) (orm : BDDor_memo) (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 forall node : ad,
 config_node_OK cfg node ->
 config_node_OK (fst (BDDor cfg orm node1 node2)) node.
Proof.
  intros.  apply nodes_preserved_2 with (cfg := cfg).  assumption.  apply BDDor_preserves_nodes.
  assumption.  assumption.  assumption.  assumption.
Qed.

Lemma BDDor_preserves_bool_fun :
 forall (cfg : BDDconfig) (orm : BDDor_memo) (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 forall node : ad,
 config_node_OK cfg node ->
 bool_fun_eq (bool_fun_of_BDD (fst (BDDor cfg orm node1 node2)) node)
   (bool_fun_of_BDD cfg node).
Proof.
  intros.  apply nodes_preserved_3.  assumption.  apply BDDor_keeps_config_OK.
  assumption.  assumption.  assumption.  assumption.  apply BDDor_preserves_nodes.
  assumption.  assumption.  assumption.  assumption.  assumption.
Qed.

Lemma BDDor_keeps_neg_memo_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo)
   (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 BDDneg_memo_OK_2 cfg negm ->
 BDDneg_memo_OK_2 (fst (BDDor cfg orm node1 node2)) negm.
Proof.
  intros.  apply nodes_preserved_negm_OK with (cfg := cfg).  assumption.  apply BDDor_keeps_config_OK.
  assumption.  assumption.  assumption.  assumption.  apply BDDor_preserves_nodes.
  assumption.  assumption.  assumption.  assumption.  assumption.
Qed.

Lemma BDDor_is_or :
 forall (cfg : BDDconfig) (orm : BDDor_memo) (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 bool_fun_eq
   (bool_fun_of_BDD (fst (BDDor cfg orm node1 node2))
      (fst (snd (BDDor cfg orm node1 node2))))
   (bool_fun_or (bool_fun_of_BDD cfg node1) (bool_fun_of_BDD cfg node2)).
Proof.
  intros.  unfold BDDor in |- *.  rewrite
   (BDDor_1_1_eq_1
      (S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))) cfg
      orm node1 node2).
  cut
   (is_internal_node cfg node1 ->
    is_internal_node cfg node2 ->
    max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)) <
    S (max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)))).
  intros.  refine
   (proj2 (proj2 (proj2 (proj2 (proj2 (BDDor_1_lemma _ _ _ _ _ _ _ _ _ _)))))).
  assumption.  assumption.  assumption.  assumption.  assumption.  intros.  unfold lt in |- *.
  apply le_n.
Qed.

Lemma BDDand_keeps_config_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo)
   (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 BDDconfig_OK (fst (BDDand cfg negm orm node1 node2)).
Proof.

  intros.  unfold BDDand in |- *.  elim (prod_sum _ _ (BDDneg cfg negm node1)).  intros cfg' H4.
  elim H4; clear H4.  intro.  elim x; clear x.  intros node1' negm' H4.  rewrite H4.
  elim (prod_sum _ _ (BDDneg cfg' negm' node2)).  intros cfg'' H5.  elim H5; clear H5.
  intro.  elim x; clear x.  intros node2' negm'' H5.  rewrite H5.  elim (prod_sum _ _ (BDDor cfg'' orm node1' node2')).
  intros cfg''' H6.  elim H6; clear H6.  intro.  elim x; clear x.  intros node orm' H6.
  rewrite H6.  elim (prod_sum _ _ (BDDneg cfg''' negm'' node)).  intros cfg'''' H7.
  elim H7; clear H7.  intro.  elim x; clear x.  intros node' negm''' H7.  rewrite H7.
  simpl in |- *.  cut (BDDconfig_OK cfg').  cut (config_node_OK cfg' node1').  cut (config_node_OK cfg' node2).
  cut (BDDneg_memo_OK_2 cfg' negm').  cut (BDDor_memo_OK cfg' orm).  intros.
  cut (BDDconfig_OK cfg'').  cut (config_node_OK cfg'' node2').  cut (config_node_OK cfg'' node1').
  cut (BDDneg_memo_OK_2 cfg'' negm'').  cut (BDDor_memo_OK cfg'' orm).  intros.
  cut (BDDconfig_OK cfg''').  cut (config_node_OK cfg''' node).  cut (BDDneg_memo_OK_2 cfg''' negm'').
  cut (BDDor_memo_OK cfg''' orm').  intros.

  replace cfg'''' with (fst (BDDneg cfg''' negm'' node)).
apply BDDneg_keeps_config_OK.
assumption.

assumption.

assumption.

rewrite H7; reflexivity.

  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).  replace orm' with (snd (snd (BDDor cfg'' orm node1' node2'))).
  apply BDDor_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  assumption.
  assumption.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  replace node with (fst (snd (BDDor cfg'' orm node1' node2'))).  apply BDDor_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H6; reflexivity.
  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_config_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  replace negm'' with (snd (snd (BDDneg cfg' negm' node2))).  apply BDDneg_keeps_neg_memo_OK.
  assumption.  assumption.  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  apply BDDneg_keeps_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  replace node2' with (fst (snd (BDDneg cfg' negm' node2))).  apply BDDneg_node_OK.  assumption.  assumption.
  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_config_OK.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.

  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_or_memo_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  replace negm' with (snd (snd (BDDneg cfg negm node1))).
  apply BDDneg_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  apply BDDneg_keeps_node_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  replace node1' with (fst (snd (BDDneg cfg negm node1))).  apply BDDneg_node_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_config_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.

Qed.

Lemma BDDand_node_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo)
   (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 config_node_OK (fst (BDDand cfg negm orm node1 node2))
   (fst (snd (BDDand cfg negm orm node1 node2))).
Proof.

  intros.  unfold BDDand in |- *.  elim (prod_sum _ _ (BDDneg cfg negm node1)).  intros cfg' H4.
  elim H4; clear H4.  intro.  elim x; clear x.  intros node1' negm' H4.  rewrite H4.
  elim (prod_sum _ _ (BDDneg cfg' negm' node2)).  intros cfg'' H5.  elim H5; clear H5.
  intro.  elim x; clear x.  intros node2' negm'' H5.  rewrite H5.  elim (prod_sum _ _ (BDDor cfg'' orm node1' node2')).
  intros cfg''' H6.  elim H6; clear H6.  intro.  elim x; clear x.  intros node orm' H6.
  rewrite H6.  elim (prod_sum _ _ (BDDneg cfg''' negm'' node)).  intros cfg'''' H7.
  elim H7; clear H7.  intro.  elim x; clear x.  intros node' negm''' H7.  rewrite H7.
  simpl in |- *.  cut (BDDconfig_OK cfg').  cut (config_node_OK cfg' node1').  cut (config_node_OK cfg' node2).
  cut (BDDneg_memo_OK_2 cfg' negm').  cut (BDDor_memo_OK cfg' orm).  intros.
  cut (BDDconfig_OK cfg'').  cut (config_node_OK cfg'' node2').  cut (config_node_OK cfg'' node1').
  cut (BDDneg_memo_OK_2 cfg'' negm'').  cut (BDDor_memo_OK cfg'' orm).  intros.
  cut (BDDconfig_OK cfg''').  cut (config_node_OK cfg''' node).  cut (BDDneg_memo_OK_2 cfg''' negm'').
  cut (BDDor_memo_OK cfg''' orm').  intros.

replace cfg'''' with (fst (BDDneg cfg''' negm'' node)).
replace node' with (fst (snd (BDDneg cfg''' negm'' node))).
apply BDDneg_node_OK.
assumption.

assumption.

assumption.

rewrite H7; reflexivity.

rewrite H7; reflexivity.

  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).  replace orm' with (snd (snd (BDDor cfg'' orm node1' node2'))).
  apply BDDor_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  assumption.
  assumption.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  replace node with (fst (snd (BDDor cfg'' orm node1' node2'))).  apply BDDor_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H6; reflexivity.
  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_config_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  replace negm'' with (snd (snd (BDDneg cfg' negm' node2))).  apply BDDneg_keeps_neg_memo_OK.
  assumption.  assumption.  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  apply BDDneg_keeps_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  replace node2' with (fst (snd (BDDneg cfg' negm' node2))).  apply BDDneg_node_OK.  assumption.  assumption.
  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_config_OK.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.

  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_or_memo_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  replace negm' with (snd (snd (BDDneg cfg negm node1))).
  apply BDDneg_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  apply BDDneg_keeps_node_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  replace node1' with (fst (snd (BDDneg cfg negm node1))).  apply BDDneg_node_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_config_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.

Qed.

Lemma BDDand_preserves_nodes :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo)
   (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 nodes_preserved cfg (fst (BDDand cfg negm orm node1 node2)).
Proof.

  intros.  unfold BDDand in |- *.  elim (prod_sum _ _ (BDDneg cfg negm node1)).  intros cfg' H4.
  elim H4; clear H4.  intro.  elim x; clear x.  intros node1' negm' H4.  rewrite H4.
  elim (prod_sum _ _ (BDDneg cfg' negm' node2)).  intros cfg'' H5.  elim H5; clear H5.
  intro.  elim x; clear x.  intros node2' negm'' H5.  rewrite H5.  elim (prod_sum _ _ (BDDor cfg'' orm node1' node2')).
  intros cfg''' H6.  elim H6; clear H6.  intro.  elim x; clear x.  intros node orm' H6.
  rewrite H6.  elim (prod_sum _ _ (BDDneg cfg''' negm'' node)).  intros cfg'''' H7.
  elim H7; clear H7.  intro.  elim x; clear x.  intros node' negm''' H7.  rewrite H7.
  simpl in |- *.  cut (BDDconfig_OK cfg').  cut (config_node_OK cfg' node1').  cut (config_node_OK cfg' node2).
  cut (BDDneg_memo_OK_2 cfg' negm').  cut (BDDor_memo_OK cfg' orm).  intros.
  cut (BDDconfig_OK cfg'').  cut (config_node_OK cfg'' node2').  cut (config_node_OK cfg'' node1').
  cut (BDDneg_memo_OK_2 cfg'' negm'').  cut (BDDor_memo_OK cfg'' orm).  intros.
  cut (BDDconfig_OK cfg''').  cut (config_node_OK cfg''' node).  cut (BDDneg_memo_OK_2 cfg''' negm'').
  cut (BDDor_memo_OK cfg''' orm').  intros.

apply nodes_preserved_trans with (cfg2 := cfg').
replace cfg' with (fst (BDDneg cfg negm node1)).
apply BDDneg_preserves_nodes.
assumption.

assumption.

assumption.

rewrite H4; reflexivity.

apply nodes_preserved_trans with (cfg2 := cfg'').
replace cfg'' with (fst (BDDneg cfg' negm' node2)).
apply BDDneg_preserves_nodes.
assumption.

assumption.

assumption.

rewrite H5; reflexivity.

apply nodes_preserved_trans with (cfg2 := cfg''').
replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
apply BDDor_preserves_nodes.
assumption.

assumption.

assumption.

assumption.

rewrite H6; reflexivity.

replace cfg'''' with (fst (BDDneg cfg''' negm'' node)).
apply BDDneg_preserves_nodes.
assumption.

assumption.

assumption.

rewrite H7; reflexivity.

  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).  replace orm' with (snd (snd (BDDor cfg'' orm node1' node2'))).
  apply BDDor_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  assumption.
  assumption.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  replace node with (fst (snd (BDDor cfg'' orm node1' node2'))).  apply BDDor_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H6; reflexivity.
  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_config_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  replace negm'' with (snd (snd (BDDneg cfg' negm' node2))).  apply BDDneg_keeps_neg_memo_OK.
  assumption.  assumption.  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  apply BDDneg_keeps_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  replace node2' with (fst (snd (BDDneg cfg' negm' node2))).  apply BDDneg_node_OK.  assumption.  assumption.
  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_config_OK.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.

  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_or_memo_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  replace negm' with (snd (snd (BDDneg cfg negm node1))).
  apply BDDneg_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  apply BDDneg_keeps_node_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  replace node1' with (fst (snd (BDDneg cfg negm node1))).  apply BDDneg_node_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_config_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.

Qed.

Lemma BDDand_keeps_node_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo)
   (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 forall node : ad,
 config_node_OK cfg node ->
 config_node_OK (fst (BDDand cfg negm orm node1 node2)) node.
Proof.
  intros.  apply nodes_preserved_2 with (cfg := cfg).  assumption.  apply BDDand_preserves_nodes.
  assumption.  assumption.  assumption.  assumption.  assumption.
Qed.

Lemma BDDand_preserves_bool_fun :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo)
   (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 forall node : ad,
 config_node_OK cfg node ->
 bool_fun_eq (bool_fun_of_BDD (fst (BDDand cfg negm orm node1 node2)) node)
   (bool_fun_of_BDD cfg node).
Proof.
  intros.  apply nodes_preserved_3.  assumption.  apply BDDand_keeps_config_OK.
  assumption.  assumption.  assumption.  assumption.  assumption.  apply BDDand_preserves_nodes.
  assumption.  assumption.  assumption.  assumption.  assumption.  assumption.
Qed.

Lemma BDDand_keeps_neg_memo_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo)
   (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 BDDneg_memo_OK_2 (fst (BDDand cfg negm orm node1 node2))
   (fst (snd (snd (BDDand cfg negm orm node1 node2)))).
Proof.

  intros.  unfold BDDand in |- *.  elim (prod_sum _ _ (BDDneg cfg negm node1)).  intros cfg' H4.
  elim H4; clear H4.  intro.  elim x; clear x.  intros node1' negm' H4.  rewrite H4.
  elim (prod_sum _ _ (BDDneg cfg' negm' node2)).  intros cfg'' H5.  elim H5; clear H5.
  intro.  elim x; clear x.  intros node2' negm'' H5.  rewrite H5.  elim (prod_sum _ _ (BDDor cfg'' orm node1' node2')).
  intros cfg''' H6.  elim H6; clear H6.  intro.  elim x; clear x.  intros node orm' H6.
  rewrite H6.  elim (prod_sum _ _ (BDDneg cfg''' negm'' node)).  intros cfg'''' H7.
  elim H7; clear H7.  intro.  elim x; clear x.  intros node' negm''' H7.  rewrite H7.
  simpl in |- *.  cut (BDDconfig_OK cfg').  cut (config_node_OK cfg' node1').  cut (config_node_OK cfg' node2).
  cut (BDDneg_memo_OK_2 cfg' negm').  cut (BDDor_memo_OK cfg' orm).  intros.
  cut (BDDconfig_OK cfg'').  cut (config_node_OK cfg'' node2').  cut (config_node_OK cfg'' node1').
  cut (BDDneg_memo_OK_2 cfg'' negm'').  cut (BDDor_memo_OK cfg'' orm).  intros.
  cut (BDDconfig_OK cfg''').  cut (config_node_OK cfg''' node).  cut (BDDneg_memo_OK_2 cfg''' negm'').
  cut (BDDor_memo_OK cfg''' orm').  intros.

replace cfg'''' with (fst (BDDneg cfg''' negm'' node)).
replace negm''' with (snd (snd (BDDneg cfg''' negm'' node))).
apply BDDneg_keeps_neg_memo_OK.
assumption.

assumption.

assumption.

rewrite H7; reflexivity.

rewrite H7; reflexivity.

  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).  replace orm' with (snd (snd (BDDor cfg'' orm node1' node2'))).
  apply BDDor_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  assumption.
  assumption.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  replace node with (fst (snd (BDDor cfg'' orm node1' node2'))).  apply BDDor_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H6; reflexivity.
  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_config_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  replace negm'' with (snd (snd (BDDneg cfg' negm' node2))).  apply BDDneg_keeps_neg_memo_OK.
  assumption.  assumption.  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  apply BDDneg_keeps_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  replace node2' with (fst (snd (BDDneg cfg' negm' node2))).  apply BDDneg_node_OK.  assumption.  assumption.
  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_config_OK.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.

  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_or_memo_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  replace negm' with (snd (snd (BDDneg cfg negm node1))).
  apply BDDneg_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  apply BDDneg_keeps_node_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  replace node1' with (fst (snd (BDDneg cfg negm node1))).  apply BDDneg_node_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_config_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.

Qed.

Lemma BDDand_keeps_or_memo_OK :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo)
   (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 BDDor_memo_OK (fst (BDDand cfg negm orm node1 node2))
   (snd (snd (snd (BDDand cfg negm orm node1 node2)))).
Proof.

  intros.  unfold BDDand in |- *.  elim (prod_sum _ _ (BDDneg cfg negm node1)).  intros cfg' H4.
  elim H4; clear H4.  intro.  elim x; clear x.  intros node1' negm' H4.  rewrite H4.
  elim (prod_sum _ _ (BDDneg cfg' negm' node2)).  intros cfg'' H5.  elim H5; clear H5.
  intro.  elim x; clear x.  intros node2' negm'' H5.  rewrite H5.  elim (prod_sum _ _ (BDDor cfg'' orm node1' node2')).
  intros cfg''' H6.  elim H6; clear H6.  intro.  elim x; clear x.  intros node orm' H6.
  rewrite H6.  elim (prod_sum _ _ (BDDneg cfg''' negm'' node)).  intros cfg'''' H7.
  elim H7; clear H7.  intro.  elim x; clear x.  intros node' negm''' H7.  rewrite H7.
  simpl in |- *.  cut (BDDconfig_OK cfg').  cut (config_node_OK cfg' node1').  cut (config_node_OK cfg' node2).
  cut (BDDneg_memo_OK_2 cfg' negm').  cut (BDDor_memo_OK cfg' orm).  intros.
  cut (BDDconfig_OK cfg'').  cut (config_node_OK cfg'' node2').  cut (config_node_OK cfg'' node1').
  cut (BDDneg_memo_OK_2 cfg'' negm'').  cut (BDDor_memo_OK cfg'' orm).  intros.
  cut (BDDconfig_OK cfg''').  cut (config_node_OK cfg''' node).  cut (BDDneg_memo_OK_2 cfg''' negm'').
  cut (BDDor_memo_OK cfg''' orm').  intros.

replace cfg'''' with (fst (BDDneg cfg''' negm'' node)).
apply BDDneg_keeps_or_memo_OK.
assumption.

assumption.

assumption.

assumption.

rewrite H7; reflexivity.

  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).  replace orm' with (snd (snd (BDDor cfg'' orm node1' node2'))).
  apply BDDor_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  assumption.
  assumption.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  replace node with (fst (snd (BDDor cfg'' orm node1' node2'))).  apply BDDor_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H6; reflexivity.
  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_config_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  replace negm'' with (snd (snd (BDDneg cfg' negm' node2))).  apply BDDneg_keeps_neg_memo_OK.
  assumption.  assumption.  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  apply BDDneg_keeps_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  replace node2' with (fst (snd (BDDneg cfg' negm' node2))).  apply BDDneg_node_OK.  assumption.  assumption.
  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_config_OK.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.

  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_or_memo_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  replace negm' with (snd (snd (BDDneg cfg negm node1))).
  apply BDDneg_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  apply BDDneg_keeps_node_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  replace node1' with (fst (snd (BDDneg cfg negm node1))).  apply BDDneg_node_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_config_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.

Qed.

Definition bool_fun_and (bf1 bf2 : bool_fun) : bool_fun :=
  fun vb : var_binding => bf1 vb && bf2 vb.

Lemma bool_fun_and_is_neg_or_neg_neg :
 forall bf1 bf2 : bool_fun,
 bool_fun_eq (bool_fun_and bf1 bf2)
   (bool_fun_neg (bool_fun_or (bool_fun_neg bf1) (bool_fun_neg bf2))).
Proof.
  intros.  unfold bool_fun_eq, bool_fun_neg, bool_fun_or, bool_fun_and in |- *.  unfold bool_fun_eval in |- *.
  intro.  elim (bf1 vb).  elim (bf2 vb).  reflexivity.  reflexivity.  reflexivity.
Qed.

Lemma BDDand_is_and :
 forall (cfg : BDDconfig) (negm : BDDneg_memo) (orm : BDDor_memo)
   (node1 node2 : ad),
 BDDconfig_OK cfg ->
 BDDneg_memo_OK_2 cfg negm ->
 BDDor_memo_OK cfg orm ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 bool_fun_eq
   (bool_fun_of_BDD (fst (BDDand cfg negm orm node1 node2))
      (fst (snd (BDDand cfg negm orm node1 node2))))
   (bool_fun_and (bool_fun_of_BDD cfg node1) (bool_fun_of_BDD cfg node2)).
Proof.

  intros.  unfold BDDand in |- *.  elim (prod_sum _ _ (BDDneg cfg negm node1)).  intros cfg' H4.
  elim H4; clear H4.  intro.  elim x; clear x.  intros node1' negm' H4.  rewrite H4.
  elim (prod_sum _ _ (BDDneg cfg' negm' node2)).  intros cfg'' H5.  elim H5; clear H5.
  intro.  elim x; clear x.  intros node2' negm'' H5.  rewrite H5.  elim (prod_sum _ _ (BDDor cfg'' orm node1' node2')).
  intros cfg''' H6.  elim H6; clear H6.  intro.  elim x; clear x.  intros node orm' H6.
  rewrite H6.  elim (prod_sum _ _ (BDDneg cfg''' negm'' node)).  intros cfg'''' H7.
  elim H7; clear H7.  intro.  elim x; clear x.  intros node' negm''' H7.  rewrite H7.
  simpl in |- *.  cut (BDDconfig_OK cfg').  cut (config_node_OK cfg' node1').  cut (config_node_OK cfg' node2).
  cut (BDDneg_memo_OK_2 cfg' negm').  cut (BDDor_memo_OK cfg' orm).  intros.
  cut (BDDconfig_OK cfg'').  cut (config_node_OK cfg'' node2').  cut (config_node_OK cfg'' node1').
  cut (BDDneg_memo_OK_2 cfg'' negm'').  cut (BDDor_memo_OK cfg'' orm).  intros.
  cut (BDDconfig_OK cfg''').  cut (config_node_OK cfg''' node).  cut (BDDneg_memo_OK_2 cfg''' negm'').
  cut (BDDor_memo_OK cfg''' orm').  intros.

apply
 bool_fun_eq_trans with (bf2 := bool_fun_neg (bool_fun_of_BDD cfg''' node)).
replace cfg'''' with (fst (BDDneg cfg''' negm'' node)).
replace node' with (fst (snd (BDDneg cfg''' negm'' node))).
apply BDDneg_is_neg.
assumption.

assumption.

assumption.

rewrite H7; reflexivity.

rewrite H7; reflexivity.

apply
 bool_fun_eq_trans
  with
    (bf2 := bool_fun_neg
              (bool_fun_or (bool_fun_of_BDD cfg'' node1')
                 (bool_fun_of_BDD cfg'' node2'))).
apply bool_fun_eq_neg_1.
replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
replace node with (fst (snd (BDDor cfg'' orm node1' node2'))).
apply BDDor_is_or.
assumption.

assumption.

assumption.

assumption.

rewrite H6; reflexivity.

rewrite H6; reflexivity.

apply
 bool_fun_eq_trans
  with
    (bf2 := bool_fun_neg
              (bool_fun_or (bool_fun_neg (bool_fun_of_BDD cfg node1))
                 (bool_fun_neg (bool_fun_of_BDD cfg node2)))).
apply bool_fun_eq_neg_1.
apply bool_fun_or_preserves_eq.
apply bool_fun_eq_trans with (bf2 := bool_fun_of_BDD cfg' node1').
replace cfg'' with (fst (BDDneg cfg' negm' node2)).
apply BDDneg_preserves_bool_fun.
assumption.

assumption.

assumption.

assumption.

rewrite H5; reflexivity.

replace cfg' with (fst (BDDneg cfg negm node1)).
replace node1' with (fst (snd (BDDneg cfg negm node1))).
apply BDDneg_is_neg.
assumption.

assumption.

assumption.

rewrite H4; reflexivity.

rewrite H4; reflexivity.

apply
 bool_fun_eq_trans with (bf2 := bool_fun_neg (bool_fun_of_BDD cfg' node2)).
replace cfg'' with (fst (BDDneg cfg' negm' node2)).
replace node2' with (fst (snd (BDDneg cfg' negm' node2))).
apply BDDneg_is_neg.
assumption.

assumption.

assumption.

rewrite H5; reflexivity.

rewrite H5; reflexivity.

replace cfg' with (fst (BDDneg cfg negm node1)).
apply bool_fun_eq_neg_1.
apply BDDneg_preserves_bool_fun.
assumption.

assumption.

assumption.

assumption.

rewrite H4; reflexivity.

apply bool_fun_eq_symm.
apply bool_fun_and_is_neg_or_neg_neg.

  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).  replace orm' with (snd (snd (BDDor cfg'' orm node1' node2'))).
  apply BDDor_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  assumption.
  assumption.  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  replace node with (fst (snd (BDDor cfg'' orm node1' node2'))).  apply BDDor_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H6; reflexivity.
  rewrite H6; reflexivity.  replace cfg''' with (fst (BDDor cfg'' orm node1' node2')).
  apply BDDor_keeps_config_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H6; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_or_memo_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  replace negm'' with (snd (snd (BDDneg cfg' negm' node2))).  apply BDDneg_keeps_neg_memo_OK.
  assumption.  assumption.  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  apply BDDneg_keeps_node_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.
  replace cfg'' with (fst (BDDneg cfg' negm' node2)).  replace node2' with (fst (snd (BDDneg cfg' negm' node2))).  apply BDDneg_node_OK.  assumption.  assumption.
  assumption.  rewrite H5; reflexivity.  rewrite H5; reflexivity.  replace cfg'' with (fst (BDDneg cfg' negm' node2)).
  apply BDDneg_keeps_config_OK.  assumption.  assumption.  assumption.  rewrite H5; reflexivity.

  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_or_memo_OK.
  assumption.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  replace negm' with (snd (snd (BDDneg cfg negm node1))).
  apply BDDneg_keeps_neg_memo_OK.  assumption.  assumption.  assumption.  rewrite H4; reflexivity.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  apply BDDneg_keeps_node_OK.  assumption.  assumption.  assumption.  assumption.
  rewrite H4; reflexivity.  replace cfg' with (fst (BDDneg cfg negm node1)).
  replace node1' with (fst (snd (BDDneg cfg negm node1))).  apply BDDneg_node_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.  rewrite H4; reflexivity.
  replace cfg' with (fst (BDDneg cfg negm node1)).  apply BDDneg_keeps_config_OK.
  assumption.  assumption.  assumption.  rewrite H4; reflexivity.

Qed.


(*
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 * http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *)

(** Imp with the Json data model *)

Require Import String.
Require Import List.
Require Import ZArith.
Require Import Utils.
Require Import BrandRelation.
Require Import ForeignEJson.
Require Import EJson.
Require Import EJsonGroupBy.
Require Import EJsonSortBy.
Require Import ForeignEJsonRuntime.

Section EJsonRuntimeOperators.
  Local Open Scope string.

  Context {foreign_ejson_model:Set}.
  Context {fejson:foreign_ejson foreign_ejson_model}.
  Context {foreign_ejson_runtime_op : Set}.

  Section Syntax.
    Inductive ejson_runtime_op :=
    (* Generic *)
    | EJsonRuntimeEqual : ejson_runtime_op
    | EJsonRuntimeCompare : ejson_runtime_op
    | EJsonRuntimeToString : ejson_runtime_op
    | EJsonRuntimeToText : ejson_runtime_op
    (* Record *)
    | EJsonRuntimeRecConcat : ejson_runtime_op
    | EJsonRuntimeRecMerge : ejson_runtime_op
    | EJsonRuntimeRecRemove: ejson_runtime_op
    | EJsonRuntimeRecProject: ejson_runtime_op
    | EJsonRuntimeRecDot : ejson_runtime_op
    (* Array *)
    | EJsonRuntimeArray : ejson_runtime_op
    | EJsonRuntimeArrayLength : ejson_runtime_op
    | EJsonRuntimeArrayPush : ejson_runtime_op
    | EJsonRuntimeArrayAccess : ejson_runtime_op
    (* Sum *)
    | EJsonRuntimeEither : ejson_runtime_op
    | EJsonRuntimeToLeft: ejson_runtime_op
    | EJsonRuntimeToRight: ejson_runtime_op
    (* Brand *)
    | EJsonRuntimeUnbrand : ejson_runtime_op
    | EJsonRuntimeCast : ejson_runtime_op
    (* Collection *)
    | EJsonRuntimeDistinct : ejson_runtime_op
    | EJsonRuntimeSingleton : ejson_runtime_op
    | EJsonRuntimeFlatten : ejson_runtime_op
    | EJsonRuntimeUnion : ejson_runtime_op
    | EJsonRuntimeMinus : ejson_runtime_op
    | EJsonRuntimeMin : ejson_runtime_op
    | EJsonRuntimeMax : ejson_runtime_op
    | EJsonRuntimeNth : ejson_runtime_op
    | EJsonRuntimeCount : ejson_runtime_op
    | EJsonRuntimeContains : ejson_runtime_op
    | EJsonRuntimeSort : ejson_runtime_op
    | EJsonRuntimeGroupBy : ejson_runtime_op
    (* String *)
    | EJsonRuntimeLength : ejson_runtime_op
    | EJsonRuntimeSubstring : ejson_runtime_op
    | EJsonRuntimeSubstringEnd : ejson_runtime_op
    | EJsonRuntimeStringJoin : ejson_runtime_op
    | EJsonRuntimeLike : ejson_runtime_op
    (* Integer *)
    | EJsonRuntimeNatLt : ejson_runtime_op
    | EJsonRuntimeNatLe : ejson_runtime_op
    | EJsonRuntimeNatPlus : ejson_runtime_op
    | EJsonRuntimeNatMinus : ejson_runtime_op
    | EJsonRuntimeNatMult : ejson_runtime_op
    | EJsonRuntimeNatDiv : ejson_runtime_op
    | EJsonRuntimeNatRem : ejson_runtime_op
    | EJsonRuntimeNatAbs : ejson_runtime_op
    | EJsonRuntimeNatLog2 : ejson_runtime_op
    | EJsonRuntimeNatSqrt : ejson_runtime_op
    | EJsonRuntimeNatMinPair : ejson_runtime_op
    | EJsonRuntimeNatMaxPair : ejson_runtime_op
    | EJsonRuntimeNatSum : ejson_runtime_op
    | EJsonRuntimeNatMin : ejson_runtime_op
    | EJsonRuntimeNatMax : ejson_runtime_op
    | EJsonRuntimeNatArithMean : ejson_runtime_op
    | EJsonRuntimeFloatOfNat : ejson_runtime_op
    (* Float *)
    | EJsonRuntimeFloatSum : ejson_runtime_op
    | EJsonRuntimeFloatArithMean : ejson_runtime_op
    | EJsonRuntimeFloatMin : ejson_runtime_op
    | EJsonRuntimeFloatMax : ejson_runtime_op
    | EJsonRuntimeNatOfFloat : ejson_runtime_op
    (* Foreign *)
    | EJsonRuntimeForeign (fop:foreign_ejson_runtime_op) : ejson_runtime_op
    .

  End Syntax.

  Context {fejruntime:foreign_ejson_runtime foreign_ejson_runtime_op}.

  Section Util.
    Local Open Scope string.

    Definition string_of_ejson_runtime_op (op: ejson_runtime_op) :=
      match op with
      (* Generic *)
      | EJsonRuntimeEqual => "equal"
      | EJsonRuntimeCompare => "compare"
      | EJsonRuntimeToString => "toString"
      | EJsonRuntimeToText => "toText"
      (* Record *)
      | EJsonRuntimeRecConcat => "recConcat"
      | EJsonRuntimeRecMerge => "recMerge"
      | EJsonRuntimeRecRemove=> "recRemove"
      | EJsonRuntimeRecProject=> "recProject"
      | EJsonRuntimeRecDot => "recDot"
      (* Array *)
      | EJsonRuntimeArray => "array"
      | EJsonRuntimeArrayLength => "arrayLength"
      | EJsonRuntimeArrayPush => "arrayPush"
      | EJsonRuntimeArrayAccess => "arrayAccess"
      (* Sum *)
      | EJsonRuntimeEither => "either"
      | EJsonRuntimeToLeft=> "getLeft"
      | EJsonRuntimeToRight=> "getRight"
      (* Brand *)
      | EJsonRuntimeUnbrand => "unbrand"
      | EJsonRuntimeCast => "cast"
      (* Collection *)
      | EJsonRuntimeDistinct => "distinct"
      | EJsonRuntimeSingleton => "singleton"
      | EJsonRuntimeFlatten => "flatten"
      | EJsonRuntimeUnion => "union"
      | EJsonRuntimeMinus => "minus"
      | EJsonRuntimeMin => "min"
      | EJsonRuntimeMax => "max"
      | EJsonRuntimeNth => "nth"
      | EJsonRuntimeCount => "count"
      | EJsonRuntimeContains => "contains"
      | EJsonRuntimeSort => "sort"
      | EJsonRuntimeGroupBy => "groupBy"
      (* String *)
      | EJsonRuntimeLength => "length"
      | EJsonRuntimeSubstring => "substring"
      | EJsonRuntimeSubstringEnd => "substringEnd"
      | EJsonRuntimeStringJoin => "stringJoin"
      | EJsonRuntimeLike => "like"
      (* Integer *)
      | EJsonRuntimeNatLt => "natLt"
      | EJsonRuntimeNatLe => "natLe"
      | EJsonRuntimeNatPlus => "natPlus"
      | EJsonRuntimeNatMinus => "natMinus"
      | EJsonRuntimeNatMult => "natMult"
      | EJsonRuntimeNatDiv => "natDiv"
      | EJsonRuntimeNatRem => "natRem"
      | EJsonRuntimeNatAbs => "natAbs"
      | EJsonRuntimeNatLog2 => "natLog2"
      | EJsonRuntimeNatSqrt => "natSqrt"
      | EJsonRuntimeNatMinPair => "natMinPair"
      | EJsonRuntimeNatMaxPair => "natMaxPair"
      | EJsonRuntimeNatMin => "natMin"
      | EJsonRuntimeNatMax => "natMax"
      | EJsonRuntimeNatSum => "natSum"
      | EJsonRuntimeNatArithMean => "natArithMean"
      | EJsonRuntimeFloatOfNat => "floatOfNat"
      (* Float *)
      | EJsonRuntimeFloatSum => "floatSum"
      | EJsonRuntimeFloatArithMean => "floatArithMean"
      | EJsonRuntimeFloatMin => "floatMin"
      | EJsonRuntimeFloatMax => "floatMax"
      | EJsonRuntimeNatOfFloat => "natOfFloat"
      (* Foreign *)
      | EJsonRuntimeForeign fop => toString fop
      end.

    Definition ejson_runtime_op_of_string (opname:string) : option ejson_runtime_op :=
      match opname with
      (* Generic *)
      | "equal" => Some EJsonRuntimeEqual
      | "compare" => Some EJsonRuntimeCompare
      | "toString" => Some EJsonRuntimeToString
      | "toText" => Some EJsonRuntimeToText
      (* Record *)
      | "recConcat" => Some EJsonRuntimeRecConcat
      | "recMerge" => Some EJsonRuntimeRecMerge
      | "recRemove" => Some EJsonRuntimeRecRemove
      | "recProject" => Some EJsonRuntimeRecProject
      | "recDot" => Some EJsonRuntimeRecDot
      (* Array *)
      | "array" => Some EJsonRuntimeArray
      | "arrayLength" => Some EJsonRuntimeArrayLength
      | "arrayPush" => Some EJsonRuntimeArrayPush
      | "arrayAccess" => Some EJsonRuntimeArrayAccess
      (* Sum *)
      | "either" => Some EJsonRuntimeEither
      | "toLeft" => Some EJsonRuntimeToLeft
      | "toRight" => Some EJsonRuntimeToRight
      (* Brand *)
      | "unbrand" => Some EJsonRuntimeUnbrand
      | "cast" => Some EJsonRuntimeCast
      (* Collection *)
      | "distinct" => Some EJsonRuntimeDistinct
      | "singleton" => Some EJsonRuntimeSingleton
      | "flatten" => Some EJsonRuntimeFlatten
      | "union" => Some EJsonRuntimeUnion
      | "minus" => Some EJsonRuntimeMinus
      | "min" => Some EJsonRuntimeMin
      | "max" => Some EJsonRuntimeMax
      | "nth" => Some EJsonRuntimeNth
      | "count" => Some EJsonRuntimeCount
      | "contains" => Some EJsonRuntimeContains
      | "sort" => Some EJsonRuntimeSort
      | "groupBy" => Some EJsonRuntimeGroupBy
      (* String *)
      | "length" => Some EJsonRuntimeLength
      | "substring" => Some EJsonRuntimeSubstring
      | "substringEnd" => Some EJsonRuntimeSubstringEnd
      | "stringJoin" => Some EJsonRuntimeStringJoin
      | "like" => Some EJsonRuntimeLike
      (* Integer *)
      | "natLt" => Some EJsonRuntimeNatLt
      | "natLe" => Some EJsonRuntimeNatLe
      | "natPlus" => Some EJsonRuntimeNatPlus
      | "natMinus" => Some EJsonRuntimeNatMinus
      | "natMult" => Some EJsonRuntimeNatMult
      | "natDiv" => Some EJsonRuntimeNatDiv
      | "natRem" => Some EJsonRuntimeNatRem
      | "natAbs" => Some EJsonRuntimeNatAbs
      | "natLog2" => Some EJsonRuntimeNatLog2
      | "natSqrt" => Some EJsonRuntimeNatSqrt
      | "natMinPair" => Some EJsonRuntimeNatMinPair
      | "natMaxPair" => Some EJsonRuntimeNatMaxPair
      | "natMin" => Some EJsonRuntimeNatMin
      | "natMax" => Some EJsonRuntimeNatMax
      | "natSum" => Some EJsonRuntimeNatSum
      | "natArithMean" => Some EJsonRuntimeNatArithMean
      | "floatOfNat" => Some EJsonRuntimeFloatOfNat
      (* Float *)
      | "floatSum" => Some EJsonRuntimeFloatSum
      | "floatArithMean" => Some EJsonRuntimeFloatArithMean
      | "floatMin" => Some EJsonRuntimeFloatMin
      | "floatMax" => Some EJsonRuntimeFloatMax
      | "natOfFloat" => Some EJsonRuntimeNatOfFloat
      (* Foreign *)
      | _ => lift EJsonRuntimeForeign (foreign_ejson_runtime_fromstring opname)
      end.

  Fixpoint defaultEJsonToString (j:@ejson foreign_ejson_model) : string
    := match j with
       | ejnull => "unit"%string
       | ejbigint n => toString n
       | ejnumber n => toString n
       | ejbool b => toString b
       | ejstring s => stringToString s
       | ejarray l => string_bracket
                        "["%string
                        (String.concat ", "%string
                                       (map defaultEJsonToString l))
                        "]"%string
       | ejobject ((s1,j')::nil) =>
         if (string_dec s1 "$left") then
           string_bracket
             "Left("%string
             (defaultEJsonToString j')
             ")"%string
         else if (string_dec s1 "$right") then
                string_bracket
                  "Right("%string
                  (defaultEJsonToString j')
                  ")"%string
              else
                string_bracket
                  "{"%string
                  (String.concat ", "%string
                                 (map (fun xy => let '(x,y):=xy in
                                                 (append (stringToString (key_decode x)) (append "->"%string
                                                                                (defaultEJsonToString y)))
                                      ) ((s1,j')::nil)))
                  "}"%string
      | ejobject ((s1,ejarray j1)::(s2,j2)::nil) =>
        if (string_dec s1 "$class") then
          if (string_dec s2 "$data") then
            match (ejson_brands j1) with
            | Some br =>
              (string_bracket
                 "<"
                 (append (@toString _ ToString_brands br) (append ":" (defaultEJsonToString j2)))
                 ">")
            | None =>
                string_bracket
                  "{"%string
                  (String.concat ", "%string
                                 ((append (stringToString (key_decode s1))
                                          (append "->"%string (string_bracket
                                                                 "["%string (String.concat ", "%string (map defaultEJsonToString j1)) "]"%string)))
                                    :: (append (stringToString (key_decode s2)) (append "->"%string (defaultEJsonToString j2)))
                                    :: nil))
                  "}"%string
            end
          else
            string_bracket
              "{"%string
              (String.concat ", "%string
                             ((append (stringToString (key_decode s1))
                                      (append "->"%string (string_bracket "["%string (String.concat ", "%string (map defaultEJsonToString j1)) "]"%string)))
                                :: (append (stringToString (key_decode s2)) (append "->"%string (defaultEJsonToString j2)))
                                :: nil))
              "}"%string
        else
          string_bracket
            "{"%string
            (String.concat ", "%string
                           ((append (stringToString (key_decode s1))
                                    (append "->"%string (string_bracket "["%string (String.concat ", "%string (map defaultEJsonToString j1)) "]"%string)))
                              :: (append (stringToString (key_decode s2)) (append "->"%string (defaultEJsonToString j2)))
                              :: nil))
            "}"%string
      | ejobject r =>
        string_bracket
          "{"%string
          (String.concat ", "%string
                         (map (fun xy => let '(x,y):=xy in
                                         (append (stringToString (key_decode x)) (append "->"%string (defaultEJsonToString y)))
                              ) r))
          "}"%string
       | ejforeign fd => toString fd
       end.

  End Util.

  Section Evaluation.
    (* XXX We should try and compile the hierarchy in. Currenty it is still used in cast for sub-branding check *)
    Context (h:brand_relation_t).
    Definition ejson_runtime_eval (rt:ejson_runtime_op) (dl:list ejson) : option ejson :=
      match rt with
      (* Generic *)
      | EJsonRuntimeEqual =>
        apply_binary (fun d1 d2 => if ejson_eq_dec d1 d2 then Some (ejbool true) else Some (ejbool false)) dl
      | EJsonRuntimeCompare =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejnumber n1, ejnumber n2 =>
               if float_lt n1 n2
               then
                 Some (ejnumber float_one)
               else if float_gt n1 n2
                    then
                      Some (ejnumber float_neg_one)
                    else
                      Some (ejnumber float_zero)
             | ejbigint n1, ejbigint n2 =>
               if Z_lt_dec n1 n2
               then
                 Some (ejnumber float_one)
               else if Z_gt_dec n1 n2
                    then
                      Some (ejnumber float_neg_one)
                    else
                      Some (ejnumber float_zero)
             | _, _ => None
             end) dl
      | EJsonRuntimeToString =>
        apply_unary
          (fun d =>
             Some (ejstring (foreign_ejson_runtime_tostring d))
          ) dl
      | EJsonRuntimeToText =>
        apply_unary
          (fun d =>
             Some (ejstring (foreign_ejson_runtime_totext d))
          ) dl
      (* Record *)
      | EJsonRuntimeRecConcat =>
        apply_binary
          (fun d1 d2 =>
             match ejson_is_record d1, ejson_is_record d2 with
             | Some r1, Some r2 => Some (ejobject (rec_sort (r1++r2)))
             | _, _ => None
             end) dl
      | EJsonRuntimeRecMerge =>
        apply_binary
          (fun d1 d2 =>
             match ejson_is_record d1, ejson_is_record d2 with
             | Some r1, Some r2 =>
               match @merge_bindings ejson _ ejson_eq_dec r1 r2 with
               | Some x => Some (ejarray ((ejobject x) :: nil))
               | None => Some (ejarray nil)
               end
             | _, _ => None
             end) dl
      | EJsonRuntimeRecRemove =>
        apply_binary
          (fun d1 d2 =>
             match ejson_is_record d1 with
             | Some r =>
               match d2 with
               | ejstring s =>
                 Some (ejobject (rremove r s))
               | _ => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeRecProject =>
        apply_binary
          (fun d1 d2 =>
             match ejson_is_record d1 with
             | Some r =>
               match d2 with
               | ejarray sl =>
                 lift ejobject
                      (lift (rproject r)
                            (of_string_list sl))
               | _ => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeRecDot =>
        apply_binary
          (fun d1 d2 =>
             match ejson_is_record d1 with
             | Some r =>
               match d2 with
               | ejstring s =>
                 edot r s
               | _ => None
               end
             | _ => None
             end) dl
      (* Array *)
      | EJsonRuntimeArray =>
        Some (ejarray dl) (* XXX n-ary *)
      | EJsonRuntimeArrayLength =>
        apply_unary
          (fun d =>
             match d with
             | ejarray ja => Some (ejbigint (Z_of_nat (List.length ja)))
             | _ => None
             end) dl
      | EJsonRuntimeArrayPush =>
        apply_binary
          (fun d1 d2 =>
             match d1 with
             | ejarray ja => Some (ejarray (ja ++ (d2::nil)))
             | _ => None
             end) dl
      | EJsonRuntimeArrayAccess =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejarray ja, ejbigint n =>
               let natish := ZToSignedNat n in
               if (fst natish) then
                 match List.nth_error ja (snd natish) with
                 | None => None
                 | Some d => Some d
                 end
               else None
             | _, _ => None
             end) dl
      (* Sum *)
      | EJsonRuntimeEither =>
        apply_unary
          (fun d =>
             match d with
             | ejobject (("$left", _)::nil) => Some (ejbool true)
             | ejobject (("$right",_)::nil) => Some (ejbool false)
             | _ => None
             end) dl
      | EJsonRuntimeToLeft =>
        apply_unary
          (fun d =>
             match d with
             | ejobject (("$left", d)::nil) => Some d
             | _ => None
             end) dl
      | EJsonRuntimeToRight =>
        apply_unary
          (fun d =>
             match d with
             | ejobject (("$right", d)::nil) => Some d
             | _ => None
             end) dl
      (* Brand *)
      | EJsonRuntimeUnbrand =>
        apply_unary
          (fun d =>
             match d with
             | ejobject ((s,ejarray jl)::(s',j')::nil) =>
               if (string_dec s "$class") then
                 if (string_dec s' "$data") then
                   match ejson_brands jl with
                   | Some _ => Some j'
                   | None => None
                   end
                 else None
               else None
             | _ => None
             end) dl
      | EJsonRuntimeCast =>
        apply_binary
          (fun d1 d2 : ejson =>
             match d1 with
             | ejarray jl1 =>
               match ejson_brands jl1 with
               | Some b1 =>
                 match d2 with
                 | ejobject ((s,ejarray jl2)::(s',_)::nil) =>
                   if (string_dec s "$class") then
                     if (string_dec s' "$data") then
                       match ejson_brands jl2 with
                       | Some b2 =>
                         if (sub_brands_dec h b2 b1)
                         then
                           Some (ejobject (("$left"%string,d2)::nil))
                         else
                           Some (ejobject (("$right"%string,ejnull)::nil))
                       | None => None
                       end
                     else None
                   else None
                 | _ => None
                 end
               | None => None
               end
             | _ => None
             end) dl

      (* Collection *)
      | EJsonRuntimeDistinct =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               Some (ejarray (@bdistinct ejson ejson_eq_dec l))
             | _ => None
             end)
          dl
      | EJsonRuntimeSingleton =>
        apply_unary
          (fun d =>
             match d with
             | ejarray (d::nil) => Some (ejobject (("$left",d)::nil))
             | ejarray _ => Some (ejobject (("$right",ejnull)::nil))
             | _ => None
             end) dl
      | EJsonRuntimeFlatten =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               lift ejarray (jflatten l)
             | _ => None
             end) dl
      | EJsonRuntimeUnion =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejarray l1, ejarray l2 =>
               Some (ejarray (bunion l1 l2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeMinus =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejarray l1, ejarray l2 =>
               Some (ejarray (bminus l2 l1))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeMin =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejarray l1, ejarray l2 =>
               Some (ejarray (bmin l1 l2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeMax =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejarray l1, ejarray l2 =>
               Some (ejarray (bmax l1 l2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNth =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | (ejarray c), (ejbigint n) =>
               let natish := ZToSignedNat n in
               if (fst natish) then
                 match List.nth_error c (snd natish) with
                 | Some d => Some (ejobject (("$left",d)::nil))
                 | None => Some (ejobject (("$right",ejnull)::nil))
                 end
               else Some (ejobject (("$right",ejnull)::nil))
             | _, _ => None
             end) dl
      | EJsonRuntimeCount =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l => Some (ejbigint (Z_of_nat (bcount l)))
             | _ => None
             end) dl
      | EJsonRuntimeContains =>
        apply_binary
          (fun d1 d2 =>
             match d2 with
             | ejarray l =>
               if in_dec ejson_eq_dec d1 l
               then Some (ejbool true) else Some (ejbool false)
             | _ => None
             end) dl
      | EJsonRuntimeSort =>
        apply_binary
          (fun d1 d2 =>
             match d1 with
             | ejarray l1 =>
               ejson_sort l1 d2
             | _ => None
             end) dl
      | EJsonRuntimeGroupBy =>
        apply_ternary
          (fun d1 d2 d3 =>
             match d3 with
             | ejarray l =>
               match d1 with
               | ejstring g =>
                 match d2 with
                 | ejarray sl =>
                   match of_string_list sl with
                   | Some kl =>
                     lift ejarray (ejson_group_by_nested_eval_table g kl l)
                   | None => None
                   end
                 | _ => None
                 end
               | _ => None
               end
             | _ => None
             end) dl
      (* String *)
      | EJsonRuntimeLength =>
        apply_unary
          (fun d =>
             match d with
             | ejstring s => Some (ejbigint (Z_of_nat (String.length s)))
             | _ => None
             end) dl
      | EJsonRuntimeSubstring =>
        apply_ternary
          (fun d1 d2 d3 =>
             match d1, d2, d3 with
             | ejstring s, ejbigint start, ejbigint len =>
               let real_start :=
                   (match start with
                    | 0%Z => 0
                    | Z.pos p => Pos.to_nat p
                    | Z.neg n => (String.length s) - (Pos.to_nat n)
                    end) in
               let real_len :=
                   match len with
                   | 0%Z => 0
                   | Z.pos p => Pos.to_nat p
                   | Z.neg n => 0
                   end
               in
               Some (ejstring (substring real_start real_len s))
             | _, _, _ => None
             end) dl
      | EJsonRuntimeSubstringEnd =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejstring s, ejbigint start =>
               let real_start :=
                   (match start with
                    | 0%Z => 0
                    | Z.pos p => Pos.to_nat p
                    | Z.neg n => (String.length s) - (Pos.to_nat n)
                    end) in
               let real_len := (String.length s) - real_start in
               Some (ejstring (substring real_start real_len s))
             | _, _ => None
             end) dl
      | EJsonRuntimeStringJoin =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejstring sep, ejarray l =>
               match ejson_strings l with
               | Some sl => Some (ejstring (String.concat sep sl))
               | None => None
               end
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeLike =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejstring sreg, ejstring starget =>
               Some (ejbool (string_like starget sreg None))
             | _, _ => None
             end
          ) dl
      (* Integer *)
      | EJsonRuntimeNatLt =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejbigint n1, ejbigint n2 =>
               Some (ejbool (if Z_lt_dec n1 n2 then true else false))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNatLe =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejbigint n1, ejbigint n2 =>
               Some (ejbool (if Z_le_dec n1 n2 then true else false))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNatPlus =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejbigint n1, ejbigint n2 =>
               Some (ejbigint (Z.add n1 n2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNatMinus =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejbigint n1, ejbigint n2 =>
               Some (ejbigint (Z.sub n1 n2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNatMult =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejbigint n1, ejbigint n2 =>
               Some (ejbigint (Z.mul n1 n2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNatDiv =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejbigint n1, ejbigint n2 =>
               Some (ejbigint (Z.quot n1 n2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNatRem =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejbigint n1, ejbigint n2 =>
               Some (ejbigint (Z.rem n1 n2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNatAbs =>
        apply_unary
          (fun d =>
             match d with
             | ejbigint z => Some (ejbigint (Z.abs z))
             | _ => None
             end) dl
      | EJsonRuntimeNatLog2 =>
        apply_unary
          (fun d =>
             match d with
             | ejbigint z => Some (ejbigint (Z.log2 z))
             | _ => None
             end) dl
      | EJsonRuntimeNatSqrt =>
        apply_unary
          (fun d =>
             match d with
             | ejbigint z => Some (ejbigint (Z.sqrt z))
             | _ => None
             end) dl
      | EJsonRuntimeNatMinPair =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejbigint n1, ejbigint n2 =>
               Some (ejbigint (Z.min n1 n2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNatMaxPair =>
        apply_binary
          (fun d1 d2 =>
             match d1, d2 with
             | ejbigint n1, ejbigint n2 =>
               Some (ejbigint (Z.max n1 n2))
             | _, _ => None
             end
          ) dl
      | EJsonRuntimeNatSum =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               match ejson_bigints l with
               | Some zl =>
                 Some (ejbigint (fold_right Zplus 0%Z zl))
               | None => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeNatMin =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               match ejson_bigints l with
               | Some zl =>
                 Some (ejbigint (bnummin zl))
               | None => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeNatMax =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               match ejson_bigints l with
               | Some zl =>
                 Some (ejbigint (bnummax zl))
               | None => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeNatArithMean =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               let length := List.length l in
               match ejson_bigints l with
               | Some zl =>
                 Some (ejbigint (Z.quot (fold_right Zplus 0%Z zl) (Z_of_nat length)))
               | None => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeFloatOfNat =>
        apply_unary
          (fun d =>
             match d with
             | ejbigint n => Some (ejnumber (float_of_int n))
             | _ => None
             end) dl
      (* Float *)
      | EJsonRuntimeFloatSum =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               match ejson_numbers l with
               | Some nl =>
                 Some (ejnumber (float_list_sum nl))
               | None => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeFloatArithMean =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               match ejson_numbers l with
               | Some nl =>
                 Some (ejnumber (float_list_arithmean nl))
               | None => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeFloatMin =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               match ejson_numbers l with
               | Some nl =>
                 Some (ejnumber (float_list_min nl))
               | None => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeFloatMax =>
        apply_unary
          (fun d =>
             match d with
             | ejarray l =>
               match ejson_numbers l with
               | Some nl =>
                 Some (ejnumber (float_list_max nl))
               | None => None
               end
             | _ => None
             end) dl
      | EJsonRuntimeNatOfFloat =>
        apply_unary
          (fun d =>
             match d with
             | ejnumber f => Some (ejbigint (float_truncate f))
             | _ => None
             end) dl
      (* Foreign *)
      | EJsonRuntimeForeign fop =>
        foreign_ejson_runtime_op_interp fop dl
      end.
  End Evaluation.
End EJsonRuntimeOperators.


From Coq Require Import List Lia String ZArith Program.Equality.
From WiSE Require Import streams lang.imp symbolic.symex implem.bugfinder.
Import ListNotations.
Import LTL.

(** * Correctness proof of the bugfinder *)

(** ** Soundness and Completness of [expand] w.r.t [sym_step] *)

Lemma map_in:
  forall A B (f : A -> B) (l : list A) b,
    In b (List.map f l) -> exists a, In a l /\ b = f a.
Proof.
  intros. induction l; try easy.
  destruct H as [<- | H].
  - repeat econstructor.
  - specialize (IHl H) as (a' & Ha' & ->).
    exists a'. split; auto. now right.
Qed.

(** [expand] is a sound implementation of [sym_step] *)
Theorem expand_sound:
  forall path env prog t,
    In t (expand path env prog) -> sym_step ((path, env), prog) t.
Proof.
  intros path env prog [[path' env'] prog'] Hin.
  induction prog in path', env', prog', Hin |-*; subst; try easy.
  - destruct Hin as [[=<-<-<-] | [ [=<-<-<-] | [] ]]; constructor.
  - destruct prog1; try easy.
    + destruct Hin as [[=<-<-<-] | []]. now econstructor.
    + pose proof (map_in _ _ _ _ _ Hin) as ([[path2 env2] prog3] & [H1 [=->->->]]).
      specialize (IHprog1 _ _ _ H1).
      now constructor.
    + pose proof (map_in _ _ _ _ _ Hin) as ([[path2 env2] prog3] & [H1 [=->->->]]).
      specialize (IHprog1 _ _ _ H1).
      now constructor.
    + pose proof (map_in _ _ _ _ _ Hin) as ([[path2 env2] prog3] & [H1 [=->->->]]).
      specialize (IHprog1 _ _ _ H1).
      now constructor.
    + pose proof (map_in _ _ _ _ _ Hin) as ([[path2 env2] prog3] & [H1 [=->->->]]).
      specialize (IHprog1 _ _ _ H1).
      now constructor.
  - destruct Hin as [[=<-<-<-] | []]. now constructor.
  - destruct Hin as [[=<-<-<-] | [[=<-<-<-]| []]]; now constructor.
Qed.

(** [expand] is a complete implementation of [sym_step] *)
Theorem expand_complete:
  forall path env prog t,
    sym_step ((path, env), prog) t ->
    In t (expand path env prog).
Proof.
  intros * Ht.
  dependent induction Ht; intros; simpl.
  - now econstructor.
  - change (π2, s2, Seq c2 c3) with (then_do c3 (π2, s2, c2)).
    destruct c1; try easy.
    all: eapply in_map, IHHt; eauto.
  - now left.
  - now left.
  - now (right; left).
  - now left.
  - now (right; left).
Qed.

(** [expand] spawns 0, 1 or 2 tasks *)
Theorem expand_inv:
  forall path env prog,
    (expand path env prog = []) \/
    (exists s, expand path env prog = [s]) \/
    (exists s1 s2, expand path env prog = [s1; s2]).
Proof.
  intros. induction prog.
  - now left.
  - now right; right; repeat econstructor.
  - destruct IHprog1 as [IH | [(s & Hs) | (s1 & s2 & Hs)]].
    + destruct prog1; simpl in *; try easy.
      now right; left; repeat econstructor. rewrite IH.
      now left.
      now left.
    + destruct prog1; simpl in *; try easy.
      right. repeat econstructor. now rewrite Hs.
      right. repeat econstructor.
    + destruct prog1; simpl in *; try easy.
      now right; right; repeat econstructor.
      now right; right; repeat econstructor; rewrite Hs.
      right; right; repeat econstructor; rewrite Hs.
  - now right; left; repeat econstructor.
  - now left.
  - now right; right; repeat econstructor.
Qed.

(** ** Eager model of [run] *)
(** The [run] function that executes the main loop of the bugfinder
    generates a lazy stream. Lazy streams are defined co-inductively
    which make them somwhat hard to reason about. To ease the proofs, we
    provide an eager implementation [run_n] of [run] that simulates the behavior of
    [run] for [n] steps of computation. We then relate the 2 functions by a theorem [run_run_n].
*)

(** [run_eq] can be used to destruct applications of the cofixpoint [run] *)
Theorem run_eq:
  forall l path env prog,
    run ((path, env, prog)::l) = scons (Some (path, env, prog)) (run (l ++ expand path env prog)).
Proof.
  intros. now rewrite <- force_id at 1.
Qed.

(** the [run []] is a fixpoint for [shift] i.e.
    once the task list is empty, [run] loops indefinitely
    in a state where the task list remains empty
*)
Lemma run_nil:
  forall n, shift n (run []) = run [].
Proof.
  now induction n.
Qed.

(** Relation between [run] and its eager model [run_n].
    [run_n n l] computes the task list after [n] iterations [run l]
*)
Lemma run_run_n:
  forall n l, shift n (run l) = run (run_n n l).
Proof.
  intros. induction n in l |-*; try easy.
  destruct l as [| [[path env] prog] l] .
  - apply run_nil.
  - rewrite run_eq. simpl. now rewrite IHn.
Qed.

Lemma run_n_nil:
  forall n, run_n n [] = [].
Proof.
  now induction n.
Qed.

(** After [List.length l1] iterations, the task list of [run (l1 ++ l2)]
    starts with [l2]
*)
Theorem run_n_length:
  forall l1 l2,
    exists l3,
      run_n (List.length l1) (l1 ++ l2) = l2 ++ l3.
Proof.
  intros. induction l1 as [|[[path env] prog] l1 IH] in l2 |-*.
  - simpl. exists []. now rewrite app_nil_r.
  - simpl. rewrite <- List.app_assoc.
    specialize (IH (l2 ++ expand path env prog)) as [l3 Hl3].
    rewrite Hl3. rewrite <- List.app_assoc. now eexists.
Qed.

(** After [1 + List.length l1] iterations, the task list of [run (t::l1 ++ l2)]
    starts with [l2] followed with the task spawed by executing [t]
*)
Theorem run_n_S_length:
  forall l1 l2 path env prog,
    exists l3,
      run_n (S (List.length l1)) ((path, env, prog)::l1 ++ l2) = l2 ++ (expand path env prog) ++ l3.
Proof.
  intros. induction l1 as [|[[path1 env1] prog1] l1 IH] in l2, path, env, prog |-*.
  - simpl. exists []. now rewrite app_nil_r.
  - simpl. do 2 rewrite <- List.app_assoc. simpl in IH.
    specialize (IH (l2 ++ expand path env prog) path1 env1 prog1).
    simpl in IH. edestruct IH as [l3 Hl3]. eexists.
    repeat rewrite <- List.app_assoc in Hl3. apply Hl3.
Qed.

(** ** LTL Specification Predicates

    In the remainder of this file, we will use a shallow embedding of the [LTL]
    logic to write specifications over lazy streams.
    We start by defining some usefull [LTL] predicates.
*)

(** The current state in the stream is [sym_steps] reachable from a state in [l] *)
Definition reachable_from (tasks : list sym_state) : LTL.t :=
  now (fun s =>
    match s with
    | None => True
    | Some s => exists s0, In s0 tasks /\ sym_steps s0 s
    end
  ).

(** The current state in the stream is [s] *)
Definition here (s : sym_state) : LTL.t :=
  now (fun st =>
    match st with
    | Some s' => s' = s
    | None => False
    end
  ).
Notation "! x" := (here x).

Definition bug_found s : LTL.t :=
  now (fun (st : status) =>
    match st with
    | BugFound s' => s' = s
    | _ => False
    end
  ).
Notation "!! x" := (bug_found x).

Definition potential_bug p : LTL.t :=
  now (fun (st : status) =>
    match st with
    | BugFound s' => potential_bug (Bcst true, id, p) s'
    | _ => True
    end
  ).

Definition none : LTL.t :=
  now (fun (st : option sym_state) =>
    match st with
    | None => True
    | _ => False
    end
  ).

Definition done : LTL.t :=
  now (fun (st : status) =>
    match st with
    | Finished => True
    | _ => False
    end
  ).

(** ** Soundess of [run] *)

(** [run] is sound with respect to [sym_exec]:
    all states generate by the stream [run l],
    are reachable from [l]
*)
Theorem run_sound:
  forall l,
    run l ⊨ □ reachable_from l.
Proof.
  intros l n. rewrite run_run_n.
  induction n in l |-*.
  - simpl in *. destruct l as [| [[path env] prog]]; try easy.
    repeat econstructor.
  - destruct l as [| [[path env] prog] l]; try easy.
    specialize (IHn (l ++ expand path env prog)).
    simpl. destruct run_n as [| [[path1 env1] prog1]] eqn:Heq; try easy.
    destruct IHn as [[[path2 env2] prog2] [[H | H]%in_app_iff Hsteps]].
    + eexists. split; eauto. now right.
    + pose proof (expand_sound _ _ _ _ H).
      eexists. split. now left.
      econstructor; eauto.
Qed.

(** ** Completeness of [run] *)

(** [run] is complete for [sym_step]:
    if [s] is the next value generated by [run l], then
    all the direct sucessors of [s] are eventually generated
*)
Theorem run_step_complete:
  forall l s s',
    sym_step s s' ->
    run l ⊨ (!s → ◊!s').
Proof.
  intros * Hstep H.
  destruct l as [| [[path env] prog]]; try easy.
  cbn in H. subst.
  apply expand_complete in Hstep.
  destruct (expand_inv path env prog) as [Htask | [[s Htask] | (s1 & s2 & Htask)]].
  - now rewrite Htask in Hstep.
  - rewrite run_eq, Htask in *. inversion Hstep; subst; try easy.
    exists (S (List.length l)). simpl.
    rewrite run_run_n.
    pose proof (run_n_length l [s']) as [l3 Hl3].
    replace (run_n (Datatypes.length l) (l ++ [s'])) with ([s'] ++ l3) at 1.
    now destruct s' as [[a b] c].
  - rewrite run_eq, Htask in *. destruct Hstep as [-> | [ -> | []]].
    + exists (S (List.length l)). simpl.
      rewrite run_run_n.
      pose proof (run_n_length l [s'; s2]) as [l3 Hl3].
      replace (run_n (Datatypes.length l) (l ++ [s'; s2])) with ([s'; s2] ++ l3) at 1.
      simpl. now destruct s' as [[a b] c].
    + exists (S (S (List.length l))). rewrite shift_eq.
      rewrite run_run_n.
      replace (l ++ [s1; s']) with ((l ++ [s1]) ++ [s']) at 1 by now rewrite <- List.app_assoc.
      pose proof (run_n_length (l ++ [s1]) [s']) as [l3 Hl3].
      replace (Datatypes.length (l ++ [s1])) with (S (Datatypes.length l)) in Hl3.
      replace (run_n (S (Datatypes.length l)) ((l ++ [s1]) ++ [s'])) with ([s'] ++ l3) at 1.
      now destruct s' as [[a b] c].
      rewrite List.app_length. simpl. lia.
Qed.

(** [run [s]] immediately generates [s] *)
Theorem run_here:
  forall s,
    run [s] ⊨ here s.
Proof.
  now intros [[path env] prog].
Qed.

(** [run] is complete for [sym_steps]:
    At any point in time, if [s] is generated by [run l], then
    all the [sym_steps] sucessors of [s] are eventually generated
*)
Theorem run_steps_complete:
  forall s s',
    sym_steps s s' ->
    forall l,
      run l ⊨ □ (!s → ◊!s').
Proof.
  intros s s' H.
  dependent induction H.
  - intros l n Hn. now exists 0.
  - intros l n Hn. rewrite run_run_n in *.
    pose proof (run_step_complete (run_n n l) _ _ H Hn) as [m Hm]. simpl in Hm.
    specialize (IHstar _ _ Hm) as [k Hk].
    rewrite shift_shift, run_run_n in Hk.
    eexists (k + m). now rewrite run_run_n.
Qed.

(** [run] is a complete wau to compute the [sym_steps] sucessors
    of any state [s]:
    starting with the task [[s]], [run [s]] eventually generates
    all [sym_steps] sucessors of [s]
*)
Theorem run_complete:
  forall s s',
    sym_steps s s' -> run [s] ⊨ ◊!s'.
Proof.
  intros.
  now pose proof (run_steps_complete _ _ H [s] 0 (run_here s)).
Qed.

Theorem run_finished_nil:
  forall l,
    run l ⊨ none -> l = [].
Proof.
  now intros [|[[path env] prog]].
Qed.

Theorem run_finished:
  forall l,
    run l ⊨ □ (none → □ none).
Proof.
  intros l n Hn m.
  rewrite run_run_n in Hn.
  apply run_finished_nil in Hn.
  rewrite run_run_n, Hn.
  now rewrite run_nil.
Qed.

(** [fin_bugs] is sound:
    For any program [p], [find_bugs p]
    emits warnings ONLY if it found a bug in [p]
*)
Theorem find_bugs_sound:
  forall p,
    find_bugs p ⊨ □ (potential_bug p).
Proof.
  intros. unfold find_bugs.
  pose proof (run_sound (init p)).
  intros n. specialize (H n).
  unfold potential_bug, reachable_from, now in *.
  rewrite get_shift in *. simpl get in *.
  rewrite get_map in *. destruct display eqn:Heq1; try easy.
  destruct get as [[[path env] prog]|] eqn:Heq2; simpl in Heq1; try easy.
  destruct (is_error prog) eqn:Heq3.
  apply is_error_correct in Heq3. injection Heq1 as <-.
  now destruct H as [[[path0 env0] prog0] [[[=->->->]|] H2]].
  now destruct is_skip.
Qed.

(** [fin_bugs] is complete:
    For any program [p], if it has a bug,
    [find_bugs p] will eventually find it
*)
Theorem find_bugs_complete:
  forall p s',
    symex.potential_bug (Bcst true, id, p) s' ->
    find_bugs p ⊨ ◊ (bug_found s').
Proof.
  intros p [[path env] prog] [H1 H2].
  pose proof (run_complete _ _ H1) as [n Hn].
  exists n. unfold find_bugs, bug_found, here, now in *.
  rewrite get_shift in *. simpl in *.
  rewrite get_map. unfold init.
  destruct get eqn:Heq1; subst; try easy.
  unfold display.
  destruct is_error eqn:Heq2; try easy.
  destruct prog; try easy.
  apply is_error_correct in H2.
  now rewrite H2 in Heq2.
Qed.

(** A symbolic state denotes a valid bug in
    [p] if all states in its concretization are bugs
*)
Definition ValidBug p σ' :=
  forall σ, Concrete σ' σ -> imp.IsBug p σ.

(** A status message is valid wrt prog [p]
    if it is a [BugFound] message reporting a [ValidBug]
    or any other kind of status message
*)
Definition ValidStatus p :=
  now (fun st =>
    match st with
    | BugFound σ' => ValidBug p σ'
    | _ => True
    end
  ).

Definition Symbolic σ :=
  now (fun st =>
    match st with
    | BugFound σ' => Concrete σ' σ
    | _ => False
    end
  ).

Theorem relative_completeness:
  forall p σ,
    imp.IsBug p σ -> find_bugs p ⊨ ◊ Symbolic σ.
Proof.
  intros * [(V0 & σ' & [Hsteps Hequiv])%Reach_complete H].
  pose proof (run_complete _ _ Hsteps) as [n Hn].
  exists n.
  unfold find_bugs, Symbolic, bug_found, here, now in *.
  rewrite get_shift in *. simpl in *.
  rewrite get_map. unfold init, display.
  destruct get as [[[π senv] p']|]; auto.
  rewrite <- Hn in Hequiv. destruct σ as [V ?].
  destruct (is_error p') eqn:Herr.
  - now exists V0.
  - destruct Hequiv as [_ [-> ->]].
    apply is_error_Stuck in H.
    now rewrite H in Herr.
Qed.

Theorem relative_soundness:
  forall p,
    find_bugs p ⊨ □ ValidStatus p.
Proof.
  intros p n.
  pose proof (find_bugs_sound p n).
  unfold ValidStatus, potential_bug, now, get in *.
  destruct (shift) eqn:Heq.
  destruct x as [ [[φ senv] p'] | | ]; auto.
  intros [V p''] (V0 & HV0).
  destruct H as [H2 H3].
  split.
  - apply symex.Reach_sound.
    now exists V0, (φ, senv, p').
  - destruct HV0 as  [_ [_ <-]].
    now apply is_error_Stuck, is_error_correct.
Qed.

(** "termination" of the bugfinding loop:
    If at any point in time [find_bugs p] emits
    a [Finished] token, then the exploration of [p]
    terminated. We encode this property by
    asserting that after the first [Finished] token,
    the only message that the loop will ever send is [Finished]
    (i.e. it cannot find new bugs afterward)
*)
Theorem sound_termination:
  forall p,
    find_bugs p ⊨ □ (done → □ done).
Proof.
  intros p. unfold find_bugs.
  pose proof (run_finished (init p)).
  intros n Hn m.
  assert (Hnone : none (shift n (run (init p)))).
  { unfold none, done, now in Hn |-*. rewrite get_shift in *.
    simpl in *. rewrite get_map in Hn.
    destruct get as [[[path env] prog]|] eqn:Heq1; try easy.
    simpl in Hn. destruct is_error eqn:Heq2; try easy.
  }
  specialize (H n Hnone m). clear Hn Hnone.
  rewrite shift_shift in *.
  unfold done, none, now in *.
  rewrite get_shift in *. simpl in *.
  rewrite get_map. now destruct get eqn:Heq.
Qed.