(* 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.

Lemma BDDdummy_lemma_2 :
 forall bound : nat,
 (forall m : nat,
  m < bound ->
  forall (cfg : BDDconfig) (node1 node2 : ad) (memo : BDDor_memo),
  BDDconfig_OK cfg ->
  BDDor_memo_OK cfg memo ->
  config_node_OK cfg node1 ->
  config_node_OK cfg node2 ->
  (is_internal_node cfg node1 ->
   is_internal_node cfg node2 ->
   max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)) < m) ->
  BDDconfig_OK (fst (BDDor_1 cfg memo node1 node2 m)) /\
  BDDor_memo_OK (fst (BDDor_1 cfg memo node1 node2 m))
    (snd (snd (BDDor_1 cfg memo node1 node2 m))) /\
  config_node_OK (fst (BDDor_1 cfg memo node1 node2 m))
    (fst (snd (BDDor_1 cfg memo node1 node2 m))) /\
  nodes_preserved cfg (fst (BDDor_1 cfg memo node1 node2 m)) /\
  BDDvar_le
    (var (fst (BDDor_1 cfg memo node1 node2 m))
       (fst (snd (BDDor_1 cfg memo node1 node2 m))))
    (BDDvar_max (var cfg node1) (var cfg node2)) = true /\
  bool_fun_eq
    (bool_fun_of_BDD (fst (BDDor_1 cfg memo node1 node2 m))
       (fst (snd (BDDor_1 cfg memo node1 node2 m))))
    (bool_fun_or (bool_fun_of_BDD cfg node1) (bool_fun_of_BDD cfg node2))) ->
 forall (cfg : BDDconfig) (node1 node2 : ad) (memo : BDDor_memo),
 BDDconfig_OK cfg ->
 BDDor_memo_OK cfg memo ->
 config_node_OK cfg node1 ->
 config_node_OK cfg node2 ->
 (is_internal_node cfg node1 ->
  is_internal_node cfg node2 ->
  max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)) < bound) ->
 BDDor_memo_lookup memo node1 node2 = None ->
 in_dom (BDDvar * (ad * ad)) node1 (fst cfg) = true ->
 node2 = BDDone \/ in_dom (BDDvar * (ad * ad)) node2 (fst cfg) = true ->
 is_internal_node cfg node1 ->
 in_dom (BDDvar * (ad * ad)) node2 (fst cfg) = true ->
 is_internal_node cfg node2 ->
 forall bound' : nat,
 bound = S bound' ->
 max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2)) < bound ->
 BDDcompare (var cfg node1) (var cfg node2) = Datatypes.Eq ->
 BDDconfig_OK (fst (BDDor_1 cfg memo node1 node2 bound)) /\
 BDDor_memo_OK (fst (BDDor_1 cfg memo node1 node2 bound))
   (snd (snd (BDDor_1 cfg memo node1 node2 bound))) /\
 config_node_OK (fst (BDDor_1 cfg memo node1 node2 bound))
   (fst (snd (BDDor_1 cfg memo node1 node2 bound))) /\
 nodes_preserved cfg (fst (BDDor_1 cfg memo node1 node2 bound)) /\
 BDDvar_le
   (var (fst (BDDor_1 cfg memo node1 node2 bound))
      (fst (snd (BDDor_1 cfg memo node1 node2 bound))))
   (BDDvar_max (var cfg node1) (var cfg node2)) = true /\
 bool_fun_eq
   (bool_fun_of_BDD (fst (BDDor_1 cfg memo node1 node2 bound))
      (fst (snd (BDDor_1 cfg memo node1 node2 bound))))
   (bool_fun_or (bool_fun_of_BDD cfg node1) (bool_fun_of_BDD cfg node2)).
Proof.
  intros bound H cfg node1 node2 memo H0 H1 H2 H3 H4 y H5 H6 H8 H9 H7 bound'
   y0 H10 y1.
cut (config_node_OK cfg (low cfg node1)).
cut (config_node_OK cfg (low cfg node2)).
cut (config_node_OK cfg (high cfg node1)).
cut (config_node_OK cfg (high cfg node2)).
intros H11 H12 H13 H14.
cut
 (is_internal_node cfg (low cfg node1) ->
  is_internal_node cfg (low cfg node2) ->
  max (nat_of_N (var cfg (low cfg node1)))
    (nat_of_N (var cfg (low cfg node2))) < bound').
cut
 (is_internal_node cfg (high cfg node1) ->
  is_internal_node cfg (high cfg node2) ->
  max (nat_of_N (var cfg (high cfg node1)))
    (nat_of_N (var cfg (high cfg node2))) < bound').
intros H15 H16.
cut
 (BDDconfig_OK
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')) /\
  BDDor_memo_OK
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (snd (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))) /\
  config_node_OK
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))) /\
  nodes_preserved cfg
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')) /\
  BDDvar_le
    (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
       (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))))
    (BDDvar_max (var cfg (low cfg node1)) (var cfg (low cfg node2))) = true /\
  bool_fun_eq
    (bool_fun_of_BDD
       (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
       (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))))
    (bool_fun_or (bool_fun_of_BDD cfg (low cfg node1))
       (bool_fun_of_BDD cfg (low cfg node2)))).
intro H17.
elim H17; clear H17; intros.
elim H18; clear H18; intros.
elim H19; clear H19; intros.
elim H20; clear H20; intros.
elim H21; clear H21; intros.
cut
 (config_node_OK
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node1)).
cut
 (config_node_OK
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node2)).
intros H23 H24.
cut
 (is_internal_node
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node1) ->
  is_internal_node
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node2) ->
  max
    (nat_of_N
       (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (high cfg node1)))
    (nat_of_N
       (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (high cfg node2))) < bound').
intro H25.
cut
 (BDDconfig_OK
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound')) /\
  BDDor_memo_OK
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (snd
       (snd
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))) /\
  config_node_OK
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst
       (snd
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))) /\
  nodes_preserved
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound')) /\
  BDDvar_le
    (var
       (fst
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))
       (fst
          (snd
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))))
    (BDDvar_max
       (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (high cfg node1)) (var cfg (high cfg node2))) = true /\
  bool_fun_eq
    (bool_fun_of_BDD
       (fst
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))
       (fst
          (snd
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))))
    (bool_fun_or
       (bool_fun_of_BDD
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (high cfg node1))
       (bool_fun_of_BDD
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (high cfg node2)))).

intro H26.

