(** * Semantical domains for H-VHDL *)

(** Module defining the semantical domains used in H-VHDL
    simulation semantics. *)

Require Import common.CoqLib.
Require Import common.GlobalTypes.
Require Import common.ListLib.
Require Import String.

Import ErrMonadNotations.

Require Import hvhdl.AbstractSyntax.
Require Import hvhdl.HVhdlTypes.

Open Scope N_scope.

(** ** Value type and functions about values *)

Section Values.

  (** Defines the type of values used to express the semantics of the
      H-VHDL language.

      A value is either a boolean, a natural number, an array of
      values. *)

  Inductive value : Type :=
  | Vbool : bool -> value
  | Vnat : N -> value
  | Varr : arrofvalues -> value

  with arrofvalues : Type :=
  | Arr_one : value -> arrofvalues
  | Arr_cons : value -> arrofvalues -> arrofvalues.

  Scheme value_ind_mut := Induction for value Sort Prop
      with arrofvalues_ind_mut := Induction for arrofvalues Sort Prop.

  (** Equality is decidable for the [value] type *)

  Lemma value_eq_dec : forall x y : value, {x = y} + {x <> y}. Admitted.

  (** Conversion from [arrofvalues] to [list value] *)

  Fixpoint aofv2list (aofv : arrofvalues) {struct aofv} : list (value) :=
    match aofv with
    | Arr_one v => [v]
    | Arr_cons v tl => v :: aofv2list tl
    end.

  Coercion aofv2list : arrofvalues >-> list.

  (** Accesses the element at position [i] in arrofvalues [aofv].

    Returns an error (i.e, None) if the index is greater
    than the list length.
   *)

  Fixpoint oget_at (i : nat) (aofv : arrofvalues) {struct aofv} : option value :=
    match i, aofv with
    (* Error, index out of bounds. *)
    | S _, Arr_one v => None
    | 0%nat, Arr_one v => Some v
    | 0%nat, Arr_cons v aofv' => Some v
    | S j, Arr_cons a aofv' => oget_at j aofv'
    end.

  (** Given a proof that index [i] is strictly less than the size of
      arrofvalues [aofv], accesses the value at position [i] in [aofv].
   *)

  Fixpoint get_at (i : nat) (aofv : arrofvalues) {struct aofv} : (i < List.length aofv)%nat -> value.
    refine (
        match i, aofv with
        (* Error, index out of bounds. *)
        | S _, Arr_one v => fun _ => _
        | 0%nat, Arr_one v => fun _ => v
        | 0%nat, Arr_cons v aofv' => fun pf => v
        | (S j), Arr_cons a aofv' => fun pf => get_at j aofv' _
        end);
      [apply lt_S_n in l; apply Nat.nlt_0_r in l; contradiction
      | apply (lt_S_n j (List.length aofv') pf)].
  Defined.

  (** Stores value [v] at position [i] in list of values [lofv].

      Returns an error (i.e, None) if the index is greater than
      the list length. *)

  Fixpoint oset_at (v : value) (i : nat) (aofv : arrofvalues) {struct i} : option arrofvalues :=
    match i, aofv with
    (* Error, index out of bounds. *)
    | S j, Arr_one _ => None
    | 0%nat, Arr_one v' => Some (Arr_one v)
    | 0%nat, Arr_cons v' tl => Some (Arr_cons v tl)
    | (S j), Arr_cons v' tl =>
        (* Inductive step. *)
        match oset_at v j tl with
        | Some aofv' => Some (Arr_cons v' aofv')
        | None => None
        end
    end.

  (** Given a proof that index [i] is strictly less than the size of
    [aofv], stores value [v] at position [i] in [aofv], and returns
    the new [arrofvalues].  *)

  Fixpoint set_at (v : value) (i : nat) (aofv : arrofvalues) {struct i} : (i < List.length aofv)%nat -> arrofvalues.
    refine (match i, aofv with
            (* Error, index out of bounds. *)
            | S j, Arr_one _ => fun _ => _
            | 0%nat, Arr_one _ => fun _ => Arr_one v
            | 0%nat, Arr_cons _ tl => fun _ => Arr_cons v tl
            | (S j), Arr_cons v' tl => fun _ => Arr_cons v' (set_at v j tl _)
            end).
    apply lt_pred in l; simpl in l; apply Nat.nlt_0_r in l; contradiction.
    apply (lt_S_n j (List.length tl) l).
  Defined.

  Functional Scheme set_at_ind := Induction for set_at Sort Prop.

  (** Given a proof that [n > 0], returns an arrofvalues of length [n]
    filled with value [v]. *)

  Definition create_arr (n : nat) (v : value) : (n > 0)%nat -> arrofvalues :=
    match n as n0 return ((n0 > 0)%nat -> arrofvalues) with
    (* Absurd case, 0 > 0. *)
    | 0%nat => fun H : (0 > 0)%nat => False_rect arrofvalues (Nat.nlt_0_r 0 H)
    (* Case n > 0 *)
    | S m =>
        fun _ =>
          (* Internal fixpoint definition, returns [Arr_one v] when size
         is zero. *)
          let fix create_arrm (m : nat) (v : value) {struct m} :=
            match m return arrofvalues with
            | 0%nat => Arr_one v
            | S o => Arr_cons v (create_arrm o v)
            end
          in create_arrm m v
    end.

End Values.

(** ** Semantic type *)

Section Types.

  (** Defines the type of types used to express the semantics of the
      H-VHDL language.

      Note that an element of the [type] type does not carry proofs of
      its well-definition, i.e. one can build an ill-formed natural
      range type, for instance [Tnat 10 2]. *)

  Inductive type : Type :=
  | Tbool                              (** Boolean type *)
  | Tnat (l : N) (u : N)               (** Natural range from l to u *)
  | Tarray (t : type) (l : N) (u : N). (** Array of t with index range
                                           from l to u *)

  (** Well-formed type predicate *)

  Inductive WFType : type -> Prop :=
  | WFBool : WFType Tbool
  | WFNat : forall l u, l <= u -> u <= NATMAX -> WFType (Tnat l u)
  | WFArr : forall t l u, l <= u -> u <= NATMAX -> WFType t -> WFType (Tarray t l u).

  Fixpoint WFType_dec (t : type) : {WFType t} + {~WFType t}.
    refine (match t with
            | Tbool => left WFBool
            | Tnat l u =>
                match N_le_dec l u, (N_le_dec u NATMAX) with
                | left lelu, left leuN => left (WFNat l u lelu leuN)
                | _, _ => right _
                end
            | Tarray t__a l u =>
                match WFType_dec t__a with
                | left WFt__a =>
                    match N_le_dec l u, (N_le_dec u NATMAX) with
                    | left lelu, left leuN => left (WFArr t__a l u lelu leuN WFt__a)
                    | _, _ => right _
                    end
                | _ => right _
                end
            end); inversion 1; contradiction.
  Defined.

  (** Defines the typing relation [IsOfType]. *)

  Inductive IsOfType : value -> type -> Prop :=
  | IsBool : forall (b : bool), IsOfType (Vbool b) Tbool

  (** Value n must satisfy the index constraint, i.e n ∈ [l,u]. *)
  | IsNat : forall (n l u : N),
      WFType (Tnat l u) -> l <= n <= u -> IsOfType (Vnat n) (Tnat l u)

  (** All elements of the array of values [aofv] must be of type [t],
    and the length of [aofv] must satisfy the index constraint.
   *)
  | IsArrOfT (l u : N) :
    forall (aofv : arrofvalues) (t : type),
      WFType (Tarray t l u) ->
      ArrIsOfType aofv (S (N.to_nat (u - l))) t ->
      IsOfType (Varr aofv) (Tarray t l u)

  (** Defines the typing relation over array of values.

    By construction, checks that the array size
    is equal to the second argument (of type [nat]). *)

  with ArrIsOfType: arrofvalues -> nat -> type -> Prop :=
  | ArrIsOfTypeOne : forall t v, IsOfType v t -> ArrIsOfType (Arr_one v) 1 t
  | ArrIsOfTypeCons :
    forall aofv size t v,
      IsOfType v t ->
      ArrIsOfType aofv size t ->
      ArrIsOfType (Arr_cons v aofv) (S size) t.

  Scheme IsOfType_ind_mut := Induction for IsOfType Sort Prop
      with ArrIsOfType_ind_mut := Induction for ArrIsOfType Sort Prop.

  (** Defines the typing function [is_of_type]. *)

  Fixpoint is_of_type (v : value) (t : type) {struct v} : optionE bool :=
    match v, t with
    | Vbool b, Tbool => Ret true
    | Vnat n, Tnat l u =>
        if WFType_dec t then
          match N_le_dec l n, N_le_dec n u with
          | left _, left _ => Ret true
          | _, _ => Ret false
          end
        else Err "is_of_type: found an ill-formed nat type"
    | Varr aofv, Tarray ta l u =>
        if WFType_dec t then
          arr_is_of_type aofv ta ((u - l) + 1)
        else Err "is_of_type: found an ill-formed array type"
    | _, _ => Ret false
    end
  with arr_is_of_type (aofv : arrofvalues) (t : type) (size : N) {struct aofv} : optionE bool :=
         match aofv, size with
         | Arr_one v, 1 => is_of_type v t
         | Arr_cons v tl, Npos n =>
             do b1 <- is_of_type v t; do b2 <- arr_is_of_type tl t (size - 1); Ret (b1 && b2)
         | _, _ => Ret false
         end.

End Types.

(** ** Equality between two values *)

Section ValueEq.

  (** Specifies the equality relation between two values, and the
      result of the equality evaluation; result can either be an error
      (i.e, [None]), or some Boolean value.

      The third parameter is mandatory, otherwise, it is not possible
      to distinguish errors from "falsity"; imagine a relation [VEq]
      that takes two values as parameters:

      - [~VEq (Vnat 0) (Vnat 1)] is provable because 0 ≠ 1.

      - [~VEq (Vnat 0) (Vbool false)] is provable because 0 and false
        are not comparable, however it is an error case because the
        two values are not of the same type.  *)

  Inductive OVEq : value -> value -> option bool -> Prop :=
  | OVEq_BoolT : forall b b', b = b' -> OVEq (Vbool b) (Vbool b') (Some true)
  | OVEq_BoolF : forall b b', b <> b' -> OVEq (Vbool b) (Vbool b') (Some false)
  | OVEq_NatT  : forall n n', n = n' -> OVEq (Vnat n) (Vnat n') (Some true)
  | OVEq_NatF  : forall n n', n <> n' -> OVEq (Vnat n) (Vnat n') (Some false)
  | OVEq_ArrT : forall a a', OArrOfVEq a a' (Some true) -> OVEq (Varr a) (Varr a') (Some true)
  | OVEq_ArrF : forall a a', OArrOfVEq a a' (Some false) -> OVEq (Varr a) (Varr a') (Some false)
  | VEqArr_Err : forall a a', OArrOfVEq a a' None -> OVEq (Varr a) (Varr a') None

  (* Error if there is no common type for value [v] and [v'], i.e, [v]
   and [v'] are not comparable. *)
  | OVEq_Err : forall v v', (forall t, ~IsOfType v t \/ ~IsOfType v' t) -> OVEq v v' None

  (** Specifies the equality relation between two arrays of values. *)
  with OArrOfVEq : arrofvalues -> arrofvalues -> option bool -> Prop :=
  (* Convenient to detect errors due to the comparison of two
   arrofvalues of different lengths. *)
  | OArrOfVEq_LengthErr1 : forall v v' aofv, OArrOfVEq (Arr_one v) (Arr_cons v' aofv) None
  | OArrOfVEq_LengthErr2 : forall v v' aofv, OArrOfVEq (Arr_cons v aofv) (Arr_one v') None
  | OArrOfVEq_OneT : forall v v', OVEq v v' (Some true) -> OArrOfVEq (Arr_one v) (Arr_one v') (Some true)
  | OArrOfVEq_OneF : forall v v', OVEq v v' (Some false) -> OArrOfVEq (Arr_one v) (Arr_one v') (Some false)
  | OArrOfVEq_ConsT :
    forall v v' aofv aofv',
      OVEq v v' (Some true) ->
      OArrOfVEq aofv aofv' (Some true) ->
      OArrOfVEq (Arr_cons v aofv) (Arr_cons v' aofv') (Some true)
  | OArrOfVEq_ConsF :
    forall v v' aofv aofv',
      OVEq v v' (Some false) ->
      OArrOfVEq aofv aofv' (Some false) ->
      OArrOfVEq (Arr_cons v aofv) (Arr_cons v' aofv') (Some false)

  | OArrOfVEqCons_Err :
    forall v v' aofv aofv' optb,
      OVEq v v' None ->
      OArrOfVEq aofv aofv' optb ->
      OArrOfVEq (Arr_cons v aofv) (Arr_cons v' aofv') None.

  Hint Constructors OVEq : hvhdl.
  Hint Constructors OArrOfVEq : hvhdl.

  Scheme OVEq_ind_mut := Induction for OVEq Sort Prop
      with OArrOfVEq_ind_mut := Induction for OArrOfVEq Sort Prop.

  (** Wrapper around the [OVEq] relation *)

  Definition VEq x y := OVEq x y (Some true).
  Definition VNEq x y := OVEq x y (Some false).

  Definition VEq_refl : forall x, VEq x x.
  Proof. unfold VEq.
         apply (value_ind_mut
                  (fun x => OVEq x x (Some true))
                  (fun x => OArrOfVEq x x (Some true)));
           intros; auto with hvhdl.
  Qed.

  Definition VEq_sym : forall x y, VEq x y -> VEq y x.
  Proof. unfold VEq; intros.
         apply (OVEq_ind_mut
                  (fun x y o _ => OVEq y x o)
                  (fun x y o _ => OArrOfVEq y x o));
           auto with hvhdl.
         intros; apply OVEq_Err; firstorder.
         intros; eapply OArrOfVEqCons_Err; eauto.
  Defined.

  Definition VEq_trans1 :
    forall y x z, VEq x y -> VEq y z -> VEq x z.
  Proof.
    unfold VEq.
    apply (value_ind_mut
             (fun y => forall x z, OVEq x y (Some true) -> OVEq y z (Some true) -> OVEq x z (Some true))
             (fun y => forall x z, OArrOfVEq x y (Some true) -> OArrOfVEq y z (Some true) -> OArrOfVEq x z (Some true))).
    - (* y = Vbool b *)
      inversion_clear 1; subst; inversion_clear 1; subst.
      constructor; reflexivity.
    - (* y = Vnat n *)
      inversion_clear 1; subst; inversion_clear 1; subst.
      constructor; reflexivity.
    - (* y = Varr a *)
      intros a IH.
      inversion_clear 1; subst; inversion_clear 1; subst.
      constructor; eapply IH; eauto.
    - (* Mutual ind. a = Arr_one *)
      intros v IH.
      inversion_clear 1; subst; inversion_clear 1; subst.
      constructor; eapply IH; eauto.
    - (* Mutual ind. a = Arr_cons *)
      intros v IHv a IHa.
      inversion_clear 1; subst; inversion_clear 1; subst.
      constructor; [ eapply IHv; eauto | eapply IHa; eauto ].
  Defined.

  Definition VEq_trans :
    forall x y z, VEq x y -> VEq y z -> VEq x z.
  Proof. intros x y; generalize x; eapply VEq_trans1. Defined.

  Add Parametric Relation : (value) (VEq)
      reflexivity proved by VEq_refl
      symmetry proved by VEq_sym
      transitivity proved by VEq_trans
      as VEq_rel.

  (** Implements the equality operator between two values.

      Returns a [bool] corresponding to the result of the comparison
      of the two values.

      Returns an error if the two values do not belong to the same
      domain of values.

   *)

  Fixpoint veq (v v' : value) {struct v} : optionE bool :=
    match v, v' with
    | Vbool b, Vbool b' => Ret (Bool.eqb b b')
    | Vnat n, Vnat n' => Ret (N.eqb n n')
    | Varr aofv, Varr aofv' => arrofveq aofv aofv'
    | _, _ => Err "veq: can not compare two values of different domains"
    end
  (** Implements the equality operator between array of values.

      Returns [Some true] if values of [aofv] and [aofv'] are equal pair-wise.

      Returns an error if a pair-wise comparison returns an error or if
      the arrays are of different length. *)

  with arrofveq (aofv aofv' : arrofvalues) {struct aofv} : optionE bool :=
         match aofv, aofv' with
         (* Two empty lists are v-equal. *)
         | Arr_one v, Arr_one v' => veq v v'

         (* Checks that a and b are v-equal. *)
         | (Arr_cons v a), (Arr_cons v' a') =>
             do b <- veq v v'; if b then arrofveq a a' else Ret false
         | _, _ => Err "arrofveq: can not compare to array of values of different size"
         end.

End ValueEq.

#[export] Hint Constructors OVEq : hvhdl.
#[export] Hint Constructors OArrOfVEq : hvhdl.

(** ** Index Iterator for [arrofvalues] *)

Section ArrOfV_Iterator.

  (** An array is a least of length [1]; it has at least one
      element. *)

  Lemma length_aofv_gt_O : forall aofv : arrofvalues, (0 < List.length aofv)%nat.
    destruct aofv; cbn; eapply Nat.lt_0_succ; eauto.
  Defined.

  (** Generates a contiguous sequence of natural numbers corresponding
      the available indexes of the [aofv] arrofvalues; i.e, the
      sequence ranges from [0] to [length aofv - 1], and for each
      index [i] there is a proof that [i < length aofv]. *)

  Definition arrofv_idxs (aofv : arrofvalues) : list { i | (i < List.length aofv)%nat } :=
    seqd 0 (List.length aofv) (length_aofv_gt_O aofv).

  (** [BProd_ArrOfV aofv bprod ≡ ∏i=0 to (length aofv -1), aofv[i]
      ].  If [ aofv[i] ] is not a boolean value, then [true] is passed
      to the product. *)

  Definition get_bool_at (aofv : arrofvalues) (i : nat) : bool :=
    match oget_at i aofv with
    | Some (Vbool b) => b
    | _ => true
    end.

  Definition BProd_ArrOfV (aofv : arrofvalues) (bprod : bool) :=
    let f_bprod :=
      fun i =>
        match oget_at i aofv with
        | Some (Vbool b) => b
        | _ => true
        end
    in
    BProd f_bprod (seq 0 (List.length aofv)) bprod.

  (** Dependently-typed version of [BProd_ArrOfV] where there is a
      proof that each index [i] in the generated sequence verifies [i
      < length aofv]. Therefore, we are able to use the error-free
      [get_at] function to access element of [aofv] through their
      index. *)

  Definition DepBProd_ArrOfV (aofv : arrofvalues) (bprod : bool) :=
    let f_bprod :=
      fun (i : { n | (n < 0 + List.length aofv)%nat }) =>
        match get_at (proj1_sig i) aofv (proj2_sig i) with
        | Vbool b => b
        | _ => true
        end
    in
    BProd f_bprod (arrofv_idxs aofv) bprod.

End ArrOfV_Iterator.


(* 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 Arith.
Require Import NArith.
Require Import Ndec.
Require Import ZArith.
Require Import Classical_Prop.
From IntMap Require Import Allmaps.
Require Import lattice_fixpoint.
Require Import bases.
Require Import defs.
Require Import semantics.
Require Import pl_path.

(* définition de la fonction dont on va calculer le point fixe *)

Fixpoint pl_non_empty (m : Map bool) (p : prec_list) {struct p} : bool :=
  match p with
  | prec_empty => true
  | prec_cons a la ls =>
      match ls with
      | prec_empty =>
          match MapGet bool m a with
          | Some b => b && pl_non_empty m la
          | None => false
          end
      | prec_cons _ _ _ =>
          match MapGet bool m a with
          | Some b => pl_non_empty m ls || b && pl_non_empty m la
          | None => pl_non_empty m ls
          end
      end
  end.

Fixpoint st_non_empty (m : Map bool) (s : state) {struct s} : bool :=
  match s with
  | M0 => false
  | M1 _ p => pl_non_empty m p
  | M2 a b => st_non_empty m a || st_non_empty m b
  end.

Fixpoint dta_app_ne_aux (d : preDTA) (m r : Map bool) {struct r} :
 Map bool :=
  match d, r with
  | M0, _ => M0 bool
  | M1 a s, M0 => M0 bool
  | M1 a s, M1 a' b =>
      if Neqb a a' then M1 bool a (b || st_non_empty m s) else M0 bool
  | M1 a s, M2 _ _ => M0 bool
  | M2 d0 d1, M0 => M0 bool
  | M2 d0 d1, M1 _ _ => M0 bool
  | M2 d0 d1, M2 r0 r1 =>
      M2 bool (dta_app_ne_aux d0 m r0) (dta_app_ne_aux d1 m r1)
  end.

Definition dta_app_ne (d : preDTA) (m : Map bool) :
  Map bool := dta_app_ne_aux d m m.

Definition dta_non_empty_states (d : preDTA) : Map bool :=
  power (Map bool) (dta_app_ne d) (map_mini state d) (S (MapCard state d)).

Definition dta_states_non_empty (d : DTA) : Map bool :=
  match d with
  | dta p a => dta_non_empty_states p
  end.

Definition dta_non_empty_states_lazy (d : preDTA) :
  Map bool :=
  lazy_power bool eqm_bool (dta_app_ne d) (map_mini state d)
    (S (MapCard state d)).

Definition dta_states_non_empty_lazy (d : DTA) : Map bool :=
  match d with
  | dta p a => dta_non_empty_states_lazy p
  end.

Lemma dta_states_non_empty_lazy_eg_dta_states_non_empty :
 forall d : DTA, dta_states_non_empty_lazy d = dta_states_non_empty d.
Proof.
	simple induction d. simpl in |- *. intros. unfold dta_non_empty_states_lazy, dta_non_empty_states in |- *. apply
  (lazy_power_eg_power bool eqm_bool (dta_app_ne p)
     (map_mini state p) (S (MapCard state p))).
	split. exact (eqm_bool_equal a0 b). intros. rewrite H.
	exact (equal_eqm_bool b).
Qed.

(* définition ok de dta_app_ne *)

Lemma dta_app_ne_aux_def_ok :
 forall (d : preDTA) (m : Map bool),
 def_ok_app bool (ensemble_base state d) (dta_app_ne_aux d m).
Proof.
	simple induction d. intros. unfold def_ok_app in |- *. intros. induction  x as [| a a0| x1 Hrecx1 x0 Hrecx0].
	simpl in |- *. unfold ensemble_base in |- *. exact I. unfold ensemble_base in |- *. simpl in |- *.
	exact I. simpl in |- *. unfold ensemble_base in |- *. simpl in |- *. exact I. intros.
	unfold def_ok_app in |- *. intros. unfold ensemble_base in |- *. unfold ensemble_base in H. induction  x as [| a1 a2| x1 Hrecx1 x0 Hrecx0]. simpl in H. inversion H. simpl in H. simpl in |- *. rewrite H.
	rewrite (Neqb_correct a1). simpl in |- *. reflexivity. simpl in H. inversion H.
	intros. unfold def_ok_app in |- *. unfold ensemble_base in |- *. intros. induction  x as [| a a0| x1 Hrecx1 x0 Hrecx0].
	simpl in H1. inversion H1. simpl in H1. inversion H1. simpl in |- *. split.
	unfold def_ok_app in H. unfold ensemble_base in H. simpl in H1.
	elim H1. intros. exact (H m1 x1 H2). unfold def_ok_app in H0.
	unfold ensemble_base in H0. elim H1. intros. exact (H0 m1 x0 H3).
Qed.

Lemma dta_app_ne_def_ok :
 forall d : preDTA, def_ok_app bool (ensemble_base state d) (dta_app_ne d).
Proof.
	intros. unfold dta_app_ne in |- *. unfold def_ok_app in |- *. intros. exact (dta_app_ne_aux_def_ok d x x H).
Qed.

(* croissance de dta_app_ne *)

Lemma dta_app_ne_inc_0 :
 forall (p : prec_list) (m0 m1 : Map bool),
 lem m0 m1 -> leb (pl_non_empty m0 p) (pl_non_empty m1 p).
Proof.
	simple induction p. intros. induction  p1 as [a0 p1_1 Hrecp1_1 p1_0 Hrecp1_0| ]. elim (option_sum bool (MapGet bool m0 a)); intro y. elim y. intros x y0. elim (option_sum bool (MapGet bool m1 a)); intro y1. elim y1. intros x0 y2. replace (pl_non_empty m0 (prec_cons a p0 (prec_cons a0 p1_1 p1_0))) with
  (pl_non_empty m0 (prec_cons a0 p1_1 p1_0) || x && pl_non_empty m0 p0). replace (pl_non_empty m1 (prec_cons a p0 (prec_cons a0 p1_1 p1_0))) with
  (pl_non_empty m1 (prec_cons a0 p1_1 p1_0) || x0 && pl_non_empty m1 p0). apply
  (leb_transitive
     (pl_non_empty m0 (prec_cons a0 p1_1 p1_0) || x && pl_non_empty m0 p0)
     (pl_non_empty m0 (prec_cons a0 p1_1 p1_0) || x0 && pl_non_empty m1 p0)
     (pl_non_empty m1 (prec_cons a0 p1_1 p1_0) || x0 && pl_non_empty m1 p0)).
	apply
  (orb_incr (pl_non_empty m0 (prec_cons a0 p1_1 p1_0))
     (pl_non_empty m0 (prec_cons a0 p1_1 p1_0)) (x && pl_non_empty m0 p0)
     (x0 && pl_non_empty m1 p0)). exact (leb_reflexive _).
	apply (andb_incr x x0 (pl_non_empty m0 p0) (pl_non_empty m1 p0)).
	exact (lem_get_leb m0 m1 a x x0 H1 y0 y2). exact (H _ _ H1).
	apply
  (orb_incr (pl_non_empty m0 (prec_cons a0 p1_1 p1_0))
     (pl_non_empty m1 (prec_cons a0 p1_1 p1_0)) (x0 && pl_non_empty m1 p0)
     (x0 && pl_non_empty m1 p0)). exact (H0 _ _ H1). exact (leb_reflexive _). simpl in |- *. rewrite y2. reflexivity. simpl in |- *. rewrite y0.
	reflexivity. elim (domain_equal_mapget bool bool m0 m1 a x). intros.
	rewrite H2 in y1. inversion y1. exact (lem_domain_equal m0 m1 H1).
	exact y0. elim (option_sum bool (MapGet bool m1 a)); intro y0. elim y0; intros x y1. elim (domain_equal_mapget bool bool m1 m0 a x); intros. rewrite H2 in y. inversion y. exact (domain_equal_symmetric bool bool _ _ (lem_domain_equal _ _ H1)). exact y1. replace (pl_non_empty m0 (prec_cons a p0 (prec_cons a0 p1_1 p1_0))) with
  (pl_non_empty m0 (prec_cons a0 p1_1 p1_0)). replace (pl_non_empty m1 (prec_cons a p0 (prec_cons a0 p1_1 p1_0))) with
  (pl_non_empty m1 (prec_cons a0 p1_1 p1_0)).
	exact (H0 _ _ H1). simpl in |- *. rewrite y0. reflexivity. simpl in |- *. rewrite y.
	reflexivity. elim (option_sum bool (MapGet bool m0 a)); intro y.
	elim (option_sum bool (MapGet bool m1 a)); intro y0. elim y; intros x y1.
	elim y0; intros x0 y2. replace (pl_non_empty m0 (prec_cons a p0 prec_empty)) with
  (x && pl_non_empty m0 p0). replace (pl_non_empty m1 (prec_cons a p0 prec_empty)) with
  (x0 && pl_non_empty m1 p0). apply
  (leb_transitive (x && pl_non_empty m0 p0) (x0 && pl_non_empty m0 p0)
     (x0 && pl_non_empty m1 p0)). apply (andb_inc_l (pl_non_empty m0 p0) x x0). exact (lem_get_leb _ _ _ _ _ H1 y1 y2). apply (andb_inc_r x0 (pl_non_empty m0 p0) (pl_non_empty m1 p0)). exact (H _ _ H1). simpl in |- *.
	rewrite y2. reflexivity. simpl in |- *. rewrite y1. reflexivity. elim y. intros x y1.
	elim (domain_equal_mapget bool bool m0 m1 a x). intros. rewrite H2 in y0.
	inversion y0. exact (lem_domain_equal _ _ H1). exact y1. elim (option_sum bool (MapGet bool m1 a)); intro y0. elim y0. intros x y1. elim (domain_equal_mapget bool bool m1 m0 a x). intros. rewrite H2 in y. inversion y.
	exact (domain_equal_symmetric bool bool _ _ (lem_domain_equal _ _ H1)).
	exact y1. simpl in |- *. rewrite y. rewrite y0. exact I. simpl in |- *. intros. exact I.
Qed.

Lemma dta_app_ne_inc_1 :
 forall (s : state) (m0 m1 : Map bool),
 lem m0 m1 -> leb (st_non_empty m0 s) (st_non_empty m1 s).
Proof.
	simple induction s. intros. simpl in |- *. exact I. intros. simpl in |- *.
	exact (dta_app_ne_inc_0 a0 m0 m1 H). intros. simpl in |- *.
	exact (orb_incr _ _ _ _ (H _ _ H1) (H0 _ _ H1)).
Qed.

Lemma dta_app_ne_inc_2 :
 forall (d : preDTA) (m0 m1 m : Map bool),
 lem m0 m1 -> lem (dta_app_ne_aux d m0 m) (dta_app_ne_aux d m1 m).
Proof.
	simple induction d. simple induction m. intros. simpl in |- *. exact I. intros.
	simpl in |- *. exact I. intros. simpl in |- *. exact I. simple induction m. intros.
	simpl in |- *. exact I. simpl in |- *. intros. elim (bool_is_true_or_false (Neqb a a1)); intros; rewrite H0. simpl in |- *. rewrite (Neqb_correct a). exact (orb_inc_r _ _ _ (dta_app_ne_inc_1 a0 m0 m1 H)).
	exact I. intros. simpl in |- *. exact I. simple induction m3. intros. simpl in |- *.
	exact I. intros. simpl in |- *. exact I. intros. simpl in |- *. split.
	exact (H _ _ _ H3). exact (H0 _ _ _ H3).
Qed.

Lemma dta_app_ne_inc_3 :
 forall (m0 m1 m : Map bool) (d : preDTA),
 lem m0 m1 -> lem (dta_app_ne_aux d m m0) (dta_app_ne_aux d m m1).
Proof.
	simple induction m0. simple induction m1; intros. induction  d as [| a a0| d1 Hrecd1 d0 Hrecd0]; simpl in |- *; exact I.
	inversion H. inversion H1. simple induction m1; intros. inversion H.
	induction  d as [| a3 a4| d1 Hrecd1 d0 Hrecd0]; simpl in |- *. exact I. simpl in H. elim (bool_is_true_or_false (Neqb a a1)); intro; rewrite H0 in H. rewrite (Neqb_complete _ _ H0).
	elim (bool_is_true_or_false (Neqb a3 a1)); intro; rewrite H1. simpl in |- *.
	rewrite (Neqb_correct a3). exact (orb_inc_l _ _ _ H). exact I. elim H.
	exact I. inversion H1. simple induction m2; intros. inversion H1. inversion H1.
	elim H3; intros. induction  d as [| a a0| d1 Hrecd1 d0 Hrecd0]; simpl in |- *. exact I. exact I. split. exact (H _ _ _ H4). exact (H0 _ _ _ H5).
Qed.

Lemma dta_app_ne_inc :
 forall d : preDTA, increasing_app bool lem (dta_app_ne d).
Proof.
	intros. unfold increasing_app in |- *. unfold dta_app_ne in |- *. intros.
	exact
  (lem_transitive _ _ _ (dta_app_ne_inc_2 d x y x H)
     (dta_app_ne_inc_3 x y y d H)).
Qed.

Inductive pl_path_true : pl_path -> Map bool -> Prop :=
  | plp_true_nil : forall m : Map bool, pl_path_true pl_path_nil m
  | plp_true_cons :
      forall (m : Map bool) (a : ad) (pl : pl_path),
      pl_path_true pl m ->
      MapGet bool m a = Some true -> pl_path_true (pl_path_cons a pl) m.

Definition pl_non_empty_path_true_def_0 (pl : pl_path)
  (p : prec_list) : Prop :=
  forall m : Map bool,
  pl_path_incl pl p -> pl_path_true pl m -> pl_non_empty m p = true.

Lemma pl_non_empty_path_true_0 :
 pl_non_empty_path_true_def_0 pl_path_nil prec_empty.
Proof.
	unfold pl_non_empty_path_true_def_0 in |- *. simpl in |- *. intros.
	reflexivity.
Qed.

Lemma pl_non_empty_path_true_1 :
 forall (plp : pl_path) (a : ad) (la ls : prec_list),
 pl_path_incl plp la ->
 pl_non_empty_path_true_def_0 plp la ->
 pl_non_empty_path_true_def_0 (pl_path_cons a plp) (prec_cons a la ls).
Proof.
	unfold pl_non_empty_path_true_def_0 in |- *. intros. inversion H2.
	simpl in |- *. rewrite H7. elim (pl_sum ls); intros. rewrite H8.
	exact (H0 m H H5). elim H8. intros. elim H9. intros. elim H10.
	intros. rewrite H11. rewrite (H0 m H H5). elim (bool_is_true_or_false (pl_non_empty m (prec_cons x x0 x1))); intro;
  rewrite H12; reflexivity.
Qed.

Lemma pl_non_empty_path_true_2 :
 forall (plp : pl_path) (a : ad) (la ls : prec_list),
 pl_path_incl plp ls ->
 pl_non_empty_path_true_def_0 plp ls ->
 plp <> pl_path_nil -> pl_non_empty_path_true_def_0 plp (prec_cons a la ls).
Proof.
	unfold pl_non_empty_path_true_def_0 in |- *. intros. induction  plp as [| a0 plp Hrecplp].
	elim (H1 (refl_equal _)). inversion H3. simpl in |- *. elim (pl_sum ls); intros. rewrite H9 in H. inversion H. elim H9.
	intros. elim H10. intros. elim H11. intros. rewrite H12.
	rewrite <- H12. rewrite (H0 m H H3). elim (option_sum bool (MapGet bool m a)); intro y. elim y. intros x2 y0. rewrite y0.
	elim (bool_is_true_or_false (x2 && pl_non_empty m la)); intro; rewrite H13;
  reflexivity. rewrite y. reflexivity.
Qed.

Lemma pl_non_empty_path_true :
 forall (pl : pl_path) (p : prec_list) (m : Map bool),
 pl_path_incl pl p -> pl_path_true pl m -> pl_non_empty m p = true.
Proof.
	intros. exact
  (pl_path_incl_ind pl_non_empty_path_true_def_0 pl_non_empty_path_true_0
     pl_non_empty_path_true_1 pl_non_empty_path_true_2 pl p H m H H0).
Qed.

Lemma pl_non_empty_path_true_rev :
 forall (p : prec_list) (m : Map bool),
 pl_non_empty m p = true ->
 exists plp : pl_path, pl_path_incl plp p /\ pl_path_true plp m.
Proof.
	simple induction p. intros. simpl in H1. elim (pl_sum p1); intros.
	rewrite H2 in H1. elim (option_sum bool (MapGet bool m a)); intro y. elim y. intros x y0. rewrite y0 in H1. elim (bool_is_true_or_false x); intro; rewrite H3 in H1. elim (bool_is_true_or_false (pl_non_empty m p0)); intros. elim (H m H4). intros. elim H5. intros. split with (pl_path_cons a x0). split. exact (pl_path_incl_cons x0 a p0 p1 H6).
	rewrite H3 in y0. exact (plp_true_cons m a x0 H7 y0).
	rewrite H4 in H1. inversion H1. elim (bool_is_true_or_false (pl_non_empty m p0)); intro; rewrite H4 in H1;
  inversion H1.
	rewrite y in H1. inversion H1. elim H2. intros. elim H3. intros.
	elim H4. intros. rewrite H5 in H1. rewrite <- H5 in H1. elim (option_sum bool (MapGet bool m a)); intro y. elim y. intros x2 y0.
	rewrite y0 in H1. elim (bool_is_true_or_false (pl_non_empty m p1)); intros. elim (H0 m H6); intros. split with x3. split.
	elim H7. intros. apply (pl_path_incl_next x3 a p0 p1 H8). intro.
	rewrite H10 in H8. rewrite H5 in H8. inversion H8. exact (H16 (refl_equal _)). elim H7; intros. assumption.
	rewrite H6 in H1. elim (bool_is_true_or_false (x2 && pl_non_empty m p0)); intros;
  rewrite H7 in H1. elim (bool_is_true_or_false x2); intros; rewrite H8 in H7. rewrite H8 in y0. elim (bool_is_true_or_false (pl_non_empty m p0)); intros.
	elim (H m H9); intros. split with (pl_path_cons a x3). split.
	elim H10. intros. exact (pl_path_incl_cons x3 a p0 p1 H11).
	elim H10. intros. exact (plp_true_cons m a x3 H12 y0). rewrite H9 in H7. inversion H7. elim (bool_is_true_or_false (pl_non_empty m p0)); intros; rewrite H9 in H7;
  inversion H7. inversion H1.
	rewrite y in H1. elim (H0 _ H1). intros. split with x2. split.
	apply (pl_path_incl_next x2 a p0 p1). elim H6. intros. assumption.
	intro. rewrite H7 in H6. elim H6. intros. inversion H8. rewrite <- H11 in H5. inversion H5. exact (H11 (refl_equal _)).
	elim H6; intros. assumption. intros. split with pl_path_nil.
	split. exact pl_path_incl_nil. exact (plp_true_nil m).
Qed.

Lemma st_non_empty_0 :
 forall (m : Map bool) (s : state) (p : prec_list) (a : ad),
 MapGet prec_list s a = Some p ->
 pl_non_empty m p = true -> st_non_empty m s = true.
Proof.
	simple induction s; intros. inversion H. simpl in |- *. simpl in H. elim (bool_is_true_or_false (Neqb a a1)); intro; rewrite H1 in H;
  inversion H. exact H0. simpl in |- *. induction  a as [| p0]. simpl in H1. rewrite (H p N0 H1 H2). simpl in |- *. reflexivity. induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]; simpl in H1.
	rewrite (H0 _ _ H1 H2). elim (bool_is_true_or_false (st_non_empty m m0)); intro; rewrite H3;
  reflexivity. rewrite (H _ _ H1 H2).
	reflexivity. rewrite (H0 _ _ H1 H2). elim (bool_is_true_or_false (st_non_empty m m0)); intro; rewrite H3;
  reflexivity.
Qed.

Lemma st_non_empty_1 :
 forall (d : preDTA) (m r : Map bool) (a : ad) (l : state),
 MapGet state d a = Some l ->
 domain_equal state bool d r ->
 st_non_empty m l = true ->
 MapGet bool (dta_app_ne_aux d m r) a = Some true.
Proof.
	simple induction d. intros. inversion H. intros. induction  r as [| a2 a3| r1 Hrecr1 r0 Hrecr0].
	inversion H0. simpl in |- *. simpl in H0. simpl in H. rewrite H0.
	rewrite (Neqb_correct a2). simpl in |- *. rewrite H0 in H. elim (bool_is_true_or_false (Neqb a2 a1)); intro; rewrite H2 in H.
	inversion H. rewrite H2. rewrite H1. elim (bool_is_true_or_false a3); intros; rewrite H3; reflexivity. inversion H. inversion H0.
	intros. induction  r as [| a0 a1| r1 Hrecr1 r0 Hrecr0]. inversion H2. inversion H2. elim H2; intros.
	induction  a as [| p]. simpl in |- *. simpl in H1. apply (H m1 r1 N0 l H1 H4).
	exact H3. induction  p as [p Hrecp| p Hrecp| ]; simpl in |- *; simpl in H1. elim H2. intros.
	exact (H0 _ _ _ _ H1 H7 H3). exact (H _ _ _ _ H1 H4 H3).
	exact (H0 _ _ _ _ H1 H5 H3).
Qed.

(* terme t reconnu en l'etat s : f^(high t)=true *)

Definition dt_non_empty_def_0 (d : preDTA) (a : ad)
  (t : term) (pr : reconnaissance d a t) :=
  forall n : nat,
  term_high t <= n ->
  MapGet bool (power (Map bool) (dta_app_ne d) (map_mini state d) n) a =
  Some true.

Definition dt_non_empty_def_1 (d : preDTA) (s : state)
  (t : term) (pr : state_reconnait d s t) :=
  forall n : nat,
  term_high t <= S n ->
  st_non_empty (power (Map bool) (dta_app_ne d) (map_mini state d) n) s =
  true.

Definition dt_non_empty_def_2 (d : preDTA) (p : prec_list)
  (t : term_list) (pr : liste_reconnait d p t) :=
  forall n : nat,
  term_high_0 t <= n ->
  pl_non_empty (power (Map bool) (dta_app_ne d) (map_mini state d) n) p =
  true.

Lemma dt_non_empty_0 :
 forall (d : preDTA) (a : ad) (t : term) (ladj : state)
   (e : MapGet state d a = Some ladj) (s : state_reconnait d ladj t),
 dt_non_empty_def_1 d ladj t s ->
 dt_non_empty_def_0 d a t (rec_dta d a t ladj e s).
Proof.
	unfold dt_non_empty_def_1, dt_non_empty_def_0 in |- *. intros. elim (nat_sum n); intros. rewrite H1 in H0. induction  t as (a0, t). simpl in H0.
	elim (le_Sn_O _ H0). elim H1. intros. rewrite H2. simpl in |- *. rewrite H2 in H0. replace
  (dta_app_ne d (power (Map bool) (dta_app_ne d) (map_mini state d) x)) with
  (dta_app_ne_aux d (power (Map bool) (dta_app_ne d) (map_mini state d) x)
     (power (Map bool) (dta_app_ne d) (map_mini state d) x)). apply
  (st_non_empty_1 d (power (Map bool) (dta_app_ne d) (map_mini state d) x)
     (power (Map bool) (dta_app_ne d) (map_mini state d) x) a ladj e). exact
  (power_def_ok bool (ensemble_base state d) (dta_app_ne d)
     (map_mini state d) x (dta_app_ne_def_ok d) (map_mini_appartient state d)). exact (H x H0). reflexivity.
Qed.

Lemma dt_non_empty_1 :
 forall (d : preDTA) (s : state) (c : ad) (tl : term_list)
   (l : prec_list) (e : MapGet prec_list s c = Some l)
   (l0 : liste_reconnait d l tl),
 dt_non_empty_def_2 d l tl l0 ->
 dt_non_empty_def_1 d s (app c tl) (rec_st d s c tl l e l0).
Proof.
	unfold dt_non_empty_def_1 in |- *. unfold dt_non_empty_def_2 in |- *. intros.
	simpl in H0. fold term_high_0 in H0. apply
  (st_non_empty_0 (power (Map bool) (dta_app_ne d) (map_mini state d) n) s l
     c e).
	exact (H n (le_S_n _ _ H0)).
Qed.

Lemma dt_non_empty_2 :
 forall d : preDTA, dt_non_empty_def_2 d prec_empty tnil (rec_empty d).
Proof.
	unfold dt_non_empty_def_2 in |- *. intros. simpl in |- *. reflexivity.
Qed.

Lemma dt_non_empty_3 :
 forall (d : preDTA) (a : ad) (la ls : prec_list) (hd : term)
   (tl : term_list) (r : reconnaissance d a hd),
 dt_non_empty_def_0 d a hd r ->
 forall l : liste_reconnait d la tl,
 dt_non_empty_def_2 d la tl l ->
 dt_non_empty_def_2 d (prec_cons a la ls) (tcons hd tl)
   (rec_consi d a la ls hd tl r l).
Proof.
	unfold dt_non_empty_def_0, dt_non_empty_def_2 in |- *. intros. simpl in H1.
	fold term_high in H1. elim
  (pl_non_empty_path_true_rev la
     (power (Map bool) (dta_app_ne d) (map_mini state d) n)
     (H0 n (le_trans (term_high_0 tl) _ _ (le_max_r _ _) H1))). intros. elim H2. intros.
	apply
  (pl_non_empty_path_true (pl_path_cons a x) (prec_cons a la ls)
     (power (Map bool) (dta_app_ne d) (map_mini state d) n)). exact (pl_path_incl_cons x a la ls H3). apply
  (plp_true_cons (power (Map bool) (dta_app_ne d) (map_mini state d) n) a x). exact H4. exact (H _ (le_trans _ _ _ (le_max_l _ _) H1)).
Qed.

Lemma dt_non_empty_4 :
 forall (d : preDTA) (a : ad) (la ls : prec_list) (hd : term)
   (tl : term_list) (l : liste_reconnait d ls (tcons hd tl)),
 dt_non_empty_def_2 d ls (tcons hd tl) l ->
 dt_non_empty_def_2 d (prec_cons a la ls) (tcons hd tl)
   (rec_consn d a la ls hd tl l).
Proof.
	unfold dt_non_empty_def_2 in |- *. intros. elim (pl_non_empty_path_true_rev _ _ (H n H0)). intros. elim H1. intros. apply
  (pl_non_empty_path_true x (prec_cons a la ls)
     (power (Map bool) (dta_app_ne d) (map_mini state d) n)). apply (pl_path_incl_next x a la ls H2). intro. rewrite H4 in H3.
	rewrite H4 in H2. inversion H2. rewrite <- H6 in l. inversion l.
	elim (H6 (refl_equal _)). exact H3.
Qed.

Lemma dt_non_empty_5 :
 forall (d : preDTA) (a : ad) (t : term),
 reconnaissance d a t ->
 forall n : nat,
 term_high t <= n ->
 MapGet bool (power (Map bool) (dta_app_ne d) (map_mini state d) n) a =
 Some true.
Proof.
	exact
  (mreconnaissance_ind dt_non_empty_def_0 dt_non_empty_def_1
     dt_non_empty_def_2 dt_non_empty_0 dt_non_empty_1 dt_non_empty_2
     dt_non_empty_3 dt_non_empty_4).
Qed.

Lemma dt_non_empty_6 :
 forall (p : preDTA) (p0 : prec_list) (t : term_list)
   (l : liste_reconnait p p0 t), dt_non_empty_def_2 p p0 t l.
Proof.
	exact
  (mlrec_ind dt_non_empty_def_0 dt_non_empty_def_1 dt_non_empty_def_2
     dt_non_empty_0 dt_non_empty_1 dt_non_empty_2 dt_non_empty_3
     dt_non_empty_4).
Qed.

Lemma dt_non_empty_d :
 forall (d : preDTA) (a : ad) (t : term),
 reconnaissance d a t ->
 exists n : nat,
   MapGet bool (power (Map bool) (dta_app_ne d) (map_mini state d) n) a =
   Some true.
Proof.
	intros. split with (term_high t). exact (dt_non_empty_5 d a t H (term_high t) (le_n_n _)).
Qed.

Lemma dt_non_empty_7 :
 forall (d : preDTA) (p : prec_list) (t : term_list),
 liste_reconnait d p t ->
 pl_non_empty
   (power (Map bool) (dta_app_ne d) (map_mini state d) (term_high_0 t)) p =
 true.
Proof.
	intros. exact (dt_non_empty_6 d p t H (term_high_0 t) (le_n_n _)).
Qed.

(* f^(high t)=true : terme t reconnu en l'etat s *)

Lemma dt_non_empty_r_0 :
 forall (d : preDTA) (m r : Map bool) (a : ad) (l : state),
 MapGet state d a = Some l ->
 domain_equal state bool d r ->
 MapGet bool (dta_app_ne_aux d m r) a = Some true ->
 MapGet bool r a = Some true \/ st_non_empty m l = true.
Proof.
	simple induction d. intros. inversion H. intros. induction  r as [| a2 a3| r1 Hrecr1 r0 Hrecr0].
	inversion H0. simpl in H0. rewrite H0 in H. rewrite H0 in H1.
	simpl in H. elim (bool_is_true_or_false (Neqb a2 a1)); intro; rewrite H2 in H. inversion H. simpl in H1. rewrite (Neqb_correct a2) in H1. simpl in H1. rewrite H2 in H1. inversion H1. rewrite H5.
	simpl in |- *. rewrite H2. elim (bool_is_true_or_false a3); intros; rewrite H3. left. reflexivity. rewrite H3 in H5. simpl in H5.
	rewrite H4 in H5. right. exact H5. inversion H. inversion H0.
	intros. induction  r as [| a0 a1| r1 Hrecr1 r0 Hrecr0]. inversion H2. inversion H2. induction  a as [| p].
	simpl in H1. simpl in |- *. simpl in H3. simpl in H2. elim H2. intros.
	exact (H _ _ _ _ H1 H4 H3). elim H2. intros. induction  p as [p Hrecp| p Hrecp| ]; simpl in |- *; simpl in H1;
  simpl in H3. exact (H0 _ _ _ _ H1 H5 H3). exact (H _ _ _ _ H1 H4 H3). exact (H0 _ _ _ _ H1 H5 H3).
Qed.

Lemma dt_non_empty_r_1 :
 forall (s : state) (m : Map bool),
 st_non_empty m s = true ->
 exists c : ad,
   (exists p : prec_list,
      MapGet prec_list s c = Some p /\ pl_non_empty m p = true).
Proof.
	simple induction s; intros. simpl in H. inversion H. simpl in H.
	split with a. split with a0. split. simpl in |- *. rewrite (Neqb_correct a). reflexivity. exact H. simpl in H1.
	elim (bool_is_true_or_false (st_non_empty m1 m)); intros.
	elim (H m1 H2). intros. elim H3. intros. elim H4. intros.
	induction  x as [| p]. split with N0. split with x0. simpl in |- *. split; assumption. split with (Npos (xO p)). split with x0. simpl in |- *.
	split; assumption. rewrite H2 in H1. simpl in H1. elim (H0 _ H1). intros. elim H3. intros. elim H4. intros. induction  x as [| p].
	split with (Npos 1). simpl in |- *. split with x0. split; assumption.
	split with (Npos (xI p)). split with x0. simpl in |- *. split; assumption.
Qed.

Lemma dt_non_empty_r_2 :
 forall (p : prec_list) (m : Map bool),
 pl_non_empty m p = true ->
 exists pl : pl_path, pl_path_true pl m /\ pl_path_incl pl p.
Proof.
	simple induction p. intros. simpl in H1. elim (pl_sum p1). intros.
	rewrite H2 in H1. elim (option_sum bool (MapGet bool m a)).
	intro y. elim y. intros x y0. rewrite y0 in H1. elim (bool_is_true_or_false x); intros; rewrite H3 in H1; simpl in H1.
	elim (H m H1). intros. elim H4. intros. rewrite H3 in y0.
	split with (pl_path_cons a x0). split. exact (plp_true_cons m a x0 H5 y0). exact (pl_path_incl_cons x0 a p0 p1 H6). inversion H1. intro y. rewrite y in H1. inversion H1. intros. elim H2.
	intros. elim H3. intros. elim H4. intros. rewrite H5 in H1.
	elim (option_sum bool (MapGet bool m a)); intro y. elim y. intros x2 y0.
	rewrite y0 in H1. rewrite <- H5 in H1. elim (bool_is_true_or_false (pl_non_empty m p1)); intros. elim (H0 _ H6). intros. elim H7.
	intros. split with x3. split. exact H8. apply (pl_path_incl_next x3 a p0 p1 H9). intro. rewrite H10 in H9. inversion H9. rewrite <- H12 in H5. inversion H5. elim (H12 (refl_equal _)).
	rewrite H6 in H1. simpl in H1. elim (bool_is_true_or_false x2); intro. rewrite H7 in y0. elim (bool_is_true_or_false (pl_non_empty m p0)); intro. elim (H _ H8). intros. elim H9. intros. split with (pl_path_cons a x3). split. exact (plp_true_cons _ _ _ H10 y0).
	exact (pl_path_incl_cons x3 a p0 p1 H11). rewrite H8 in H1.
	rewrite H7 in H1. inversion H1. rewrite H7 in H1. inversion H1.
	rewrite y in H1. rewrite <- H5 in H1. elim (H0 _ H1). intros.
	elim H6. intros. split with x2. split. exact H7. apply (pl_path_incl_next x2 a p0 p1 H8). intro. rewrite H9 in H8.
	inversion H8. rewrite <- H11 in H5. inversion H5. elim H11.
	reflexivity. intros. split with pl_path_nil. split. exact (plp_true_nil m). exact pl_path_incl_nil.
Qed.

Definition dt_non_empty_r_def_0 (n : nat) : Prop :=
  forall (d : preDTA) (a : ad),
  MapGet bool (power (Map bool) (dta_app_ne d) (map_mini state d) n) a =
  Some true -> exists t : term, reconnaissance d a t.

Lemma dt_non_empty_r_3 : dt_non_empty_r_def_0 0.
Proof.
	unfold dt_non_empty_r_def_0 in |- *. simpl in |- *. intros. cut (true <> false).
	intro. elim (H0 (map_mini_mapget_false state d a true H)).
	intro. inversion H0.
Qed.

Lemma dt_non_empty_r_4 :
 forall (p : prec_list) (n : nat) (d : preDTA) (pl : pl_path),
 dt_non_empty_r_def_0 n ->
 pl_path_true pl (power (Map bool) (dta_app_ne d) (map_mini state d) n) ->
 pl_path_incl pl p -> exists tl : term_list, liste_reconnait d p tl.
Proof.
	unfold dt_non_empty_r_def_0 in |- *. simple induction p. intros.
	inversion H2. inversion H3.
        rewrite <- H4 in H7. inversion H7.
        elim H11; auto.
        elim (H1 _ _ H5). intros. inversion H3. rewrite <- H10 in H6.
        inversion H6. rewrite <- H10 in H2.
        inversion H2. elim (H n d plp H1 H18 H11).
        intros. split with (tcons x x0).
        rewrite H15 in H8. rewrite H9 in H8.
        exact (rec_consi d a p0 p1 x x0 H8 H21).
        elim (H0 n d pl H1 H2 H12). intros. induction  x0 as [| t x0 Hrecx0].
        inversion H15. rewrite <- H17 in H12. inversion H12. elim H14; auto.
        split with (tcons t x0). exact (rec_consn d a p0 p1 t x0 H15).
        intros. inversion H1. split with tnil. exact (rec_empty d).
Qed.

Lemma dt_non_empty_r_5 :
 forall n : nat, dt_non_empty_r_def_0 n -> dt_non_empty_r_def_0 (S n).
Proof.
	unfold dt_non_empty_r_def_0 in |- *. intros. elim
  (domain_equal_mapget bool state
     (power (Map bool) (dta_app_ne d) (map_mini state d) (S n)) d a true). intros. unfold dta_app_ne in H0.  simpl in H0. elim
  (dt_non_empty_r_0 d
     (power (Map bool) (fun m : Map bool => dta_app_ne_aux d m m)
        (map_mini state d) n)
     (power (Map bool) (fun m : Map bool => dta_app_ne_aux d m m)
        (map_mini state d) n) a x H1); intros. exact (H d a H2). elim (dt_non_empty_r_1 _ _ H2). intros. elim H3. intros. elim H4. intros. elim (dt_non_empty_r_2 _ _ H6). intros. elim H7. intros.
	elim (dt_non_empty_r_4 x1 n d x2 H H8 H9). intros.
	split with (app x0 x3). exact (rec_dta d a (app x0 x3) x H1 (rec_st d x x0 x3 x1 H5 H10)). apply
  (power_def_ok bool (ensemble_base state d) (dta_app_ne d)
     (map_mini state d) n).
	exact (dta_app_ne_def_ok d). exact (map_mini_appartient state d). exact H0. apply
  (domain_equal_symmetric state bool d
     (power (Map bool) (dta_app_ne d) (map_mini state d) (S n))). exact
  (power_def_ok bool (ensemble_base state d) (dta_app_ne d)
     (map_mini state d) (S n) (dta_app_ne_def_ok d)
     (map_mini_appartient state d)). exact H0.
Qed.

Lemma dt_non_empty_r :
 forall (n : nat) (d : preDTA) (a : ad),
 MapGet bool (power (Map bool) (dta_app_ne d) (map_mini state d) n) a =
 Some true -> exists t : term, reconnaissance d a t.
Proof.
	exact (nat_ind dt_non_empty_r_def_0 dt_non_empty_r_3 dt_non_empty_r_5).
Qed.

Lemma dt_non_empty_fix_0 :
 forall d : preDTA,
 lower_fix_point bool (ensemble_base state d) lem (dta_app_ne d)
   (dta_non_empty_states d).
Proof.
	unfold dta_non_empty_states in |- *.
	intros. exact
  (iteres_lower_fix_point bool (ensemble_base state d) lem
     (dta_app_ne d) (map_mini state d) (S (MapCard state d))
     (S (MapCard state d)) (map_mini_mini state d)
     (dta_app_ne_def_ok d) (dta_app_ne_inc d) (lattice_bounded state d)
     (le_n_n _)).
Qed.

Lemma dt_non_empty_fix_1 :
 forall (d : preDTA) (a : ad) (n : nat),
 MapGet bool (power (Map bool) (dta_app_ne d) (map_mini state d) n) a =
 Some true -> MapGet bool (dta_non_empty_states d) a = Some true.
Proof.
	intros. elim
  (domain_equal_mapget bool bool
     (power (Map bool) (dta_app_ne d) (map_mini state d) n)
     (dta_non_empty_states d) a true).
	intros. elim (bool_is_true_or_false x); intro; rewrite H1 in H0.
	exact H0. elim (dt_non_empty_fix_0 d). intros. unfold inf_fix_points in H3. elim
  (lem_get_leb _ _ _ _ _
     (iteres_inf_fps bool (ensemble_base state d) lem
        (dta_app_ne d) (map_mini state d) (dta_non_empty_states d) n
        (map_mini_mini state d) H2 (dta_app_ne_inc d)) H H0). apply
  (domain_equal_transitive bool state bool
     (power (Map bool) (dta_app_ne d) (map_mini state d) n) d
     (dta_non_empty_states d)). exact
  (domain_equal_symmetric state bool _ _
     (power_def_ok bool (ensemble_base state d) (dta_app_ne d)
        (map_mini state d) n (dta_app_ne_def_ok d)
        (map_mini_appartient state d))). unfold dta_non_empty_states in |- *.
	exact
  (power_def_ok bool (ensemble_base state d) (dta_app_ne d)
     (map_mini state d) (S (MapCard state d)) (dta_app_ne_def_ok d)
     (map_mini_appartient state d)). exact H.
Qed.

Lemma dt_non_empty_fix_2 :
 forall (d : preDTA) (a : ad),
 MapGet bool (dta_non_empty_states d) a = Some true ->
 exists n : nat,
   MapGet bool (power (Map bool) (dta_app_ne d) (map_mini state d) n) a =
   Some true.
Proof.
	unfold dta_non_empty_states in |- *. intros. split with (S (MapCard state d)). exact H.
Qed.

(* correction et complètude du test au vide *)

Lemma dt_non_empty_fix :
 forall (d : preDTA) (a : ad),
 MapGet bool (dta_non_empty_states d) a = Some true <->
 (exists t : term, reconnaissance d a t).
Proof.
	intros. split. intros. elim (dt_non_empty_fix_2 d a H).
	intros. exact (dt_non_empty_r _ _ _ H0). intros. elim H.
	intros. elim (dt_non_empty_d d a x H0). intros. exact (dt_non_empty_fix_1 _ _ _ H1).
Qed.

Lemma dt_non_empty_lazy_fix :
 forall (d : preDTA) (a : ad),
 MapGet bool (dta_non_empty_states_lazy d) a = Some true <->
 (exists t : term, reconnaissance d a t).
Proof.
	intro. unfold dta_non_empty_states_lazy in |- *. rewrite
  (lazy_power_eg_power bool eqm_bool (dta_app_ne d)
     (map_mini state d) (S (MapCard state d))). exact (dt_non_empty_fix d). split. exact (eqm_bool_equal a b). intro. rewrite H. exact (equal_eqm_bool b).
Qed.


From VT Require Export seplogic.

Definition NULL := 0.

(* (l |-> w) * (l+1 |-> _) *)
Definition pto1any L l w : Heap -> PropX L := star (pto _ l w) (ptoany _ (l+1)).

(* (l |-> _) * (l+1 |-> w) *)
Definition ptoany1 L l w : Heap -> PropX L := star (ptoany _ l) (pto _ (l+1) w).

(* (l |-> _) * (l+1 |-> _) *)
Definition ptoanyany L l : Heap -> PropX L := star (ptoany _ l) (ptoany _ (l+1)).

(* Definitions using tactic language Ltac. *)
(* okvalid: Validity_of_Deductions *)
Ltac des H := generalize (okvalid _ _ H); clear H; intro; unfold eq_rect.
Ltac dest H := generalize (okvalid _ _ H); clear H; destruct 1; unfold eq_rect.
Ltac destx H v := generalize (okvalid _ _ H); clear H; destruct 1 as [v]; unfold eq_rect.
Ltac existsx x := apply ok_extx_i with x.
Ltac splitx := apply ok_and_i.
Ltac leftx := apply ok_or_i1.
Ltac rightx := apply ok_or_i2.
Ltac propx := apply ok_prop_i.

(* a: Heap -> PropX L
   Si: CdHpSpec
   h: Heap
 *)
Lemma star_emp : forall a Si h,
  (* OK: Env -> CdHpSpec -> PropX tO -> Prop
     Validity rules for impredicative extended propositions
  *)
  (* Gamma(nil) |-{Si} a * emp *)
  OK xcapi.nil Si (star a (emp _) h) ->
  (* meq: forall a, M1 a = M2 a *)
  (forall Si h h', Map.meq h h' -> OK xcapi.nil Si (a h) -> OK xcapi.nil Si (a h')) ->
  OK xcapi.nil Si (a h).
Admitted.

Lemma star_sym : forall a a' Si h,
  OK xcapi.nil Si (star a a' h) -> OK xcapi.nil Si (star a' a h).
Admitted.

Lemma star_assoc_R : forall a a' a'' Si h,
  OK xcapi.nil Si (star a (star a' a'') h) ->
  OK xcapi.nil Si (star (star a a') a'' h).
Admitted.

Lemma star_assoc_L : forall a a' a'' Si h,
  OK xcapi.nil Si (star (star a a') a'' h) ->
  OK xcapi.nil Si (star a (star a' a'') h).
Admitted.

Lemma pto_lookup : forall l w Si h,
  OK xcapi.nil Si (pto _ l w h) -> Map.lookup h l w.
Admitted.

Lemma lookup_star_lookup : forall l w a,
  (forall Si h, OK xcapi.nil Si (a h) -> Map.lookup h l w) ->
  forall a' Si h, OK xcapi.nil Si (star a a' h) -> Map.lookup h l w.
Admitted.

Lemma ptoany_indom : forall l Si h,
  OK xcapi.nil Si (ptoany _ l h) -> Map.in_dom h l.
Admitted.

Lemma indom_star_indom : forall l a,
  (forall Si h, OK xcapi.nil Si (a h) -> Map.in_dom h l) ->
  forall a' Si h, OK xcapi.nil Si (star a a' h) -> Map.in_dom h l.
Admitted.

Definition hpred_imp (a a' : Heap -> PropX tO) :=
  forall h Si, OK xcapi.nil Si (a h) -> OK xcapi.nil Si (a' h).

Lemma ok_star_ok : forall a a' a'' h Si,
  OK xcapi.nil Si ((star a a') h) -> hpred_imp a' a''
  -> OK xcapi.nil Si ((star a a'') h).
Admitted.

Lemma pto2_ptoany1 : forall l w w' Si h,
  OK xcapi.nil Si (pto2 _ l w w' h) -> OK xcapi.nil Si (ptoany1 _ l w' h).
Admitted.

Lemma ptoany1_ptoanyany : forall l w Si h,
  OK xcapi.nil Si (ptoany1 _ l w h) -> OK xcapi.nil Si (ptoanyany _ l h).
Admitted.

Lemma ptoany_free : forall l Si h,
  OK xcapi.nil Si (ptoany _ l h) -> OK xcapi.nil Si (emp _ (fH h l)).
Admitted.

Lemma disj_free_disj :
  forall h1 h2 l, Map.disjoint h1 h2 -> Map.disjoint h1 (fH h2 l).
Admitted.

Lemma disj_update_disj :
  forall h1 h2 l w, Map.disjoint h1 h2 -> Map.in_dom h1 l ->
                    Map.disjoint (uH h1 l w) h2.
Admitted.

Lemma star_free : forall l a a' a'',
  (forall Si h, OK xcapi.nil Si (a' h) ->
    Map.in_dom h l /\ OK xcapi.nil Si (a'' (fH h l))) ->
  forall Si h, OK xcapi.nil Si (star a a' h) ->
    Map.in_dom h l /\ OK xcapi.nil Si (star a a'' (fH h l)).
Admitted.

Lemma star_imp : forall a a' a'' a''',
  (forall Si h, OK xcapi.nil Si (a h) -> OK xcapi.nil Si (a'' h)) ->
  (forall Si h, OK xcapi.nil Si (a' h) -> OK xcapi.nil Si (a''' h)) ->
  forall Si h, OK xcapi.nil Si (star a a' h) -> OK xcapi.nil Si (star a'' a''' h).
Admitted.

Lemma pto2_pto1any : forall l w w' Si h,
  OK xcapi.nil Si (pto2 _ l w w' h) -> OK xcapi.nil Si (pto1any _ l w h).
Admitted.

Lemma star_meq_star : forall a a' Si h h',
  OK xcapi.nil Si (star a a' h) -> Map.meq h h' ->
  OK xcapi.nil Si (star a a' h').
Admitted.

Lemma ptoany_update : forall l Si h w,
  OK xcapi.nil Si (ptoany _ l h) -> OK xcapi.nil Si (pto _ l w (uH h l w)).
Admitted.

Lemma star_update : forall a a' l w,
  (forall Si h, OK xcapi.nil Si (a h) ->
                Map.in_dom h l /\ OK xcapi.nil Si (a' (uH h l w))) ->
  forall a'' Si h, OK xcapi.nil Si (star a a'' h) ->
                   OK xcapi.nil Si (star a' a'' (uH h l w)).
Admitted.

Lemma subst_star : forall B (A : B -> PropX tO) a a' a'' a''',
  (forall Si h, OK xcapi.nil Si (Subst tO B (a h) A) ->
                OK xcapi.nil Si (a'' h)) ->
  (forall Si h, OK xcapi.nil Si (Subst tO B (a' h) A) ->
                OK xcapi.nil Si (a''' h)) ->
  forall Si h, OK xcapi.nil Si (Subst tO B (star a a' h) A) ->
               OK xcapi.nil Si (star a'' a''' h).
Admitted.

Lemma star_subst : forall a a' B (A : B -> PropX tO) a'' a''',
  (forall Si h, OK xcapi.nil Si (a h) ->
                OK xcapi.nil Si (Subst tO B (a'' h) A)) ->
  (forall Si h, OK xcapi.nil Si (a' h) ->
                OK xcapi.nil Si (Subst tO B (a''' h) A)) ->
  forall Si h, OK xcapi.nil Si (star a a' h) ->
               OK xcapi.nil Si (Subst tO B (star a'' a''' h) A).
Admitted.


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

(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(* Notation management revised in December 2002 *)

(****************************************************************************)
(*                                                                          *)
(*                                                                          *)
(*  subset.v                                                                *)
(*                                                                          *)
(*  Definition of subsets as types                                          *)
(*                                                                          *)
(*                                                                          *)
(*  Samuel Boutin                                                           *)
(*  Coq V5.10                                                               *)
(*  June  1995                                                              *)
(*                                                                          *)
(*                                                                          *)
(****************************************************************************)
(*                              subset.v                                    *)
(****************************************************************************)

(*
We define subset as types in the same way as quotients:
like in the deliverable model where a subset is a type
and a predicate on that type.
The alternative consisting of using a strong sum to encode
this feature suffers from the fact that we need to
use proof irrelevance if we want two
objects (a,pa) (a,pb) with pa,pb:(P a) to be identified.
*)

(* Definition of a subset: *)

Parameter MK_SUBSET : forall (A : Set) (R : A -> Prop), Set.

(* An element of a subset is an element of the underlying type
with a proof that this element satisfies the underlying predicate *)

Parameter
  In_subset : forall (A : Set) (R : A -> Prop) (a : A), R a -> MK_SUBSET A R.

(* Every element of a subset is an element of the underlying type *)

Parameter Out_subset : forall (A : Set) (R : A -> Prop), MK_SUBSET A R -> A.

(* Every element of the subset should satisfy the underlying predicate *)

Parameter
  proof :
    forall (A : Set) (R : A -> Prop) (t : MK_SUBSET A R),
    R (Out_subset A R t).

(* Rewrite rules explaining coercion principles between the subset and its
underlying type *)

Axiom
  In_Out :
    forall (A : Set) (R : A -> Prop) (t : MK_SUBSET A R)
      (p : R (Out_subset A R t)), In_subset A R (Out_subset A R t) p = t.

Axiom
  Out_In :
    forall (A : Set) (R : A -> Prop) (t : A) (p : R t),
    Out_subset A R (In_subset A R t p) = t.

(* Without proof irrelevance we should identify two element of a subset
as soon as their projection on the ground type are leibniz equal *)

Axiom
  Canonic :
    forall (A : Set) (R : A -> Prop) (t : A) (p p' : R t),
    In_subset A R t p = In_subset A R t p'.

(* Closure axioms defining the canonical form of objects of a subset type *)

Axiom
  Prop_closure :
    forall (A : Set) (R : A -> Prop) (P : MK_SUBSET A R -> Prop)
      (x : MK_SUBSET A R),
    (forall (y : A) (p : R y), P (In_subset A R y p)) -> P x.

Axiom
  Set_closure :
    forall (A : Set) (R : A -> Prop) (P : MK_SUBSET A R -> Set)
      (x : MK_SUBSET A R),
    (forall (y : A) (p : R y), P (In_subset A R y p)) -> P x.

(* Notation for subsets: *)

Notation "c ! p" := (MK_SUBSET c p) (at level 20).

Notation "%+ c" := (In_subset _ _ _ c) (at level 20).

(*
Require quotient.

Grammar constr constr1 :=
  mksub [ constr0($c) "!" constr0($c2) ] -> [ (MK_SUBSET $c $c2) ].

Syntax constr
  level 1:
  MK_SUBSET [ (MK_QUO $c $c1) ] -> [$c: L "!" $c1:L].
*)


(* Celsius project *)
(* Clément Blaudeau - Lamp@EPFL & Inria 2020-2022 *)
(* ------------------------------------------------------------------------ *)
(* This files defines the big step semantics and an induction predicate on the rules *)

From Celsius Require Export Helpers.

(* ------------------------------------------------------------------------ *)
(** ** Big step semantics *)

(* Notation only used for the definition *)
Reserved Notation "'⟦'  e  '⟧p' '(' σ ',' ρ ',' v ')'  '-->'  '(' v0 ',' σ0 ')'" (at level 80).
Reserved Notation "'⟦_' e '_⟧p' '(' σ ',' ρ ',' v ')'  '-->'  '(' vl ',' σl ')'" (at level 80).

(* Big step semantics for an expression *)
Inductive evalP : Expr -> Store -> Env -> Loc -> Loc -> Store -> Prop :=

(* Variable : we retrieve the value of x in the local environment ρ *)
| bs_var : forall σ x ρ ψ l,
    getVal ρ x = Some l ->
    ⟦ e_var x ⟧p (σ, ρ, ψ) --> (l, σ)

(* This : we return the current this pointer ψ *)
| bs_this : forall σ ρ ψ,
    ⟦ e_this ⟧p (σ, ρ, ψ) --> (ψ, σ)

(* Field access : we compute the object e, and fetch the value of the field in the resulting
object *)
| bs_fld : forall σ ρ ψ e f v1 σ1 C ω v,
    ⟦ e ⟧p (σ, ρ, ψ) --> (v1, σ1) ->
    getObj σ1 v1 = Some (C, ω) ->
    getVal ω f = Some v ->
    ⟦ (e_fld e f) ⟧p (σ, ρ, ψ) --> (v, σ1)

(* Method call : we first compute the object on which the method will be called, then the arguments,
and then we fetch the body of the method which we execute with the arguments as local environment *)
| bs_mtd : forall σ e0 m el e2 ρ ψ l1 vl2 l3 σ1 σ2 σ3 C Args Flds Mtds f argsM T μ,
    ⟦ e0 ⟧p (σ, ρ, ψ) --> (l1, σ1) ->
    getObj σ1 l1 = Some (C, f) ->
    ⟦_ el _⟧p (σ1, ρ, ψ) --> (vl2, σ2) ->
    ct C = class Args Flds Mtds  ->
    Mtds m = Some (method μ argsM T e2) ->
    ⟦ e2 ⟧p (σ2, vl2, l1) --> (l3, σ3) ->
    ⟦ e_mtd e0 m el ⟧p (σ, ρ, ψ) --> (l3, σ3)

(* New instance : we compute the arguments and call the special procedure [initP] to initialize the
new instance *)
| bs_new : forall σ ρ ψ C args vl__args σ1 σ3,
    ⟦_ args _⟧p (σ, ρ, ψ) --> (vl__args, σ1) ->
    let I := (length σ1) in
    initP C I 0 vl__args (σ1 ++ [(C, [])]) σ3 ->
    ⟦ e_new C args ⟧p (σ, ρ, ψ) --> (I, σ3)

(* Assignment : we compute the object, the value and update the field x. Then we compute the other
expression e' *)
| bs_asgn : forall σ ρ ψ e1 x e2 e' σ1 v1 σ2 v2 σ3 v3,
    ⟦ e1 ⟧p (σ, ρ, ψ) --> (v1, σ1) ->
    ⟦ e2 ⟧p (σ1, ρ, ψ) --> (v2, σ2) ->
    ⟦ e' ⟧p ((assign v1 x v2 σ2), ρ, ψ) --> (v3, σ3) ->
    ⟦ e_asgn e1 x e2 e' ⟧p (σ, ρ, ψ) --> (v3, σ3)

where "'⟦' e '⟧p' '(' σ ',' ρ ',' v ')' '-->' '(' v0 ',' σ0 ')' "  := (evalP e σ ρ v v0 σ0)

(* Big step semantics for a list of expressions (mainly a fold left) *)
with evalListP : list Expr -> Store -> Env -> Loc -> list Loc -> Store -> Prop :=

| bs_nil : forall σ ρ ψ,
    ⟦_ [] _⟧p (σ, ρ, ψ) --> ([], σ)

| bs_cons : forall σ ρ ψ e el l1 σ1 vl σ2,
    ⟦ e ⟧p (σ, ρ, ψ) --> (l1, σ1) ->
    ⟦_ el _⟧p (σ1, ρ, ψ) --> (vl, σ2) ->
    ⟦_ (e::el) _⟧p (σ, ρ, ψ) --> (l1::vl, σ2)

where "'⟦_' el '_⟧p' '(' σ ',' ρ ',' v ')' '-->' '(' vl ',' σ0 ')' "  := (evalListP el σ ρ v vl σ0)

(* Initialization procedure: we compute the mandatory field initializers for the fields between i
and (length Flds) *)
with initP : ClN -> Var -> nat -> Env -> Store -> Store -> Prop :=

(* No fields left to initialize *)
| init_nil : forall C I ρ σ Args Flds Mtds,
    ct C = class Args Flds Mtds ->
    initP C I (dom Flds) ρ σ σ

(* We compute the value of the defining expression, then update the store (which can already a value
for x) and proceed *)
| init_cons : forall C ψ i ρ σ v T e Args Flds Mtds σ1 σ2 σ3,
    ct C = class Args Flds Mtds ->
    nth_error Flds i = Some (field T e) ->
    ⟦ e ⟧p (σ, ρ, ψ) --> (v, σ1) ->
    assign_new ψ i v σ1 = Some σ2 ->
    initP C ψ (S i) ρ σ2 σ3 ->
    initP C ψ i ρ σ σ3.

(* Overloaded notations between expressions and lists of expressions *)
Global Instance notation_big_step_list_expr : notation_big_step (list Expr) (list Loc) :=
  { big_step_ := evalListP }.
Global Instance notation_big_step_expr : notation_big_step Expr Loc :=
  { big_step_ := evalP }.
Global Hint Unfold big_step_: core.
Global Hint Unfold notation_big_step_expr: core.
Global Hint Unfold notation_big_step_list_expr: core.

(* ------------------------------------------------------------------------ *)
(** ** Induction predicate *)

Section evalP_ind.
  (* We define a custom induction predicate *)

  Variable P : forall e σ ρ ψ v σ', (evalP e σ ρ ψ v σ') -> Prop.
  Variable Pl : forall el σ ρ ψ vl σ', (evalListP el σ ρ ψ vl σ') -> Prop.
  Variable Pin : forall C ψ x ρ σ σ', (initP C ψ x ρ σ σ') -> Prop.

  Variable P_var : forall σ x ρ ψ l Hget,
      P (e_var x) σ ρ ψ l σ (bs_var σ x ρ ψ l Hget).

  Variable P_this : forall σ ρ ψ,
      P e_this σ ρ ψ ψ σ (bs_this σ ρ ψ).

  Variable P_fld : forall σ ρ ψ e f v1 σ1 C ω v EH__e0 H__getObj H__getVal
    (IH__e0: P e σ ρ ψ v1 σ1 (EH__e0)),
    P (e_fld e f) σ ρ ψ v σ1 (bs_fld σ ρ ψ e f v1 σ1 C ω v EH__e0 H__getObj H__getVal).

  Variable P_mtd : forall σ e0 m el e2 ρ ψ v1 vl2 v3 σ1 σ2 σ3 C f argsC argsM fields methods T μ H__e0 Hobj H__el Hct Hmth  H__e2
    (IH__e0: P e0 σ ρ ψ v1 σ1 H__e0)
    (IH__el: Pl el σ1 ρ ψ vl2 σ2 H__el)
    (IH__e2: P e2 σ2 vl2 v1 v3 σ3 H__e2),
    P( e_mtd e0 m el) σ ρ ψ v3 σ3 (bs_mtd σ e0 m el e2 ρ ψ v1 vl2 v3 σ1 σ2 σ3 C f argsC argsM fields methods T μ H__e0 Hobj H__el Hct Hmth H__e2).

  Variable P_new : forall σ ρ ψ C args vl__args σ1 σ3 H__args H__init
    (IH__args: Pl args σ ρ ψ vl__args σ1 H__args)
    (IH__init: Pin C (length σ1) 0 vl__args (σ1 ++ [(C, [])]) σ3 H__init),
    P (e_new C args) σ ρ ψ (length σ1) σ3 (bs_new σ ρ ψ C args vl__args σ1 σ3 H__args H__init).

  Variable P_asgn :  forall σ ρ ψ e1 x e2 e' σ1 v1 σ2 v2 σ3 v3 H__e1 H__e2 H__e'
    (IH__e1: P e1 σ ρ ψ v1 σ1 H__e1)
    (IH__e2: P e2 σ1 ρ ψ v2 σ2 H__e2)
    (IH__e': P e' (assign v1 x v2 σ2) ρ ψ v3 σ3 H__e'),
    P (e_asgn e1 x e2 e') σ ρ ψ v3 σ3 (bs_asgn σ ρ ψ e1 x e2 e' σ1 v1 σ2 v2 σ3 v3 H__e1 H__e2 H__e').

  Variable Pl_nil : forall σ ρ ψ, Pl [] σ ρ ψ [] σ (bs_nil σ ρ ψ).

  Variable Pl_cons : forall σ ρ ψ e el v1 σ1 vl σ2 H__e H__el
      (IH__e: P e σ ρ ψ v1 σ1 H__e)
      (IH__el: Pl el σ1 ρ ψ vl σ2 H__el),
      Pl (e::el) σ ρ ψ (v1::vl) σ2 (bs_cons σ ρ ψ e el v1 σ1 vl σ2 H__e H__el).

  Variable Pin_nil: forall C I ρ σ Args Flds Mtds H__ct,
      Pin C I (length Flds) ρ σ σ (init_nil C I ρ σ Args Flds Mtds H__ct).

  Variable Pin_cons : forall C I x ρ σ v T e Args Flds Mtds σ1 σ2 σ3 H__ct H__fld H__e H__assign H__init
      (IH__e: P e σ ρ I v σ1 H__e)
      (IH__init: Pin C I (S x) ρ σ2 σ3 H__init),
      Pin C I x ρ σ σ3 (init_cons C I x ρ σ v T e Args Flds Mtds σ1 σ2 σ3 H__ct H__fld H__e H__assign H__init).

  Fixpoint evalP_ind2 e σ ρ ψ v σ' (eval : evalP e σ ρ ψ v σ') : P e σ ρ ψ v σ' eval :=
    match eval with
    | bs_var σ x ρ ψ v Hget => P_var σ x ρ ψ v Hget
    | bs_this σ ρ ψ => P_this σ ρ ψ
    | bs_fld σ ρ ψ e0 x l1 σ1 C f v1 H__e0 Hobj Hval =>
        P_fld σ ρ ψ e0 x l1 σ1 C f v1 H__e0 Hobj Hval (evalP_ind2 e0 σ ρ ψ l1 σ1 H__e0)
    | bs_mtd σ e0 m el e2 ρ ψ l1 vl2 l3 σ1 σ2 σ3 C f argsC argsM fields methods T μ H__e0 Hobj H__el Hct Hmth H__e2 =>
        P_mtd σ e0 m el e2 ρ ψ l1 vl2 l3 σ1 σ2 σ3 C f argsC argsM fields methods T μ H__e0 Hobj H__el Hct Hmth H__e2
              (evalP_ind2 e0 σ ρ ψ l1 σ1 H__e0)
              (evalListP_ind2 el σ1 ρ ψ vl2 σ2 H__el)
              (evalP_ind2 e2 σ2 vl2 l1 l3 σ3 H__e2)
    | bs_new σ ρ ψ C args vl__args σ1 σ3 H__args H__init =>
        P_new σ ρ ψ C args vl__args σ1 σ3 H__args H__init
              (evalListP_ind2 args σ ρ ψ vl__args σ1 H__args)
              (initP_ind2 C (length σ1) 0 vl__args (σ1 ++ [(C, [])]) σ3 H__init)
    | bs_asgn σ ρ ψ e1 x e2 e' σ1 v1 σ2 v2 σ3 v3 H__e1 H__e2 H__e' =>
        P_asgn σ ρ ψ e1 x e2 e' σ1 v1 σ2 v2 σ3 v3 H__e1 H__e2 H__e'
               (evalP_ind2 e1 σ ρ ψ v1 σ1 H__e1)
               (evalP_ind2 e2 σ1 ρ ψ v2 σ2 H__e2)
               (evalP_ind2 e' (assign v1 x v2 σ2) ρ ψ v3 σ3 H__e')
    end

  with evalListP_ind2 el σ ρ ψ vl σ' evalList : Pl el σ ρ ψ vl σ' evalList :=
         match evalList  with
         | bs_nil σ ρ ψ  => Pl_nil σ ρ ψ
         | bs_cons σ ρ ψ e el l1 σ1 vl σ2 H__e H__el =>
             Pl_cons σ ρ ψ e el l1 σ1 vl σ2 H__e H__el
                     (evalP_ind2 e σ ρ ψ l1 σ1 H__e)
                     (evalListP_ind2 el σ1 ρ ψ vl σ2 H__el)
         end

  with initP_ind2 C ψ x (ρ:Env) (σ σ':Store) H__init: Pin C ψ x ρ σ σ' H__init :=
         match H__init with
         | init_nil C ψ ρ σ Args Flds Mtds H__ct => Pin_nil C ψ ρ σ Args Flds Mtds H__ct
         | init_cons C ψ x ρ σ v T e Args Flds Mtds σ1 σ2 σ3 H__ct H__fld H__e H__assign H__init  =>
             Pin_cons C ψ x ρ σ v T e Args Flds Mtds σ1 σ2 σ3 H__ct H__fld H__e H__assign H__init
                      (evalP_ind2 e σ ρ ψ v σ1 H__e)
                      (initP_ind2 C ψ (S x) ρ σ2 σ3 H__init)
         end.

  Lemma evalP_multi_ind:
    (forall e σ ρ ψ v σ' H__eval, P e σ ρ ψ v σ' H__eval) /\
      (forall el σ ρ ψ vl σ' H__evalList, Pl el σ ρ ψ vl σ' H__evalList) /\
      (forall C ψ x ρ σ σ' H__init, Pin C ψ x ρ σ σ' H__init).
  Proof.
    splits; intros.
    + apply evalP_ind2.
    + apply evalListP_ind2.
    + apply initP_ind2.
  Qed.

End evalP_ind.

(* ------------------------------------------------------------------------ *)
(** ** Conservation result *)
(* The monotonicity on the size of the store is easy to obtain via induction *)

Theorem dom_theorem:
  (forall e σ ρ ψ v σ',
      ⟦e⟧ (σ, ρ, ψ) --> (v, σ') -> dom σ <= dom σ') /\
    ( forall el σ ρ ψ vl σ',
        ⟦_ el _⟧p (σ, ρ, ψ) --> (vl, σ') -> dom σ <= dom σ') /\
    ( forall C ψ x ρ σ σ',
        initP C ψ x ρ σ σ' -> dom σ <= dom σ').
Proof.
  eapply evalP_multi_ind;
    unfold assign, assign_new;
    steps; updates; try lia.
Qed.

Corollary evalP_dom:
  forall e σ ρ ψ v σ',
      ⟦e⟧ (σ, ρ, ψ) --> (v, σ') -> dom σ <= dom σ'.
Proof.
  apply dom_theorem.
Qed.

Corollary evalListP_dom:
   forall el σ ρ ψ vl σ',
      ⟦_ el _⟧p (σ, ρ, ψ) --> (vl, σ') -> dom σ <= dom σ'.
Proof.
  apply dom_theorem.
Qed.

Corollary initP_dom:
  forall C ψ x ρ σ σ',
      initP C ψ x ρ σ σ' -> dom σ <= dom σ'.
Proof.
  apply dom_theorem.
Qed.

Lemma init_field:
  forall C ψ x ρ σ σ' Args Flds Mtds,
    ct C = class Args Flds Mtds ->
    initP C ψ x ρ σ σ' ->
    x <= length Flds.
Proof.
  intros. move: Args Flds Mtds H.
  induction H0; intros; cross_rewrites => //.
  apply IHinitP in H. lia.
Qed.

Ltac eval_dom :=
  repeat match goal with
         | H: ⟦ ?e ⟧p (?σ, ?ρ, ?ψ) --> (?v, ?σ') |- _ =>
             let fresh := fresh "H_dom" in
             add_hypothesis fresh (evalP_dom e σ ρ ψ v σ' H)
         | H: ⟦_ ?el _⟧p (?σ, ?ρ, ?ψ) --> (?vl, ?σ') |- _ =>
             let fresh := fresh "H_dom" in
             add_hypothesis fresh (evalListP_dom el σ ρ ψ vl σ' H)
         | H: ⟦ ?e ⟧ (?σ, ?ρ, ?ψ) --> (?v, ?σ') |- _ =>
             let fresh := fresh "H_dom" in
             add_hypothesis fresh (evalP_dom e σ ρ ψ v σ' H)
         | H: ⟦?el ⟧ (?σ, ?ρ, ?ψ) --> (?vl, ?σ') |- _ =>
             let fresh := fresh "H_dom" in
             add_hypothesis fresh (evalListP_dom el σ ρ ψ vl σ' H)
         | H: initP ?C ?ψ ?x ?ρ ?σ ?σ' |- _ =>
             let fresh := fresh "H_dom" in
             add_hypothesis fresh (initP_dom C ψ x ρ σ σ' H)
         end.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable tPROGRAM_ : Universe -> Prop.
Variable tOr_72_ : Universe -> Universe -> Universe -> Prop.
Variable tOr_65_ : Universe -> Universe -> Universe -> Prop.
Variable tOr_50_ : Universe -> Universe -> Universe -> Prop.
Variable tOr_46_ : Universe -> Universe -> Universe -> Prop.
Variable tOr_26_ : Universe -> Prop.
Variable tOr_15_ : Universe -> Universe -> Prop.
Variable tOUTPUTS_ : Universe -> Universe -> Prop.
Variable tHALTS3_ : Universe -> Universe -> Universe -> Prop.
Variable tHALTS2_ : Universe -> Universe -> Prop.
Variable tForall_76_ : Universe -> Universe -> Prop.
Variable tForall_54_ : Universe -> Prop.
Variable tForall_28_ : Prop.
Variable tForall_17_ : Universe -> Prop.
Variable tExists_40_ : Universe -> Universe -> Prop.
Variable tExists_22_ : Universe -> Universe -> Prop.
Variable tDECIDES_ : Universe -> Universe -> Universe -> Prop.
Variable tAnd_74_ : Universe -> Universe -> Universe -> Prop.
Variable tAnd_70_ : Universe -> Universe -> Prop.
Variable tAnd_63_ : Universe -> Universe -> Universe -> Prop.
Variable tAnd_59_ : Universe -> Universe -> Universe -> Prop.
Variable tAnd_52_ : Universe -> Universe -> Universe -> Prop.
Variable tAnd_48_ : Universe -> Universe -> Universe -> Prop.
Variable tAnd_44_ : Universe -> Universe -> Universe -> Prop.
Variable tAnd_36_ : Universe -> Prop.
Variable tAnd_19_ : Universe -> Prop.
Variable tALGORITHM_ : Universe -> Prop.
Variable goal_ : Prop.
Variable fPROGRAM_ : Universe -> Prop.
Variable fOr_69_ : Universe -> Universe -> Universe -> Prop.
Variable fOr_62_ : Universe -> Universe -> Universe -> Prop.
Variable fOr_58_ : Universe -> Universe -> Universe -> Prop.
Variable fOr_33_ : Universe -> Universe -> Prop.
Variable fOUTPUTS_ : Universe -> Universe -> Prop.
Variable fHALTS3_ : Universe -> Universe -> Universe -> Prop.
Variable fHALTS2_ : Universe -> Universe -> Prop.
Variable fForall_35_ : Universe -> Prop.
Variable fForall_31_ : Universe -> Universe -> Prop.
Variable fForall_14_ : Universe -> Universe -> Prop.
Variable fDECIDES_ : Universe -> Universe -> Universe -> Prop.
Variable fALGORITHM_ : Universe -> Prop.
Variable dom_ : Universe -> Prop.

Variable good_ : Universe.
Variable bad_ : Universe.

Variable initial_model_1 : (dom_ good_ /\ (dom_ bad_ /\ (dom_ X1 /\ (tAnd_19_ X1 /\ tForall_17_ X1)))).
Variable botALGORITHM_2 : (forall V1 : Universe, ((tALGORITHM_ V1 /\ fALGORITHM_ V1) -> goal_)).
Variable botDECIDES_3 : (forall V1 V2 V3 : Universe, ((tDECIDES_ V1 V2 V3 /\ fDECIDES_ V1 V2 V3) -> goal_)).
Variable botPROGRAM_4 : (forall V1 : Universe, ((tPROGRAM_ V1 /\ fPROGRAM_ V1) -> goal_)).
Variable botHALTS3_5 : (forall V1 V2 V3 : Universe, ((tHALTS3_ V1 V2 V3 /\ fHALTS3_ V1 V2 V3) -> goal_)).
Variable botHALTS2_6 : (forall V1 V2 : Universe, ((tHALTS2_ V1 V2 /\ fHALTS2_ V1 V2) -> goal_)).
Variable botOUTPUTS_7 : (forall V1 V2 : Universe, ((tOUTPUTS_ V1 V2 /\ fOUTPUTS_ V1 V2) -> goal_)).
Variable ax00_8 : (forall X1 : Universe, ((tAnd_19_ X1 /\ fALGORITHM_ X1) -> goal_)).
Variable ax01_9 : (forall X1 Y1 : Universe, ((tOr_15_ X1 Y1 /\ (tPROGRAM_ Y1 /\ fForall_14_ X1 Y1)) -> goal_)).
Variable ax02_10 : (forall W : Universe, ((tAnd_36_ W /\ fForall_35_ W) -> goal_)).
Variable ax03_11 : (forall Y Z W : Universe, ((tAnd_44_ Y Z W /\ fOUTPUTS_ W good_) -> goal_)).
Variable ax04_12 : (forall Y Z W : Universe, ((tAnd_48_ Y Z W /\ fOUTPUTS_ W bad_) -> goal_)).
Variable ax05_13 : (forall Y Z W : Universe, ((tAnd_59_ Y Z W /\ fOr_58_ Y Z W) -> goal_)).
Variable ax06_14 : (forall Y Z W : Universe, ((tAnd_63_ Y Z W /\ tHALTS2_ Y Z) -> goal_)).
Variable ax07_15 : (forall Y Z W : Universe, ((tAnd_63_ Y Z W /\ fOr_62_ Y Z W) -> goal_)).
Variable ax08_16 : (forall W Y V : Universe, ((tAnd_74_ W Y V /\ fOr_69_ W V Y) -> goal_)).
Variable ax09_17 : (forall Y V : Universe, ((tAnd_70_ Y V /\ fOUTPUTS_ V bad_) -> goal_)).
Variable ax10_18 : (forall Y1 X1 : Universe, ((dom_ Y1 /\ tForall_17_ X1) -> tOr_15_ X1 Y1)).
Variable ax11_19 : (forall X1 Y1 Z1 : Universe, (fDECIDES_ X1 Y1 Z1 -> fForall_14_ X1 Y1)).
Variable ax12_20 : (forall X : Universe, ((dom_ X /\ tForall_28_) -> tOr_26_ X)).
Variable ax13_21 : (forall W Y : Universe, (fOr_33_ W Y -> fForall_35_ W)).
Variable ax14_22 : (forall Y W : Universe, ((tPROGRAM_ Y /\ fForall_31_ W Y) -> fOr_33_ W Y)).
Variable ax15_23 : (forall W Y Z : Universe, (fDECIDES_ W Y Z -> fForall_31_ W Y)).
Variable ax16_24 : (forall Y Z W : Universe, ((dom_ Y /\ (dom_ Z /\ tForall_54_ W)) -> tAnd_52_ Y Z W)).
Variable ax17_25 : (forall Y Z W : Universe, (tAnd_52_ Y Z W -> (tOr_46_ Y Z W /\ tOr_50_ Y Z W))).
Variable ax18_26 : (forall Y Z W : Universe, ((tOr_46_ Y Z W /\ (tPROGRAM_ Y /\ tHALTS2_ Y Z)) -> (tAnd_44_ Y Z W /\ tHALTS3_ W Y Z))).
Variable ax19_27 : (forall Y W V : Universe, ((dom_ Y /\ tForall_76_ W V) -> tAnd_74_ W Y V)).
Variable ax20_28 : (forall W Y V : Universe, (tAnd_74_ W Y V -> tOr_72_ W Y V)).
Variable ax21_29 : (forall Y Z W : Universe, ((tOr_50_ Y Z W /\ tPROGRAM_ Y) -> (tHALTS2_ Y Z \/ (tAnd_48_ Y Z W /\ tHALTS3_ W Y Z)))).
Variable ax22_30 : (forall Y Z W : Universe, (tOr_65_ Y Z W -> ((tAnd_59_ Y Z W /\ (tPROGRAM_ Y /\ tHALTS2_ Y Z)) \/ (tAnd_63_ Y Z W /\ tPROGRAM_ Y)))).
Variable ax23_31 : (forall W Y Z : Universe, (tHALTS3_ W Y Z -> (fOr_58_ Y Z W \/ fOUTPUTS_ W good_))).
Variable ax24_32 : (forall W Y Z : Universe, (tHALTS3_ W Y Z -> (fOr_62_ Y Z W \/ fOUTPUTS_ W bad_))).
Variable ax25_33 : (forall Y W V : Universe, ((tPROGRAM_ Y /\ (tHALTS3_ W Y Y /\ tHALTS2_ V Y)) -> (fOr_69_ W V Y \/ fOUTPUTS_ W good_))).
Variable ax26_34 : (forall W Y V : Universe, ((tOr_72_ W Y V /\ (tPROGRAM_ Y /\ tHALTS3_ W Y Y)) -> (fOUTPUTS_ W bad_ \/ (tAnd_70_ Y V /\ tHALTS2_ V Y)))).
Variable ax28_35 : (forall X Y : Universe, (tExists_22_ X Y -> (exists Z : Universe, (dom_ Z /\ fDECIDES_ X Y Z)))).
Variable ax29_36 : (forall W Y : Universe, (tExists_40_ W Y -> (exists Z : Universe, (dom_ Z /\ fDECIDES_ W Y Z)))).
Variable ax30_37 : (True -> ((exists W : Universe, tForall_28_) \/ (dom_ W /\ (tAnd_36_ W /\ tPROGRAM_ W)))).
Variable ax31_38 : (forall X : Universe, (tOr_26_ X -> (exists Y : Universe, (fALGORITHM_ X \/ (dom_ Y /\ (tPROGRAM_ Y /\ tExists_22_ X Y)))))).
Variable ax32_39 : (forall W : Universe, (tPROGRAM_ W -> ((exists Y : Universe, (dom_ Y /\ (tPROGRAM_ Y /\ tExists_40_ W Y))) \/ tForall_54_ W))).
Variable ax33_40 : (forall W : Universe, (tPROGRAM_ W -> ((exists Y Z V : Universe, (dom_ Y /\ (dom_ Z /\ tOr_65_ Y Z W))) \/ (dom_ V /\ (tPROGRAM_ V /\ tForall_76_ W V))))).

Theorem hpbf2_41 : goal_.
Proof.
  time tac.
Qed.

End FOFProblem.