elim H26; clear H26; intros.
elim H27; clear H27; intros.
elim H28; clear H28; intros.
elim H29; clear H29; intros.
elim H30; clear H30; intros.
cut
 (config_node_OK
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))).
intro H32.
cut
 (forall (xl : BDDvar) (ll rl : ad),
  MapGet _
    (fst
       (fst
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound')))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))) =
  Some (xl, (ll, rl)) -> BDDcompare xl (var cfg node1) = Datatypes.Lt).
cut
 (forall (xr : BDDvar) (lr rr : ad),
  MapGet _
    (fst
       (fst
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound')))
    (fst
       (snd
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))) =
  Some (xr, (lr, rr)) -> BDDcompare xr (var cfg node1) = Datatypes.Lt).
intros H33 H34.
cut
 (BDDconfig_OK
    (fst
       (BDDmake
          (fst
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))
          (var cfg node1)
          (fst
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (fst
             (snd
                (BDDor_1
                   (fst
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound'))
                   (snd
                      (snd
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound')))
                   (high cfg node1) (high cfg node2) bound'))))) /\
  (N.eqb
     (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
     (fst
        (snd
           (BDDor_1
              (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
              (snd
                 (snd
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
              (high cfg node1) (high cfg node2) bound'))) = false ->
   MapGet _
     (fst
        (fst
           (BDDmake
              (fst
                 (BDDor_1
                    (fst
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound'))
                    (snd
                       (snd
                          (BDDor_1 cfg memo (low cfg node1)
                             (low cfg node2) bound')))
                    (high cfg node1) (high cfg node2) bound'))
              (var cfg node1)
              (fst
                 (snd
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
              (fst
                 (snd
                    (BDDor_1
                       (fst
                          (BDDor_1 cfg memo (low cfg node1)
                             (low cfg node2) bound'))
                       (snd
                          (snd
                             (BDDor_1 cfg memo (low cfg node1)
                                (low cfg node2) bound')))
                       (high cfg node1) (high cfg node2) bound'))))))
     (snd
        (BDDmake
           (fst
              (BDDor_1
                 (fst
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                 (snd
                    (snd
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound')))
                 (high cfg node1) (high cfg node2) bound'))
           (var cfg node1)
           (fst
              (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
           (fst
              (snd
                 (BDDor_1
                    (fst
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound'))
                    (snd
                       (snd
                          (BDDor_1 cfg memo (low cfg node1)
                             (low cfg node2) bound')))
                    (high cfg node1) (high cfg node2) bound'))))) =
   Some
     (var cfg node1,
     (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')),
     fst
       (snd
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))))) /\
  (N.eqb
     (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
     (fst
        (snd
           (BDDor_1
              (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
              (snd
                 (snd
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
              (high cfg node1) (high cfg node2) bound'))) = true ->
   snd
     (BDDmake
        (fst
           (BDDor_1
              (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
              (snd
                 (snd
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
              (high cfg node1) (high cfg node2) bound'))
        (var cfg node1)
        (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
        (fst
           (snd
              (BDDor_1
                 (fst
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                 (snd
                    (snd
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound')))
                 (high cfg node1) (high cfg node2) bound')))) =
   fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))) /\
  (forall (a l' r' : ad) (x' : BDDvar),
   (MapGet _
      (fst
         (fst
            (BDDmake
               (fst
                  (BDDor_1
                     (fst
                        (BDDor_1 cfg memo (low cfg node1)
                           (low cfg node2) bound'))
                     (snd
                        (snd
                           (BDDor_1 cfg memo (low cfg node1)
                              (low cfg node2) bound')))
                     (high cfg node1) (high cfg node2) bound'))
               (var cfg node1)
               (fst
                  (snd
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
               (fst
                  (snd
                     (BDDor_1
                        (fst
                           (BDDor_1 cfg memo (low cfg node1)
                              (low cfg node2) bound'))
                        (snd
                           (snd
                              (BDDor_1 cfg memo (low cfg node1)
                                 (low cfg node2) bound')))
                        (high cfg node1) (high cfg node2) bound')))))) a =
    Some (x', (l', r')) ->
    MapGet _
      (fst
         (fst
            (BDDor_1
               (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
               (snd
                  (snd
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
               (high cfg node1) (high cfg node2) bound'))) a =
    Some (x', (l', r')) \/
    snd
      (BDDmake
         (fst
            (BDDor_1
               (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
               (snd
                  (snd
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
               (high cfg node1) (high cfg node2) bound'))
         (var cfg node1)
         (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
         (fst
            (snd
               (BDDor_1
                  (fst
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                  (snd
                     (snd
                        (BDDor_1 cfg memo (low cfg node1)
                           (low cfg node2) bound')))
                  (high cfg node1) (high cfg node2) bound')))) = a) /\
   (MapGet _
      (fst
         (fst
            (BDDor_1
               (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
               (snd
                  (snd
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
               (high cfg node1) (high cfg node2) bound'))) a =
    Some (x', (l', r')) ->
    MapGet _
      (fst
         (fst
            (BDDmake
               (fst
                  (BDDor_1
                     (fst
                        (BDDor_1 cfg memo (low cfg node1)
                           (low cfg node2) bound'))
                     (snd
                        (snd
                           (BDDor_1 cfg memo (low cfg node1)
                              (low cfg node2) bound')))
                     (high cfg node1) (high cfg node2) bound'))
               (var cfg node1)
               (fst
                  (snd
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
               (fst
                  (snd
                     (BDDor_1
                        (fst
                           (BDDor_1 cfg memo (low cfg node1)
                              (low cfg node2) bound'))
                        (snd
                           (snd
                              (BDDor_1 cfg memo (low cfg node1)
                                 (low cfg node2) bound')))
                        (high cfg node1) (high cfg node2) bound')))))) a =
    Some (x', (l', r')))) /\
  node_OK
    (fst
       (fst
          (BDDmake
             (fst
                (BDDor_1
                   (fst
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound'))
                   (snd
                      (snd
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound')))
                   (high cfg node1) (high cfg node2) bound'))
             (var cfg node1)
             (fst
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (fst
                (snd
                   (BDDor_1
                      (fst
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound'))
                      (snd
                         (snd
                            (BDDor_1 cfg memo (low cfg node1)
                               (low cfg node2) bound')))
                      (high cfg node1) (high cfg node2) bound'))))))
    (snd
       (BDDmake
          (fst
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))
          (var cfg node1)
          (fst
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (fst
             (snd
                (BDDor_1
                   (fst
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound'))
                   (snd
                      (snd
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound')))
                   (high cfg node1) (high cfg node2) bound')))))).
intro H35.
elim H35; clear H35; intros.
elim H36; clear H36; intros.
elim H37; clear H37; intros.
elim H38; clear H38; intros.
cut (BDDconfig_OK (fst (BDDor_1 cfg memo node1 node2 bound))).
intro H40.
cut
 (config_node_OK (fst (BDDor_1 cfg memo node1 node2 bound))
    (fst (snd (BDDor_1 cfg memo node1 node2 bound)))).
intro H41.
cut (nodes_preserved cfg (fst (BDDor_1 cfg memo node1 node2 bound))).
intro H42.
cut
 (BDDvar_le
    (var (fst (BDDor_1 cfg memo node1 node2 bound))
       (fst (snd (BDDor_1 cfg memo node1 node2 bound))))
    (BDDvar_max (var cfg node1) (var cfg node2)) = true).
intro H43.
cut
 (bool_fun_eq
    (bool_fun_of_BDD (fst (BDDor_1 cfg memo node1 node2 bound))
       (fst (snd (BDDor_1 cfg memo node1 node2 bound))))
    (bool_fun_or (bool_fun_of_BDD cfg node1) (bool_fun_of_BDD cfg node2))).
intro H44.
cut
 (BDDor_memo_OK (fst (BDDor_1 cfg memo node1 node2 bound))
    (snd (snd (BDDor_1 cfg memo node1 node2 bound)))).
intro H45.
split.
assumption.

split.
assumption.

split.
assumption.

split.

assumption.

split.
assumption.

assumption.

unfold BDDor_memo_OK in |- *.
intros node1' node2' node.
rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1).
simpl in |- *.
rewrite
 (BDDor_memo_lookup_semantics
    (snd
       (snd
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))) node1 node2
    (snd
       (BDDmake
          (fst
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))
          (var cfg node1)
          (fst
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (fst
             (snd
                (BDDor_1
                   (fst
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound'))
                   (snd
                      (snd
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound')))
                   (high cfg node1) (high cfg node2) bound'))))) node1'
    node2').
elim (sumbool_of_bool (N.eqb node1 node1' && N.eqb node2 node2')); intro y2.
cut (node1 = node1').
cut (node2 = node2').
intro H45.
intro H46.
rewrite y2.
intro H47.

injection H47.
clear H47; intro.
split.
rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1) in H41.
simpl in H41.
apply
 nodes_preserved_2
  with
    (cfg := fst
              (BDDor_1
                 (fst
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                 (snd
                    (snd
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound')))
                 (high cfg node1) (high cfg node2) bound')).
apply
 nodes_preserved_2
  with (cfg := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
apply nodes_preserved_2 with (cfg := cfg).

rewrite <- H46.
assumption.

assumption.

assumption.

apply BDDmake_preserves_nodes.
assumption.

split.
apply
 nodes_preserved_2
  with
    (cfg := fst
              (BDDor_1
                 (fst
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                 (snd
                    (snd
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound')))
                 (high cfg node1) (high cfg node2) bound')).
apply
 nodes_preserved_2
  with (cfg := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
apply nodes_preserved_2 with (cfg := cfg).
rewrite <- H45; assumption; assumption.

assumption.

assumption.

apply BDDmake_preserves_nodes.
assumption.

split.
rewrite <- H47.
rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1) in H41.
simpl in H41.
assumption.

split.
rewrite <- H45.
cut
 (var
    (fst
       (BDDmake
          (fst
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))
          (var cfg node1)
          (fst
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (fst
             (snd
                (BDDor_1
                   (fst
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound'))
                   (snd
                      (snd
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound')))
                   (high cfg node1) (high cfg node2) bound'))))) node2 =
  var cfg node2).
intro H48.
rewrite H48.
rewrite <- H46.
cut
 (var
    (fst
       (BDDmake
          (fst
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))
          (var cfg node1)
          (fst
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (fst
             (snd
                (BDDor_1
                   (fst
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound'))
                   (snd
                      (snd
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound')))
                   (high cfg node1) (high cfg node2) bound'))))) node1 =
  var cfg node1).
intro; rewrite H49.
rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1) in H43.
simpl in H43.
rewrite <- H47; exact H43.

apply nodes_preserved_var.
rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1) in H42; simpl in H42; exact H42.

assumption.

apply nodes_preserved_var.
rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1) in H42; simpl in H42; exact H42.

assumption.

rewrite <- H45; rewrite <- H46.
apply
 bool_fun_eq_trans
  with
    (bf2 := bool_fun_or (bool_fun_of_BDD cfg node1)
              (bool_fun_of_BDD cfg node2)).
rewrite <- H47.
rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1) in H44.
simpl in H44.
exact H44.

apply bool_fun_or_preserves_eq.
apply bool_fun_eq_symm.
apply nodes_preserved_3.
assumption.

assumption.

rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1) in H42; simpl in H42; exact H42.

assumption.

apply bool_fun_eq_symm.
apply nodes_preserved_3.
assumption.

assumption.

rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1) in H42; simpl in H42; exact H42.

assumption.

apply Neqb_complete.
exact (proj2 (andb_prop (N.eqb node1 node1') (N.eqb node2 node2') y2)).

apply Neqb_complete.
exact (proj1 (andb_prop (N.eqb node1 node1') (N.eqb node2 node2') y2)).

rewrite y2.
split.
apply
 nodes_preserved_2
  with
    (cfg := fst
              (BDDor_1
                 (fst
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                 (snd
                    (snd
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound')))
                 (high cfg node1) (high cfg node2) bound')).
unfold BDDor_memo_OK in H27.
exact (proj1 (H27 node1' node2' node H45)).

apply BDDmake_preserves_nodes.
assumption.

split.
apply
 nodes_preserved_2
  with
    (cfg := fst
              (BDDor_1
                 (fst
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                 (snd
                    (snd
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound')))
                 (high cfg node1) (high cfg node2) bound')).
unfold BDDor_memo_OK in H27.
exact (proj1 (proj2 (H27 node1' node2' node H45))).

apply BDDmake_preserves_nodes.
assumption.

split.
apply
 nodes_preserved_2
  with
    (cfg := fst
              (BDDor_1
                 (fst
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                 (snd
                    (snd
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound')))
                 (high cfg node1) (high cfg node2) bound')).
unfold config_node_OK in H27.
exact (proj1 (proj2 (proj2 (H27 node1' node2' node H45)))).

apply BDDmake_preserves_nodes.
assumption.

split.
cut
 (var
    (fst
       (BDDmake
          (fst
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))
          (var cfg node1)
          (fst
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (fst
             (snd
                (BDDor_1
                   (fst
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound'))
                   (snd
                      (snd
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound')))
                   (high cfg node1) (high cfg node2) bound'))))) node1' =
  var
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound')) node1').
intro H46.
rewrite H46.
cut
 (var
    (fst
       (BDDmake
          (fst
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))
          (var cfg node1)
          (fst
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (fst
             (snd
                (BDDor_1
                   (fst
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound'))
                   (snd
                      (snd
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound')))
                   (high cfg node1) (high cfg node2) bound'))))) node2' =
  var
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound')) node2').
intro H47.
rewrite H47.
cut
 (var
    (fst
       (BDDmake
          (fst
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))
          (var cfg node1)
          (fst
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (fst
             (snd
                (BDDor_1
                   (fst
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound'))
                   (snd
                      (snd
                         (BDDor_1 cfg memo (low cfg node1)
                            (low cfg node2) bound')))
                   (high cfg node1) (high cfg node2) bound'))))) node =
  var
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound')) node).
intro H48.
rewrite H48.
unfold BDDor_memo_OK in H27.
exact (proj1 (proj2 (proj2 (proj2 (H27 node1' node2' node H45))))).

apply nodes_preserved_var_1.
assumption.

assumption.

apply BDDmake_preserves_nodes.
assumption.

unfold BDDor_memo_OK in H27.
exact (proj1 (proj2 (proj2 (H27 node1' node2' node H45)))).

apply nodes_preserved_var_1.
assumption.

assumption.

apply BDDmake_preserves_nodes.
assumption.

unfold BDDor_memo_OK in H27.
exact (proj1 (proj2 (H27 node1' node2' node H45))).

apply nodes_preserved_var_1.
assumption.

assumption.

apply BDDmake_preserves_nodes.
assumption.

unfold BDDor_memo_OK in H27.

exact (proj1 (H27 node1' node2' node H45)).

apply
 bool_fun_eq_trans
  with
    (bf2 := bool_fun_of_BDD
              (fst
                 (BDDor_1
                    (fst
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound'))
                    (snd
                       (snd
                          (BDDor_1 cfg memo (low cfg node1)
                             (low cfg node2) bound')))
                    (high cfg node1) (high cfg node2) bound')) node).
apply nodes_preserved_3.
assumption.

assumption.

apply BDDmake_preserves_nodes.
assumption.

unfold BDDor_memo_OK in H27.
exact (proj1 (proj2 (proj2 (H27 node1' node2' node H45)))).

apply
 bool_fun_eq_trans
  with
    (bf2 := bool_fun_or
              (bool_fun_of_BDD
                 (fst
                    (BDDor_1
                       (fst
                          (BDDor_1 cfg memo (low cfg node1)
                             (low cfg node2) bound'))
                       (snd
                          (snd
                             (BDDor_1 cfg memo (low cfg node1)
                                (low cfg node2) bound')))
                       (high cfg node1) (high cfg node2) bound')) node1')
              (bool_fun_of_BDD
                 (fst
                    (BDDor_1
                       (fst
                          (BDDor_1 cfg memo (low cfg node1)
                             (low cfg node2) bound'))
                       (snd
                          (snd
                             (BDDor_1 cfg memo (low cfg node1)
                                (low cfg node2) bound')))
                       (high cfg node1) (high cfg node2) bound')) node2')).
unfold BDDor_memo_OK in H27.
exact (proj2 (proj2 (proj2 (proj2 (H27 node1' node2' node H45))))).

apply bool_fun_or_preserves_eq.
apply bool_fun_eq_symm.
apply nodes_preserved_3.
assumption.

assumption.

apply BDDmake_preserves_nodes.
assumption.

unfold BDDor_memo_OK in H27; exact (proj1 (H27 node1' node2' node H45)).

apply bool_fun_eq_symm.
apply nodes_preserved_3.
assumption.

assumption.

apply BDDmake_preserves_nodes.
assumption.

unfold BDDor_memo_OK in H27.
exact (proj1 (proj2 (H27 node1' node2' node H45))).

rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1).
simpl in |- *.
cut
 (config_node_OK
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))).
intro H44.
cut
 (is_internal_node
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))) ->
  BDDcompare
    (var
       (fst
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))
       (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))))
    (var cfg node1) = Datatypes.Lt).
cut
 (is_internal_node
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst
       (snd
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))) ->
  BDDcompare
    (var
       (fst
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound'))
       (fst
          (snd
             (BDDor_1
                (fst
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                (snd
                   (snd
                      (BDDor_1 cfg memo (low cfg node1)
                         (low cfg node2) bound')))
                (high cfg node1) (high cfg node2) bound'))))
    (var cfg node1) = Datatypes.Lt).
intros H45 H46.
apply
 bool_fun_eq_trans
  with
    (bf2 := bool_fun_if (var cfg node1)
              (bool_fun_of_BDD
                 (fst
                    (BDDor_1
                       (fst
                          (BDDor_1 cfg memo (low cfg node1)
                             (low cfg node2) bound'))
                       (snd
                          (snd
                             (BDDor_1 cfg memo (low cfg node1)
                                (low cfg node2) bound')))
                       (high cfg node1) (high cfg node2) bound'))
                 (fst
                    (snd
                       (BDDor_1
                          (fst
                             (BDDor_1 cfg memo (low cfg node1)
                                (low cfg node2) bound'))
                          (snd
                             (snd
                                (BDDor_1 cfg memo (low cfg node1)
                                   (low cfg node2) bound')))
                          (high cfg node1) (high cfg node2) bound'))))
              (bool_fun_of_BDD
                 (fst
                    (BDDor_1
                       (fst
                          (BDDor_1 cfg memo (low cfg node1)
                             (low cfg node2) bound'))
                       (snd
                          (snd
                             (BDDor_1 cfg memo (low cfg node1)
                                (low cfg node2) bound')))
                       (high cfg node1) (high cfg node2) bound'))
                 (fst
                    (snd
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound'))))).
apply BDDmake_bool_fun.
assumption.

assumption.

assumption.

assumption.

assumption.

apply
 bool_fun_eq_trans
  with
    (bf2 := bool_fun_if (var cfg node1)
              (bool_fun_or
                 (bool_fun_of_BDD
                    (fst
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound'))
                    (high cfg node1))
                 (bool_fun_of_BDD
                    (fst
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound'))
                    (high cfg node2)))
              (bool_fun_of_BDD
                 (fst
                    (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                 (fst
                    (snd
                       (BDDor_1 cfg memo (low cfg node1)
                          (low cfg node2) bound'))))).
apply bool_fun_if_preserves_eq.
assumption.

apply nodes_preserved_3.
assumption.

assumption.

assumption.

assumption.

apply
 bool_fun_eq_trans
  with
    (bf2 := bool_fun_if (var cfg node1)
              (bool_fun_or (bool_fun_of_BDD cfg (high cfg node1))
                 (bool_fun_of_BDD cfg (high cfg node2)))
              (bool_fun_or (bool_fun_of_BDD cfg (low cfg node1))
                 (bool_fun_of_BDD cfg (low cfg node2)))).
apply bool_fun_if_preserves_eq.
apply bool_fun_or_preserves_eq.
apply nodes_preserved_3.
assumption.

assumption.

assumption.

assumption.

apply nodes_preserved_3.
assumption.

assumption.

assumption.

assumption.

assumption.

apply
 bool_fun_eq_trans
  with
    (bf2 := bool_fun_or
              (bool_fun_if (var cfg node1)
                 (bool_fun_of_BDD cfg (high cfg node1))
                 (bool_fun_of_BDD cfg (low cfg node1)))
              (bool_fun_if (var cfg node1)
                 (bool_fun_of_BDD cfg (high cfg node2))
                 (bool_fun_of_BDD cfg (low cfg node2)))).

apply bool_fun_if_lemma_1.

apply bool_fun_or_preserves_eq.
apply bool_fun_eq_symm.
apply bool_fun_if_lemma_2.
assumption.

assumption.

replace (var cfg node1) with (var cfg node2).
apply bool_fun_eq_symm.
apply bool_fun_if_lemma_2.
assumption.

assumption.

apply BDDcompare_eq.
apply BDD_EGALsymm.
assumption.

intro H45.
apply
 BDDcompare_le_INFERIEUR_1
  with
    (y := BDDvar_max
            (var
               (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
               (high cfg node1)) (var cfg (high cfg node2))).
assumption.

cut
 (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node1) = var cfg (high cfg node1)).
intro; rewrite H46.
cut (var cfg node1 = BDDvar_max (var cfg node1) (var cfg node2)).
intro H47.
rewrite H47.
apply BDDvar_ordered_high_1.
assumption.

assumption.

assumption.

cut
 (is_internal_node
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node1) \/
  is_internal_node
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node2)).
intro H48.
elim H48.
intro H49.
left.
apply
 nodes_preserved_internal
  with
    (cfg' := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

intro H49.
right.
apply
 nodes_preserved_internal
  with
    (cfg' := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

apply
 BDDor_1_internal
  with
    (memo := snd
               (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
    (bound := bound').
assumption.

assumption.

assumption.

assumption.

assumption.

replace (var cfg node2) with (var cfg node1).
rewrite (BDDvar_max_x_x (var cfg node1)).
reflexivity.

apply BDDcompare_eq.
assumption.

apply nodes_preserved_var_1.
assumption.

assumption.

assumption.

assumption.

intros H45.
cut
 (var
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))) =
  var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))).
intro H46.
rewrite H46.
apply
 BDDcompare_le_INFERIEUR_1
  with (y := BDDvar_max (var cfg (low cfg node1)) (var cfg (low cfg node2))).
assumption.

cut (var cfg node1 = var cfg node2).
intro H47.
cut (var cfg node1 = BDDvar_max (var cfg node1) (var cfg node2)).
intro H48.
rewrite H48.
apply BDDvar_ordered_low_1.
assumption.

assumption.

assumption.

apply BDDor_1_internal with (memo := memo) (bound := bound').
assumption.

assumption.

assumption.

assumption.

apply
 nodes_preserved_internal
  with
    (cfg' := fst
               (BDDor_1
                  (fst
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                  (snd
                     (snd
                        (BDDor_1 cfg memo (low cfg node1)
                           (low cfg node2) bound')))
                  (high cfg node1) (high cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

rewrite H47.
rewrite (BDDvar_max_x_x (var cfg node2)).
reflexivity.

apply BDDcompare_eq.
assumption.

apply nodes_preserved_var.
assumption.

apply
 nodes_preserved_internal
  with
    (cfg' := fst
               (BDDor_1
                  (fst
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                  (snd
                     (snd
                        (BDDor_1 cfg memo (low cfg node1)
                           (low cfg node2) bound')))
                  (high cfg node1) (high cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

assumption.

cut (var cfg node1 = var cfg node2).
intro H43.
rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1).
simpl in |- *.

rewrite <- H43.
rewrite (BDDvar_max_x_x (var cfg node1)).
apply BDDmake_var_order.
assumption.

assumption.

assumption.

intro H44.
cut
 (var
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))) =
  var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))).
intro H45.
rewrite H45.
apply
 BDDcompare_le_INFERIEUR_1
  with (y := BDDvar_max (var cfg (low cfg node1)) (var cfg (low cfg node2))).
assumption.

cut (var cfg node1 = BDDvar_max (var cfg node1) (var cfg node2)).
intro H46.
rewrite H46.
apply BDDvar_ordered_low_1.
assumption.

assumption.

assumption.

apply BDDor_1_internal with (memo := memo) (bound := bound').
assumption.

assumption.

assumption.

assumption.

apply
 nodes_preserved_internal
  with
    (cfg' := fst
               (BDDor_1
                  (fst
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                  (snd
                     (snd
                        (BDDor_1 cfg memo (low cfg node1)
                           (low cfg node2) bound')))
                  (high cfg node1) (high cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

rewrite <- H43.
rewrite (BDDvar_max_x_x (var cfg node1)).
reflexivity.

apply nodes_preserved_var.
assumption.

apply
 nodes_preserved_internal
  with
    (cfg' := fst
               (BDDor_1
                  (fst
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                  (snd
                     (snd
                        (BDDor_1 cfg memo (low cfg node1)
                           (low cfg node2) bound')))
                  (high cfg node1) (high cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

intro H44.
apply
 BDDcompare_le_INFERIEUR_1
  with
    (y := BDDvar_max
            (var
               (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
               (high cfg node1)) (var cfg (high cfg node2))).
assumption.

cut
 (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node1) = var cfg (high cfg node1)).
intro H45.
rewrite H45.
cut (var cfg node1 = BDDvar_max (var cfg node1) (var cfg node2)).
intro H46.
rewrite H46.
apply BDDvar_ordered_high_1.
assumption.

assumption.

assumption.

cut
 (is_internal_node
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node1) \/
  is_internal_node
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node2)).
intro H47.
elim H47.
intro H48.
left.
apply
 nodes_preserved_internal
  with
    (cfg' := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

intro H48.
right.
apply
 nodes_preserved_internal
  with
    (cfg' := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

apply
 BDDor_1_internal
  with
    (memo := snd
               (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
    (bound := bound').
assumption.

assumption.

assumption.

assumption.

assumption.

replace (var cfg node2) with (var cfg node1).
rewrite (BDDvar_max_x_x (var cfg node1)).
reflexivity.

apply nodes_preserved_var_1.
assumption.

assumption.

assumption.

assumption.

apply BDDcompare_eq.
assumption.

rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1).
simpl in |- *.
apply
 nodes_preserved_trans
  with
    (cfg2 := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

apply
 nodes_preserved_trans
  with
    (cfg2 := fst
               (BDDor_1
                  (fst
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                  (snd
                     (snd
                        (BDDor_1 cfg memo (low cfg node1)
                           (low cfg node2) bound')))
                  (high cfg node1) (high cfg node2) bound')).
assumption.

apply BDDmake_preserves_nodes.
assumption.

rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1).
simpl in |- *.
exact H39.

rewrite
 (BDDor_1_lemma_internal_1 cfg memo node1 node2 bound bound' y H0 H8 H7 H10
    y0 y1).
simpl in |- *.
assumption.

apply BDDmake_semantics.
assumption.

assumption.

assumption.

assumption.

assumption.

intros xr lr rr H33.
cut
 (xr =
  var
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst
       (snd
          (BDDor_1
             (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
             (snd
                (snd
                   (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
             (high cfg node1) (high cfg node2) bound')))).
intro H34.
rewrite H34.
apply
 BDDcompare_le_INFERIEUR_1
  with
    (y := BDDvar_max
            (var
               (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
               (high cfg node1)) (var cfg (high cfg node2))).
assumption.

cut
 (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node1) = var cfg (high cfg node1)).
intro H35.
rewrite H35.
cut (var cfg node1 = BDDvar_max (var cfg node1) (var cfg node2)).
intro H36.
rewrite H36.
apply BDDvar_ordered_high_1.
assumption.

assumption.

assumption.

cut
 (is_internal_node
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node1) \/
  is_internal_node
    (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node2)).
intro H37.
elim H37.
intro H38.
left.
apply
 nodes_preserved_internal
  with
    (cfg' := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

intro H38.
right.
apply
 nodes_preserved_internal
  with
    (cfg' := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

apply
 BDDor_1_internal
  with
    (memo := snd
               (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
    (bound := bound').
assumption.

assumption.

assumption.

assumption.

unfold is_internal_node in |- *.
split with xr.
split with lr.
split with rr.
assumption.

replace (var cfg node2) with (var cfg node1).
rewrite (BDDvar_max_x_x (var cfg node1)).
reflexivity.

apply BDDcompare_eq.
assumption.

apply nodes_preserved_var_1.
assumption.

assumption.

assumption.

assumption.

unfold var in |- *.
rewrite H33.
reflexivity.

intros xl ll rl H33.
cut
 (xl =
  var
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))).

intro H34.
rewrite H34.
cut
 (var
    (fst
       (BDDor_1
          (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
          (snd
             (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))
          (high cfg node1) (high cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))) =
  var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (fst (snd (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')))).
intro H35.
rewrite H35.
apply
 BDDcompare_le_INFERIEUR_1
  with (y := BDDvar_max (var cfg (low cfg node1)) (var cfg (low cfg node2))).
assumption.

cut (var cfg node1 = BDDvar_max (var cfg node1) (var cfg node2)).
intro H36.
rewrite H36.
apply BDDvar_ordered_low_1.
assumption.

assumption.

assumption.

apply BDDor_1_internal with (memo := memo) (bound := bound').
assumption.

assumption.

assumption.

assumption.

apply
 nodes_preserved_internal
  with
    (cfg' := fst
               (BDDor_1
                  (fst
                     (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
                  (snd
                     (snd
                        (BDDor_1 cfg memo (low cfg node1)
                           (low cfg node2) bound')))
                  (high cfg node1) (high cfg node2) bound')).
assumption.

assumption.

assumption.

unfold is_internal_node in |- *.
split with xl.
split with ll.
split with rl.
assumption.

replace (var cfg node2) with (var cfg node1).
rewrite (BDDvar_max_x_x (var cfg node1)).
reflexivity.

apply BDDcompare_eq.
assumption.

apply nodes_preserved_var_1.
assumption.

assumption.

assumption.

assumption.

unfold var in |- *; rewrite H33; reflexivity.

apply
 nodes_preserved_2
  with (cfg := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

assumption.

cut
 (var cfg (high cfg node2) =
  var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node2)).
intro H26.
rewrite H26.
apply H.
rewrite y0.
unfold lt in |- *; apply le_n.

assumption.

assumption.

assumption.

assumption.

assumption.

replace (var cfg (high cfg node2)) with
 (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node2)).
reflexivity.

apply nodes_preserved_var_1.
assumption.

assumption.

assumption.

assumption.

intros H25 H26.
cut
 (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node1) = var cfg (high cfg node1)).
intro H27.
rewrite H27.
cut
 (var (fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound'))
    (high cfg node2) = var cfg (high cfg node2)).
intro H28.
rewrite H28.

apply H15.
apply
 nodes_preserved_internal
  with
    (cfg' := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

apply
 nodes_preserved_internal
  with
    (cfg' := fst (BDDor_1 cfg memo (low cfg node1) (low cfg node2) bound')).
assumption.

assumption.

assumption.

assumption.

apply nodes_preserved_var_1.
assumption.

assumption.

assumption.

assumption.

apply nodes_preserved_var_1.
assumption.

assumption.

assumption.

assumption.

apply nodes_preserved_2 with (cfg := cfg).

assumption.

assumption.

apply nodes_preserved_2 with (cfg := cfg).
assumption.

assumption.

apply H.
rewrite y0.
unfold lt in |- *; apply le_n.

assumption.

assumption.

assumption.

assumption.

assumption.

intros H15 H16.
apply
 lt_trans_1
  with (y := max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2))).
apply lt_max_1_2.
apply BDDcompare_lt.
apply BDDvar_ordered_high.
assumption.

assumption.

assumption.

apply BDDcompare_lt.
apply BDDvar_ordered_high.
assumption.

assumption.

assumption.

rewrite <- y0; assumption.

intros H15 H16.
apply
 lt_trans_1
  with (y := max (nat_of_N (var cfg node1)) (nat_of_N (var cfg node2))).
apply lt_max_1_2.
apply BDDcompare_lt.
apply BDDvar_ordered_low.
assumption.

assumption.

assumption.

apply BDDcompare_lt.
apply BDDvar_ordered_low.
assumption.

assumption.

assumption.

rewrite <- y0; assumption.

apply high_OK.
assumption.

assumption.

apply high_OK.
assumption.

assumption.

apply low_OK.
assumption.

assumption.

apply low_OK.
assumption.

assumption.
Qed.


From mathcomp.ssreflect
Require Import ssreflect ssrbool ssrnat eqtype ssrfun seq.
From mathcomp
Require Import path.
Require Import Eqdep pred idynamic ordtype pcm finmap unionmap heap coding.
Require Import Hgraphs Logs Wavefronts.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(********************************************************************************)
(* Implementation of the Apex 'expose' function and the proof of its soundness. *)
(********************************************************************************)

Section ApexAlgo.

(* Default log entry *)
Variable e0 : LogEntry.

(* Initial graph an heap *)
Variables (h0 : heap) (g0: graph h0).

(* A collector log p will all unique entires *)
Variables  (p : log).

(* Final heap and graph for the log p with the corresponding certificate epf *)
Variables (h : heap) (g: graph h).
Hypothesis (epf : executeLog g0 p = Some (ExRes g)).

(******************************************************************)
(*    Apex procedure for exposing reachable objects in the graph  *)
(******************************************************************)

(* A candidate for approximating wavefront *)
Variable wf_approx : log -> seq (ptr * nat).

Hypothesis wfp : forall l, prefix l p ->
   {subset wavefront l <= wf_approx l}.

Definition expose_apex : seq ptr :=
  [seq let pi := pe.2      in
       let o  := source pi in
       let f  := fld pi    in
       o#f@g | pe <- prefixes e0 p &
               let: (pre, pi)    := pe          in
               let k             := (kind pi)   in
               let o             := (source pi) in
               let f             := (fld pi)    in
               (kindMA k) && ((o, f) \in wf_approx pre)].

(* The following lemma roughly corresponds to "pre-safety" of the
   expose_apex procedure. It states that if there is an MA-entry 'ema'
   in the log, preceded by some T-entry 'et', and moreover, the value
   n of the new field, introduced by 'ema' made it to the final graph
   as a value of field 'f' of the object 'o', traced by 'et' (o#f =
   n), then this value is going to be reported by expose_apex.  *)

Lemma expose_apex_fires l1 l2 et ema :
  let o := source ema in
  let f := fld    ema in
  let n := new    ema in
  p = l1 ++ et :: l2 -> ema \in l2 ->
  kindMA (kind ema) -> kind et == T ->
  source et = o -> fld et = f -> o#f@g = n ->
  n \in expose_apex.
Proof.
move=>/=E D Kma Kt S F N.
case: (prefix_wavefront e0 D E Kt)=>pre[H1]/wfp H2.
apply/mapP; exists (pre, ema)=>//=.
rewrite mem_filter -S -F H1 Kma -!(andbC true)/=; apply: H2.
by case/prefV: H1=>i[G1] G2 G3; exists i.
Qed.

(******************************************************************)
(*                 Correctness of expose_apex                     *)
(******************************************************************)

(* The following theorem states the soundness of the expose_apex
   procedure: it adds to the alreadyMarked (retrieved from the
   T-entries) a set of objects, delivered by 'expose_apex', such that
   the union of the two contains the *actual targets* of all traced
   object-fields by the end of the log execution. *)

Theorem expose_apex_sound :
  {subset shouldBeMarked p g <= alreadyMarked p ++ expose_apex}.
Proof.
move=>x/shouldBeMarkedP=>[[et]][l1][l2][E]K Z; subst x.
rewrite mem_cat; apply/orP.
case: (traced_objects epf E K); [left | right].
- by apply/alreadyMarkedP; exists et, l1, l2.
case/hasP: b=>ema D/andP[K2]/andP[/eqP E2]/andP[/eqP E3]/eqP E4.
rewrite E2 E3 in E4 *;  rewrite E4.
by apply: (expose_apex_fires E D).
Qed.

End ApexAlgo.

Section ApexVanilla.

(* Runnin Apex with the defalut wavefront function *)

Variable e0 : LogEntry.
Variables (h0 : heap) (g0: graph h0) (p : log).
Variables (h : heap) (g: graph h).
Variable (epf : executeLog g0 p = Some (ExRes g)).

(* Indeed, this is trivially sound  *)

Corollary vanilla_expose_apex_sound :
  {subset shouldBeMarked p g
            <= alreadyMarked p ++ expose_apex e0 p g wavefront}.
Proof. by apply: (expose_apex_sound e0 epf)=>l _. Qed.

End ApexVanilla.


Require Export Basics.
Require Export Coq.Program.Equality.
Require Import Coq.Init.Specif.
Require Import Coq.Arith.PeanoNat.
Require Import Omega.
Require Import Coq.Lists.List.

Require Export EnvListAux7.
Require Export EnvListAuxT1.
Require Import TPipStaticM2.
Require Import TRInductM2.
Require Import IdModType.

Module Dynamic (IdT: IdModType) <: IdModType.
(* Export IdT. *)

Module StaticInductC := StaticInduct IdT.
Export StaticInductC.

Definition Id := IdT.Id.
Definition IdEqDec := IdT.IdEqDec.
Definition IdEq := IdT.IdEq.
Definition W := IdT.W.
Definition Loc_PI := IdT.Loc_PI.
Definition BInit := IdT.BInit.
Definition WP := IdT.WP.

(* Configurations *)

Inductive AConfig (T: Type) : Type :=
          Conf (state: W) (qq: T).

(* Dynamic semantics *)

Inductive QVStep :
   valEnv -> AConfig QValue -> AConfig QValue -> Type :=
   OK_QVStep : forall (env: valEnv) (n: W) (x: Id) (v: Value),
          findET env x v ->
          QVStep env (Conf QValue n (Var x))
                       (Conf QValue n (QV v)).

Inductive QFStep :
   funEnv -> AConfig QFun -> AConfig QFun -> Type :=
   OK_QFStep : forall (env: funEnv) (n: W) (x: Id) (v: Fun),
          findET env x v ->
          QFStep env (Conf QFun n (FVar x))
                       (Conf QFun n (QF v)).

Inductive EStep : funEnv -> valEnv ->
                                 AConfig Exp -> AConfig Exp -> Type :=
(* modify *)
| Modify_EStep : forall (fenv: funEnv) (env: valEnv) (n: W)
                        (T1 T2: Type) (VT1: ValTyp T1) (VT2: ValTyp T2)
                        (XF: XFun T1 T2) (w: T1),
    EStep fenv env
       (Conf Exp n (Modify T1 T2 VT1 VT2 XF (QV (cst T1 w))))
       (Conf Exp (b_exec T1 T2 XF n w)
                   (Val (cst T2 (b_eval T1 T2 XF n w))))
| Modify_Cg_EStep : forall (fenv: funEnv) (env: valEnv) (n n': W)
                        (T1 T2: Type) (VT1: ValTyp T1) (VT2: ValTyp T2)
                        (XF: XFun T1 T2) (q q': QValue),
    QVStep env (Conf QValue n q) (Conf QValue n' q') ->
    EStep fenv env (Conf Exp n (Modify T1 T2 VT1 VT2 XF q))
                        (Conf Exp n' (Modify T1 T2 VT1 VT2 XF q'))

(* return *)
| Return_EStep : forall (G: Tag)
                        (fenv: funEnv) (env: valEnv) (n: W) (v: Value),
    EStep fenv env (Conf Exp n (Return G (QV v)))
                        (Conf Exp n (Val v))
| Return_Cg_EStep : forall (G: Tag)
                           (fenv: funEnv) (env: valEnv)
                           (n n': W) (q q': QValue),
    QVStep env (Conf QValue n q) (Conf QValue n' q') ->
    EStep fenv env (Conf Exp n (Return G q)) (Conf Exp n' (Return G q'))
(* bindN *)
| BindN_EStep : forall (fenv: funEnv) (env: valEnv)
                       (n: W) (v: Value) (e: Exp),
    EStep fenv env (Conf Exp n (BindN (Val v) e)) (Conf Exp n e)
| BindN_Cg_EStep : forall (fenv: funEnv) (env: valEnv)
                          (n n': W) (e1 e1' e2: Exp),
    EStep fenv env (Conf Exp n e1) (Conf Exp n' e1') ->
    EStep fenv env (Conf Exp n (BindN e1 e2))
                        (Conf Exp n' (BindN e1' e2))
(* bindS *)
| BindS_EStep : forall (fenv: funEnv) (env: valEnv)
                       (n: W) (x: Id) (v: Value) (e: Exp),
    EStep fenv env (Conf Exp n (BindS x (Val v) e))
                        (Conf Exp n (BindMS emptyE (singleE x v) e))
| BindS_Cg_EStep : forall (fenv: funEnv) (env: valEnv)
                          (n n': W) (x: Id) (e1 e1' e2: Exp),
    EStep fenv env (Conf Exp n e1) (Conf Exp n' e1') ->
    EStep fenv env (Conf Exp n (BindS x e1 e2))
                        (Conf Exp n' (BindS x e1' e2))
(* bindMS *)
| BindMS_EStep : forall (fenv fenv': funEnv) (env env': valEnv)
                        (n: W) (v: Value),
    EStep fenv env (Conf Exp n (BindMS fenv' env' (Val v)))
                     (Conf Exp n (Val v))
| BindMS_Cg_EStep : forall (fenv fenvL fenv': funEnv)
                           (env envL env': valEnv)
                           (n n': W) (e e': Exp),
    fenv' = overrideE fenvL fenv ->
    env' = overrideE envL env ->
    EStep fenv' env' (Conf Exp n e) (Conf Exp n' e') ->
    EStep fenv env (Conf Exp n (BindMS fenvL envL e))
                     (Conf Exp n' (BindMS fenvL envL e'))
(* apply *)
| Apply_EStep0 : forall (fenv fenv': funEnv) (env env': valEnv)
                        (n: W) (e0 e1: Exp)
                        (es: list Exp) (vs: list Value)
                        (x: Id) (*i: nat*)
                        (pt: valTC),
     isValueList2T es vs ->
     length pt = length vs ->
     env' = mkVEnv pt vs ->
     EStep fenv env (Conf Exp n
              (Apply (QF (FC fenv' pt e0 e1 x 0)) (PS es)))
                     (Conf Exp n (BindMS fenv' env' e0))
| Apply_EStep1 : forall (fenv fenv': funEnv) (env env': valEnv)
                        (n: W) (e0 e1: Exp)
                        (es: list Exp) (vs: list Value)
                        (x: Id) (i: nat)
                        (pt: valTC),
     isValueList2T es vs ->
     length pt = length vs ->
     env' = mkVEnv pt vs ->
     EStep fenv env (Conf Exp n
              (Apply (QF (FC fenv' pt e0 e1 x (S i))) (PS es)))
                    (Conf Exp n (BindMS (updateE fenv' x
              (FC fenv' pt e0 e1 x i)) env' e1))
| Apply_Cg1_EStep : forall (fenv: funEnv) (env: valEnv)
                           (n n': W)
                           (f: Fun) (ps ps': Prms),
     PrmsStep fenv env (Conf Prms n ps) (Conf Prms n' ps') ->
     EStep fenv env (Conf Exp n (Apply (QF f) ps))
                         (Conf Exp n' (Apply (QF f) ps'))
| Apply_Cg2_EStep : forall (fenv: funEnv) (env: valEnv)
                           (n n': W)
                           (qf qf': QFun) (ps: Prms),
     QFStep fenv (Conf QFun n qf) (Conf QFun n' qf') ->
     EStep fenv env (Conf Exp n (Apply qf ps))
                         (Conf Exp n' (Apply qf' ps))
(* ifthenelse *)
| IfThenElse_EStep1 :  forall (fenv: funEnv) (env: valEnv)
                              (n: W) (e1 e2: Exp),
     EStep fenv env (Conf Exp n (IfThenElse (Val (cst bool true)) e1 e2))
                         (Conf Exp n e1)
| IfThenElse_EStep2 :  forall (fenv: funEnv) (env: valEnv)
                              (n: W) (e1 e2: Exp),
     EStep fenv env (Conf Exp n
                (IfThenElse (Val (cst bool false)) e1 e2))
                         (Conf Exp n e2)
| IfThenElse_Cg_EStep :  forall (fenv: funEnv) (env: valEnv)
                                (n n': W) (e e' e1 e2: Exp),
     EStep fenv env (Conf Exp n e) (Conf Exp n' e') ->
     EStep fenv env (Conf Exp n (IfThenElse e e1 e2))
                         (Conf Exp n' (IfThenElse e' e1 e2))
with PrmsStep :
       funEnv -> valEnv -> AConfig Prms -> AConfig Prms -> Type :=
| Prms_Cg_Step : forall (fenv: funEnv) (env: valEnv)
                   (n n': W)
                   (es es': list Exp) (v: Value),
         PrmsStep fenv env (Conf Prms n (PS es))
                                (Conf Prms n' (PS es')) ->
         PrmsStep fenv env (Conf Prms n (PS (Val v :: es)))
                                (Conf Prms n' (PS (Val v :: es')))
| Prms_Step1 : forall (fenv: funEnv) (env: valEnv)
                   (n n': W) (es: list Exp) (e e': Exp),
         EStep fenv env (Conf Exp n e) (Conf Exp n' e') ->
         PrmsStep fenv env (Conf Prms n (PS (e::es)))
                                (Conf Prms n' (PS (e'::es))).

Scheme EStep_mut := Induction for EStep Sort Type
with PrmsStep_mut := Induction for PrmsStep Sort Type.

Inductive PStep :
          funEnv -> AConfig Prog -> AConfig Prog -> Type :=
| Prog_PStep : forall (fenv: funEnv) (env: valEnv)
                      (n n': W) (e e': Exp),
                 EStep fenv env (Conf Exp n e) (Conf Exp n' e') ->
                 env = emptyE ->
                 PStep fenv (Conf Prog n (prog e))
                                 (Conf Prog n' (prog e'))
| Define_PStep : forall (fenv: funEnv) (env: valEnv)
                        (n: W) (x: Id) (f: Fun) (v: Value),
      PStep fenv (Conf Prog n (define x f (prog (Val v))))
                      (Conf Prog n (prog (Val v)))
| Define_Cg_PStep : forall (fenv fenv': funEnv)
                           (n n': W)
                           (x: Id) (f: Fun) (p p': Prog),
      fenv' = updateE fenv x f ->
      PStep fenv' (Conf Prog n p) (Conf Prog n' p') ->
      PStep fenv (Conf Prog n (define x f p))
                      (Conf Prog n' (define x f p')).

Inductive RTClosure :
     funEnv -> AConfig Prog -> AConfig Prog -> Type :=
  | RTC_Base : forall (env: funEnv) (p: AConfig Prog),
              RTClosure env p p
  | RTC_Step : forall (env: funEnv) (p1 p2 p3: AConfig Prog),
           PStep env p1 p2 -> RTClosure env p2 p3 ->
           RTClosure env p1 p3.

Inductive EClosure :
     funEnv -> valEnv -> AConfig Exp -> AConfig Exp -> Type :=
  | EC_Base : forall (fenv: funEnv) (env: valEnv) (p: AConfig Exp),
              EClosure fenv env p p
  | EC_Step : forall (fenv: funEnv) (env: valEnv) (p1 p2 p3: AConfig Exp),
           EStep fenv env p1 p2 ->
           EClosure fenv env p2 p3 -> EClosure fenv env p1 p3.

Inductive PrmsClosure :
     funEnv -> valEnv -> AConfig Prms -> AConfig Prms -> Type :=
  | PrmsC_Base : forall (fenv: funEnv) (env: valEnv) (p: AConfig Prms),
              PrmsClosure fenv env p p
  | PrmsC_Step : forall (fenv: funEnv) (env: valEnv)
                        (p1 p2 p3: AConfig Prms),
                   PrmsStep fenv env p1 p2 ->
                   PrmsClosure fenv env p2 p3 ->
                   PrmsClosure fenv env p1 p3.

Inductive QFClosure :
     funEnv -> AConfig QFun -> AConfig QFun -> Type :=
  | QF_Base : forall (fenv: funEnv) (p: AConfig QFun),
              QFClosure fenv p p
  | QF_Step : forall (fenv: funEnv) (p1 p2: AConfig QFun),
                QFStep fenv p1 p2 ->
                QFClosure fenv p1 p2.

Lemma StepIsEClos :
         forall (fenv: funEnv) (env: valEnv) (p1 p2: AConfig Exp),
               EStep fenv env p1 p2 -> EClosure fenv env p1 p2.
Proof.
intros.
eapply EC_Step.
eassumption.
constructor.
Defined.

Lemma StepIsRTClos :
         forall (fenv: funEnv) (p1 p2: AConfig Prog),
              PStep fenv p1 p2 -> RTClosure fenv p1 p2.
Proof.
  intros.
  eapply RTC_Step.
  eassumption.
  constructor.
Defined.

Lemma StepIsPrmsClos :
     forall (fenv: funEnv) (env: valEnv) (p1 p2: AConfig Prms),
       PrmsStep fenv env p1 p2 -> PrmsClosure fenv env p1 p2.
Proof.
  intros.
  eapply PrmsC_Step.
  eassumption.
  constructor.
Defined.

Lemma RTClosConcat :
        forall (env: funEnv) (p1 p2 p3: AConfig Prog),
             RTClosure env p1 p2 -> RTClosure env p2 p3 ->
             RTClosure env p1 p3.
Proof.
  intros.
  induction X.
  assumption.
  apply IHX in X0.
  econstructor.
  eassumption.
  assumption.
Defined.

Lemma EClosConcat :
    forall (fenv: funEnv) (env: valEnv)
           (p1 p2 p3: AConfig Exp),
   EClosure fenv env p1 p2 -> EClosure fenv env p2 p3 ->
                                   EClosure fenv env p1 p3.
Proof.
  intros.
  induction X.
  assumption.
  apply IHX in X0.
  econstructor.
  eassumption.
  assumption.
Defined.

Lemma PrmsConcat :
  forall (fenv: funEnv) (env: valEnv)
         (p1 p2 p3: AConfig Prms),
   PrmsClosure fenv env p1 p2 -> PrmsClosure fenv env p2 p3 ->
                                      PrmsClosure fenv env p1 p3.
Proof.
  intros.
  induction X.
  assumption.
  apply IHX in X0.
  econstructor.
  eassumption.
  assumption.
Defined.

Lemma Define_extended_congruence :
  forall (env1 env2: funEnv)
         (n1 n2: W) (x: Id) (f: Fun) (p1 p2: Prog),
             env2 = updateE env1 x f ->
             RTClosure env2 (Conf Prog n1 p1) (Conf Prog n2 p2) ->
             RTClosure env1 (Conf Prog n1 (define x f p1))
                                 (Conf Prog n2 (define x f p2)).
Proof.
  intros.
  dependent induction X.
  - constructor.
  - destruct p4.
    econstructor.
    + instantiate (1 := Conf Prog state (define x f qq)).
      econstructor.
      reflexivity.
      assumption.
    + eapply IHX.
      reflexivity.
      reflexivity.
      reflexivity.
Defined.

Lemma BindN_extended_congruence :
   forall (fenv: funEnv) (env: valEnv)
                          (n1 n2: W) (p1 p2 p3: Exp),
     EClosure fenv env (Conf Exp n1 p1) (Conf Exp n2 p2) ->
     EClosure fenv env (Conf Exp n1 (BindN p1 p3))
                            (Conf Exp n2 (BindN p2 p3)).
Proof.
  intros.
  dependent induction X.
  constructor.
  destruct p5.
  specialize (IHX state).
  specialize (IHX n2).
  specialize (IHX qq).
  specialize (IHX p2).
  econstructor.
  - instantiate (1:= Conf Exp state (BindN qq p3)).
    eapply BindN_Cg_EStep.
    assumption.
  - apply IHX.
    reflexivity.
    reflexivity.
Defined.

Lemma BindMS_extended_congruence :
        forall (fenv fenvL fenv': funEnv) (env envL env': valEnv)
               (n1 n2: W) (e1 e2: Exp),
          fenv' = overrideE fenvL fenv ->
          env' = overrideE envL env ->
          EClosure fenv' env' (Conf Exp n1 e1) (Conf Exp n2 e2) ->
          EClosure fenv env (Conf Exp n1 (BindMS fenvL envL e1))
                                 (Conf Exp n2 (BindMS fenvL envL e2)).
Proof.
  intros.
  dependent induction X.
  constructor.
  destruct p2.
  econstructor.
  - instantiate (1 := Conf Exp state (BindMS fenvL envL qq)).
    econstructor.
    reflexivity.
    reflexivity.
    assumption.
  - eapply IHX.
    reflexivity.
    reflexivity.
    reflexivity.
    reflexivity.
Defined.

Lemma BindS_extended_congruence :
   forall (fenv: funEnv) (env: valEnv)
      (n1 n2: W) (x: Id) (p1 p2 p3: Exp),
           EClosure fenv env (Conf Exp n1 p1) (Conf Exp n2 p2) ->
           EClosure fenv env (Conf Exp n1 (BindS x p1 p3))
                                  (Conf Exp n2 (BindS x p2 p3)).
Proof.
  intros.
  dependent induction X.
  constructor.
  destruct p5.
  econstructor.
  - econstructor.
    eassumption.
  - eapply IHX.
    reflexivity.
    reflexivity.
Defined.

Lemma Apply1_extended_congruence :
     forall (fenv: funEnv) (env: valEnv)
                           (n n': W)
                           (f: Fun) (ps ps': Prms),
     PrmsClosure fenv env (Conf Prms n ps) (Conf Prms n' ps') ->
     EClosure fenv env (Conf Exp n (Apply (QF f) ps))
                            (Conf Exp n' (Apply (QF f) ps')).
Proof.
  intros.
  dependent induction X.
  constructor.
  destruct p2.
  econstructor.
  - econstructor.
    eassumption.
  - specialize (IHX state n' qq ps').
    eapply IHX.
    reflexivity.
    reflexivity.
Defined.

Lemma Apply2_extended_congruence
      (fenv: funEnv) (env: valEnv) (n n': W) (h h': QFun) (ps: Prms) :
     QFClosure fenv (Conf QFun n h) (Conf QFun n' h') ->
     EClosure fenv env (Conf Exp n (Apply h ps))
                            (Conf Exp n' (Apply h' ps)).
Proof.
  intros.
  dependent induction X.
  constructor.
  econstructor.
  - econstructor.
    eassumption.
  - constructor.
Defined.

Lemma IfThenElse_extended_congruence :
     forall (fenv: funEnv) (env: valEnv)
                           (n n': W)
                           (e e' e1 e2: Exp),
     EClosure fenv env (Conf Exp n e) (Conf Exp n' e') ->
     EClosure fenv env (Conf Exp n
                                 (IfThenElse e e1 e2))
                            (Conf Exp n'
                                 (IfThenElse e' e1 e2)).
Proof.
  intros.
  dependent induction X.
  constructor.
  intros.
  destruct p2.
  specialize (IHX state n' qq e' eq_refl eq_refl).
  econstructor.
  - econstructor.
    eassumption.
  - assumption.
Defined.

Lemma Pars_extended_congruence1 :
    forall (fenv: funEnv) (env: valEnv)
                   (n n': W)
                   (es es': list Exp) (v: Value),
         PrmsClosure fenv env (Conf Prms n (PS es))
                                   (Conf Prms n' (PS es')) ->
         PrmsClosure fenv env (Conf Prms n (PS (Val v :: es)))
                                   (Conf Prms n' (PS (Val v :: es'))).
Proof.
  intros.
  revert v.
  dependent induction X.
  - intros.
    constructor.
  - intros.
    destruct p2.
    destruct qq.
    specialize (IHX state n' es0 es').
    specialize (IHX eq_refl eq_refl v).
    econstructor.
    econstructor.
    eassumption.
    assumption.
Defined.

Lemma Pars_extended_congruence2 :
    forall (fenv: funEnv) (env: valEnv)
           (n n': W) (es: list Exp) (e e': Exp),
         EClosure fenv env (Conf Exp n e)
                                (Conf Exp n' e') ->
         PrmsClosure fenv env (Conf Prms n (PS (e::es)))
                                   (Conf Prms n' (PS (e'::es))).
  intros.
  revert es.
  dependent induction X.
  - constructor.
  - intros.
    destruct p2.
    specialize (IHX state n' qq e').
    specialize (IHX eq_refl eq_refl es).
    econstructor.
    econstructor.
    eassumption.
    assumption.
Defined.

Lemma Pars_extended_congruence3 :
       forall (fenv: funEnv) (env: valEnv)
                   (n n': W)
                   (es evs: list Exp) (vs: list Value),
         isValueList2T evs vs ->
         PrmsClosure fenv env (Conf Prms n (PS es))
                                   (Conf Prms n' (PS evs)) ->
         PrmsClosure fenv env (Conf Prms n (PS es))
                                   (Conf Prms n' (PS (map Val vs))).
Proof.
  intros.
  inversion H; subst.
  inversion H; subst.
  assumption.
Defined.

Lemma Pars_extended_congruence4 :
    forall (fenv: funEnv) (env: valEnv)
           (n n' n'': W) (es es': list Exp) (e: Exp) (v: Value),
         EClosure fenv env (Conf Exp n e)
                                (Conf Exp n' (Val v)) ->
         PrmsClosure fenv env (Conf Prms n' (PS es))
                                   (Conf Prms n'' (PS es')) ->
         PrmsClosure fenv env (Conf Prms n (PS (e::es)))
                                   (Conf Prms n'' (PS (Val v::es'))).
  intros.
  revert es es' X0.
  revert n''.
  dependent induction X.
  - intros.
    eapply PrmsConcat.
    econstructor.
    eapply Pars_extended_congruence1.
    assumption.
  - intros.
    destruct p2.
    specialize (IHX state n' qq v).
    specialize (IHX eq_refl eq_refl n'' es es' X0).
    econstructor.
    econstructor.
    eassumption.
    assumption.
Defined.

Lemma PrmsStep_aux0 :
    forall (fenv: funEnv) (env: valEnv)
           (n n': W) (es es': list Exp),
         PrmsStep fenv env (Conf Prms n (PS es))
                     (Conf Prms n' (PS es')) ->
         length es = length es'.
Proof.
  intros.
  dependent induction X.
  specialize (IHX n n' es0 es'0 eq_refl eq_refl).
  simpl.
  auto.
  auto.
Defined.

Lemma PrmsClos_aux0 :
    forall (fenv: funEnv) (env: valEnv)
           (n n': W) (es es': list Exp),
         PrmsClosure fenv env (Conf Prms n (PS es))
                     (Conf Prms n' (PS es')) ->
         length es = length es'.
Proof.
  intros.
  dependent induction X.
  auto.
  destruct p2.
  destruct qq.
  eapply PrmsStep_aux0 in p.
  specialize (IHX state n' es0 es' eq_refl eq_refl).
  rewrite <- p in IHX.
  auto.
Defined.

Lemma PrmsClos_aux1 (fenv: funEnv) (env: valEnv)
                     (e: Exp) (v: Value) (es es': list Exp) (n: W)
      : {n' : W &
      PrmsClosure fenv env (Conf Prms n (PS (e :: es)))
                  (Conf Prms n' (PS (Val v :: es')))} ->
{n' : W &
      prod (EClosure fenv env (Conf Exp n e)
               (Conf Exp n' (Val v)))
            {n'' : W &
                  PrmsClosure fenv env (Conf Prms n' (PS es))
                                       (Conf Prms n'' (PS es'))} }.
Proof.
  intros.
  destruct X as [n2 X].
  dependent induction X.
  - econstructor.
    split.
    econstructor.
    econstructor.
    econstructor.
  - destruct p2.
    destruct qq.
    destruct es0 as [| e1 es1].
    inversion p.
    specialize (IHX e1 v es1 es' state n2 eq_refl eq_refl).
    destruct IHX.
    destruct p0.
    destruct s.
    inversion e0; subst.
    inversion p; subst.
    econstructor.
    split.
    econstructor.
    econstructor.
    econstructor.
    exact X0.
    exact p0.
    econstructor.
    split.
    eapply StepIsEClos.
    exact X0.
    econstructor.
    exact p0.
    (**)
    inversion e0; subst.
    inversion X0.
    inversion p; subst.
    inversion X0.
    econstructor.
    split.
    econstructor.
    exact X4.
    exact e0.
    econstructor.
    exact p0.
Defined.

Lemma prmsAux1
      (ftenv: funTC) (tenv: valTC) (ps: Prms) (pt: PTyp) :
  forall (fenv: funEnv) (env: valEnv),
    FEnvTyping fenv ftenv ->
    EnvTyping env tenv ->
    forall n: W,
    (sigT (fun (n': W) =>
           sigT (fun (es: list Exp) =>
           prod (isValueListT es)
           (prod (PrmsClosure fenv env (Conf Prms n ps)
                                            (Conf Prms n' (PS es)))
                 (PrmsTyping ftenv tenv fenv (PS es) pt))))) ->
    (sigT (fun (n': W) =>
           sigT (fun (vs: list Value) =>
           prod (PrmsClosure fenv env (Conf Prms n ps)
                                           (Conf Prms n' (PS (map Val vs))))
                (PrmsTyping emptyE emptyE emptyE (PS (map Val vs)) pt)))).
Proof.
  intros.
  destruct X1 as [n1 X1].
  destruct X1 as [es X1].
  destruct X1 as [X1 X2].
  destruct X2 as [X2 X3].
  exists n1.
  eapply isValueList22_T in X1.
  inversion X1.
  destruct X1 as [vs].
  constructor 1 with (x:=vs).
  split.
  - eapply PrmsConcat.
    eassumption.
    inversion i; subst.
    constructor.
  - destruct pt.
    inversion i; subst.
    constructor.
    eapply matchListsAux1A.
    eassumption.
    inversion X3; subst.
    eassumption.
Defined.

Lemma NoPrmsStep (fenv: funEnv) (env: valEnv)
                  (n0 n1: W) (es1 es2: list Exp):
  PrmsStep fenv env (Conf Prms n0 (PS es1))
                      (Conf Prms n1 (PS es2)) ->
   isValueListT es1 -> False.
Proof.
  intros.
  revert X0.
  dependent induction X.
  intros.
  inversion X0; subst.
  eapply IHX.
  reflexivity.
  reflexivity.
  auto.
  intro.
  inversion X0; subst.
  inversion X; subst.
  inversion e0.
Defined.

End Dynamic.

(*
Module DynamicC := Dynamic IdMod1.

Export IdMod1.
Export DynamicC.
*)