(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** Recognition of tail calls: correctness proof *)

Require Import Coqlib Maps Integers AST Linking.
Require Import Values Memory Events Globalenvs Smallstep.
Require Import Op Registers RTL Conventions Tailcall.
Require Import sflib.

(** * Syntactic properties of the code transformation *)

(** ** Measuring the number of instructions eliminated *)

(** The [return_measure c pc] function counts the number of instructions
  eliminated by the code transformation, where [pc] is the successor
  of a call turned into a tailcall.  This is the length of the
  move/nop/return sequence recognized by the [is_return] boolean function.
*)

Fixpoint return_measure_rec (n: nat) (c: code) (pc: node)
                            {struct n}: nat :=
  match n with
  | O => O
  | S n' =>
      match c!pc with
      | Some(Inop s) => S(return_measure_rec n' c s)
      | Some(Iop op args dst s) => S(return_measure_rec n' c s)
      | _ => O
      end
  end.

Definition return_measure (c: code) (pc: node) :=
  return_measure_rec niter c pc.

Lemma return_measure_bounds:
  forall f pc, (return_measure f pc <= niter)%nat.
Proof.
  intro f.
  assert (forall n pc, (return_measure_rec n f pc <= n)%nat).
    induction n; intros; simpl.
    omega.
    destruct (f!pc); try omega.
    destruct i; try omega.
    generalize (IHn n0). omega.
    generalize (IHn n0). omega.
  intros. unfold return_measure. apply H.
Qed.

Remark return_measure_rec_incr:
  forall f n1 n2 pc,
  (n1 <= n2)%nat ->
  (return_measure_rec n1 f pc <= return_measure_rec n2 f pc)%nat.
Proof.
  induction n1; intros; simpl.
  omega.
  destruct n2. omegaContradiction. assert (n1 <= n2)%nat by omega.
  simpl. destruct f!pc; try omega. destruct i; try omega.
  generalize (IHn1 n2 n H0). omega.
  generalize (IHn1 n2 n H0). omega.
Qed.

Lemma is_return_measure_rec:
  forall f n n' pc r,
  is_return n f pc r = true -> (n <= n')%nat ->
  return_measure_rec n f.(fn_code) pc = return_measure_rec n' f.(fn_code) pc.
Proof.
  induction n; simpl; intros.
  congruence.
  destruct n'. omegaContradiction. simpl.
  destruct (fn_code f)!pc; try congruence.
  destruct i; try congruence.
  decEq. apply IHn with r. auto. omega.
  destruct (is_move_operation o l); try congruence.
  destruct (Reg.eq r r1); try congruence.
  decEq. apply IHn with r0. auto. omega.
Qed.

(** ** Relational characterization of the code transformation *)

(** The [is_return_spec] characterizes the instruction sequences
  recognized by the [is_return] boolean function.  *)

Inductive is_return_spec (f:function): node -> reg -> Prop :=
  | is_return_none: forall pc r,
      f.(fn_code)!pc = Some(Ireturn None) ->
      is_return_spec f pc r
  | is_return_some: forall pc r,
      f.(fn_code)!pc = Some(Ireturn (Some r)) ->
      is_return_spec f pc r
  | is_return_nop: forall pc r s,
      f.(fn_code)!pc = Some(Inop s) ->
      is_return_spec f s r ->
      (return_measure f.(fn_code) s < return_measure f.(fn_code) pc)%nat ->
      is_return_spec f pc r
  | is_return_move: forall pc r r' s,
      f.(fn_code)!pc = Some(Iop Omove (r::nil) r' s) ->
      is_return_spec f s r' ->
      (return_measure f.(fn_code) s < return_measure f.(fn_code) pc)%nat ->
     is_return_spec f pc r.

Lemma is_return_charact:
  forall f n pc rret,
  is_return n f pc rret = true -> (n <= niter)%nat ->
  is_return_spec f pc rret.
Proof.
  induction n; intros.
  simpl in H. congruence.
  generalize H. simpl.
  caseEq ((fn_code f)!pc); try congruence.
  intro i. caseEq i; try congruence.
  intros s; intros. eapply is_return_nop; eauto. eapply IHn; eauto. omega.
  unfold return_measure.
  rewrite <- (is_return_measure_rec f (S n) niter pc rret); auto.
  rewrite <- (is_return_measure_rec f n niter s rret); auto.
  simpl. rewrite H2. omega. omega.

  intros op args dst s EQ1 EQ2.
  caseEq (is_move_operation op args); try congruence.
  intros src IMO. destruct (Reg.eq rret src); try congruence.
  subst rret. intro.
  exploit is_move_operation_correct; eauto. intros [A B]. subst.
  eapply is_return_move; eauto. eapply IHn; eauto. omega.
  unfold return_measure.
  rewrite <- (is_return_measure_rec f (S n) niter pc src); auto.
  rewrite <- (is_return_measure_rec f n niter s dst); auto.
  simpl. rewrite EQ2. omega. omega.

  intros or EQ1 EQ2. destruct or; intros.
  assert (r = rret). eapply proj_sumbool_true; eauto. subst r.
  apply is_return_some; auto.
  apply is_return_none; auto.
Qed.

(** The [transf_instr_spec] predicate relates one instruction in the
  initial code with its possible transformations in the optimized code. *)

Inductive transf_instr_spec (f: function): instruction -> instruction -> Prop :=
  | transf_instr_tailcall: forall sig ros args res s,
      f.(fn_stacksize) = 0 ->
      is_return_spec f s res ->
      transf_instr_spec f (Icall sig ros args res s) (Itailcall sig ros args)
  | transf_instr_default: forall i,
      transf_instr_spec f i i.

Lemma transf_instr_charact:
  forall f pc instr,
  f.(fn_stacksize) = 0 ->
  transf_instr_spec f instr (transf_instr f pc instr).
Proof.
  intros. unfold transf_instr. destruct instr; try constructor.
  caseEq (is_return niter f n r && tailcall_is_possible s &&
          opt_typ_eq (sig_res s) (sig_res (fn_sig f))); intros.
  destruct (andb_prop _ _ H0). destruct (andb_prop _ _ H1).
  eapply transf_instr_tailcall; eauto.
  eapply is_return_charact; eauto.
  constructor.
Qed.

Lemma transf_instr_lookup:
  forall f pc i,
  f.(fn_code)!pc = Some i ->
  exists i',  (transf_function f).(fn_code)!pc = Some i' /\ transf_instr_spec f i i'.
Proof.
  intros. unfold transf_function.
  destruct (zeq (fn_stacksize f) 0).
  simpl. rewrite PTree.gmap. rewrite H. simpl.
  exists (transf_instr f pc i); split. auto. apply transf_instr_charact; auto.
  exists i; split. auto. constructor.
Qed.

(** * Semantic properties of the code transformation *)

(** ** The ``less defined than'' relation between register states *)

(** A call followed by a return without an argument can be turned
  into a tail call.  In this case, the original function returns
  [Vundef], while the transformed function can return any value.
  We account for this situation by using the ``less defined than''
  relation between values and between memory states.  We need to
  extend it pointwise to register states. *)

Lemma regs_lessdef_init_regs:
  forall params vl vl',
  Val.lessdef_list vl vl' ->
  regs_lessdef (init_regs vl params) (init_regs vl' params).
Proof.
  induction params; intros.
  simpl. red; intros. rewrite Regmap.gi. constructor.
  simpl. inv H.   red; intros. rewrite Regmap.gi. constructor.
  apply set_reg_lessdef. auto. auto.
Qed.

(** * Proof of semantic preservation *)

Definition match_prog (p tp: RTL.program) :=
  match_program (fun cu f tf => tf = transf_fundef f) eq p tp.

Lemma transf_program_match:
  forall p, match_prog p (transf_program p).
Proof.
  intros. apply match_transform_program; auto.
Qed.

Section PRESERVATION.

Variable prog tprog: program.
Hypothesis TRANSL: match_prog prog tprog.

Section CORELEMMA.

Variable se tse: Senv.t.
Hypothesis (MATCH_SENV: Senv.equiv se tse).
Variable ge tge: genv.

Hypothesis (MATCH_GENV: Genv.match_genvs (match_globdef (fun cu f tf => tf = transf_fundef f) eq prog) ge tge).

Lemma symbols_preserved:
  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
Proof (Genv.find_symbol_transf_genv MATCH_GENV).

Lemma functions_translated:
  forall (v: val) (f: RTL.fundef),
  Genv.find_funct ge v = Some f ->
  Genv.find_funct tge v = Some (transf_fundef f).
Proof (Genv.find_funct_transf_genv MATCH_GENV).

Lemma funct_ptr_translated:
  forall (b: block) (f: RTL.fundef),
  Genv.find_funct_ptr ge b = Some f ->
  Genv.find_funct_ptr tge b = Some (transf_fundef f).
Proof (Genv.find_funct_ptr_transf_genv MATCH_GENV).

Lemma senv_preserved:
  Senv.equiv ge tge.
Proof (Genv.senv_transf_genv MATCH_GENV).

Lemma sig_preserved:
  forall f, (transf_function f).(fn_sig) = f.(fn_sig).
Proof.
  intro. simpl. unfold transf_function.
  destruct (zeq (fn_stacksize f) 0); auto.
Qed.

Lemma stacksize_preserved:
  forall f, fn_stacksize (transf_function f) = fn_stacksize f.
Proof.
  unfold transf_function. intros.
  destruct (zeq (fn_stacksize f) 0); auto.
Qed.

Lemma find_function_ptr_translated:
  forall ros rs rs' fptr,
  find_function_ptr ge ros rs = fptr ->
  regs_lessdef rs rs' ->
  exists tfptr, <<FPTR: find_function_ptr tge ros rs' = tfptr>> /\ <<FPTRREL: Val.lessdef fptr tfptr>>.
Proof.
  i. unfold find_function_ptr in *.
  des_ifs; try erewrite symbols_preserved in *; clarify; esplits; eauto.
Qed.

Lemma find_funct_lessdef
      fptr tfptr f
      (FPTR: Genv.find_funct ge fptr = Some f)
      (LD: Val.lessdef fptr tfptr):
    <<EQ: fptr = tfptr>>.
Proof. exploit Genv.find_funct_inv; eauto. i; des. clarify. inv LD; ss. Qed.

(** Consider an execution of a call/move/nop/return sequence in the
  original code and the corresponding tailcall in the transformed code.
  The transition sequences are of the following form
  (left: original code, right: transformed code).
  [f] is the calling function and [fd] the called function.
<<
     State stk f (Icall instruction)       State stk' f' (Itailcall)

     Callstate (frame::stk) fd args        Callstate stk' fd' args'
            .                                       .
            .                                       .
            .                                       .
     Returnstate (frame::stk) res          Returnstate stk' res'

     State stk f (move/nop/return seq)
            .
            .
            .
     State stk f (return instr)

     Returnstate stk res
>>
The simulation invariant must therefore account for two kinds of
mismatches between the transition sequences:
- The call stack of the original program can contain more frames
  than that of the transformed program (e.g. [frame] in the example above).
- The regular states corresponding to executing the move/nop/return
  sequence must all correspond to the single [Returnstate stk' res']
  state of the transformed program.

We first define the simulation invariant between call stacks.
The first two cases are standard, but the third case corresponds
to a frame that was eliminated by the transformation. *)

Inductive match_stackframes: list stackframe -> list stackframe -> Prop :=
  | match_stackframes_nil:
      match_stackframes nil nil
  | match_stackframes_normal: forall stk stk' res sp pc rs rs' f,
      match_stackframes stk stk' ->
      regs_lessdef rs rs' ->
      match_stackframes
        (Stackframe res f (Vptr sp Ptrofs.zero) pc rs :: stk)
        (Stackframe res (transf_function f) (Vptr sp Ptrofs.zero) pc rs' :: stk')
  | match_stackframes_tail: forall stk stk' res sp pc rs f,
      match_stackframes stk stk' ->
      is_return_spec f pc res ->
      f.(fn_stacksize) = 0 ->
      match_stackframes
        (Stackframe res f (Vptr sp Ptrofs.zero) pc rs :: stk)
        stk'.

(** Here is the invariant relating two states.  The first three
  cases are standard.  Note the ``less defined than'' conditions
  over values and register states, and the corresponding ``extends''
  relation over memory states. *)

Inductive match_states: state -> state -> Prop :=
  | match_states_normal:
      forall s sp pc rs m s' rs' m' f
             (STACKS: match_stackframes s s')
             (RLD: regs_lessdef rs rs')
             (MLD: Mem.extends m m'),
      match_states (State s f (Vptr sp Ptrofs.zero) pc rs m)
                   (State s' (transf_function f) (Vptr sp Ptrofs.zero) pc rs' m')
  | match_states_call:
      forall s fptr tfptr args m s' args' m' sg
      (FPTR: Val.lessdef fptr tfptr),
      match_stackframes s s' ->
      Val.lessdef_list args args' ->
      Mem.extends m m' ->
      match_states (Callstate s fptr sg args m)
                   (Callstate s' tfptr sg args' m')
  | match_states_return:
      forall s v m s' v' m',
      match_stackframes s s' ->
      Val.lessdef v v' ->
      Mem.extends m m' ->
      match_states (Returnstate s v m)
                   (Returnstate s' v' m')
  | match_states_interm:
      forall s sp pc rs m s' m' f r v'
             (STACKS: match_stackframes s s')
             (MLD: Mem.extends m m'),
      is_return_spec f pc r ->
      f.(fn_stacksize) = 0 ->
      Val.lessdef (rs#r) v' ->
      match_states (State s f (Vptr sp Ptrofs.zero) pc rs m)
                   (Returnstate s' v' m').

(** The last case of [match_states] corresponds to the execution
  of a move/nop/return sequence in the original code that was
  eliminated by the transformation:
<<
     State stk f (move/nop/return seq)  ~~  Returnstate stk' res'
            .
            .
            .
     State stk f (return instr)         ~~  Returnstate stk' res'
>>
  To preserve non-terminating behaviors, we need to make sure
  that the execution of this sequence in the original code cannot
  diverge.  For this, we introduce the following complicated
  measure over states, which will decrease strictly whenever
  the original code makes a transition but the transformed code
  does not. *)

Definition measure (st: state) : nat :=
  match st with
  | State s f sp pc rs m => (List.length s * (niter + 2) + return_measure f.(fn_code) pc + 1)%nat
  | Callstate _ _ _ _ _ => 0%nat
  | Returnstate s v m => (List.length s * (niter + 2))%nat
  end.

Ltac TransfInstr :=
  match goal with
  | H: (PTree.get _ (fn_code _) = _) |- _ =>
      destruct (transf_instr_lookup _ _ _ H) as [i' [TINSTR TSPEC]]; inv TSPEC
  end.

Ltac EliminatedInstr :=
  match goal with
  | H: (is_return_spec _ _ _) |- _ => inv H; try congruence
  | _ => idtac
  end.

(** The proof of semantic preservation, then, is a simulation diagram
  of the ``option'' kind. *)

Lemma transf_step_correct:
  forall s1 t s2, step se ge s1 t s2 ->
  forall s1' (MS: match_states s1 s1'),
  (exists s2', step tse tge s1' t s2' /\ match_states s2 s2')
  \/ (measure s2 < measure s1 /\ t = E0 /\ match_states s2 s1')%nat.
Proof.
  induction 1; intros; inv MS; EliminatedInstr.

- (* nop *)
  TransfInstr. left. econstructor; split.
  eapply exec_Inop; eauto. constructor; auto.
- (* eliminated nop *)
  assert (s0 = pc') by congruence. subst s0.
  right. split. simpl. omega. split. auto.
  econstructor; eauto.

- (* op *)
  TransfInstr.
  assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto.
  exploit eval_operation_lessdef; eauto.
  intros [v' [EVAL' VLD]].
  left. exists (State s' (transf_function f) (Vptr sp0 Ptrofs.zero) pc' (rs'#res <- v') m'); split.
  eapply exec_Iop; eauto.  rewrite <- EVAL'.
  apply eval_operation_preserved. exact symbols_preserved.
  econstructor; eauto. apply set_reg_lessdef; auto.
- (* eliminated move *)
  rewrite H1 in H. clear H1. inv H.
  right. split. simpl. omega. split. auto.
  econstructor; eauto. simpl in H0. rewrite PMap.gss. congruence.

- (* load *)
  TransfInstr.
  assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto.
  exploit eval_addressing_lessdef; eauto.
  intros [a' [ADDR' ALD]].
  exploit Mem.loadv_extends; eauto.
  intros [v' [LOAD' VLD]].
  left. exists (State s' (transf_function f) (Vptr sp0 Ptrofs.zero) pc' (rs'#dst <- v') m'); split.
  eapply exec_Iload with (a := a'). eauto.  rewrite <- ADDR'.
  apply eval_addressing_preserved. exact symbols_preserved. eauto.
  econstructor; eauto. apply set_reg_lessdef; auto.

- (* store *)
  TransfInstr.
  assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto.
  exploit eval_addressing_lessdef; eauto.
  intros [a' [ADDR' ALD]].
  exploit Mem.storev_extends. 2: eexact H1. eauto. eauto. apply RLD.
  intros [m'1 [STORE' MLD']].
  left. exists (State s' (transf_function f) (Vptr sp0 Ptrofs.zero) pc' rs' m'1); split.
  eapply exec_Istore with (a := a'). eauto.  rewrite <- ADDR'.
  apply eval_addressing_preserved. exact symbols_preserved. eauto.
  destruct a; simpl in H1; try discriminate.
  econstructor; eauto.

- (* call *)
  clear H1. exploit find_function_ptr_translated; eauto. i; des.
  TransfInstr.
+ (* call turned tailcall *)
  assert ({ m'' | Mem.free m' sp0 0 (fn_stacksize (transf_function f)) = Some m''}).
    apply Mem.range_perm_free. rewrite stacksize_preserved. rewrite H7.
    red; intros; omegaContradiction.
  destruct X as [m'' FREE].
  left. eexists (Callstate s' _ _ (rs'##args) m''); split.
  eapply exec_Itailcall; eauto. constructor.
  constructor. inversion FPTR. eauto. eapply match_stackframes_tail; eauto. apply regs_lessdef_regs; auto.
  eapply Mem.free_right_extends; eauto.
  rewrite stacksize_preserved. rewrite H7. intros. omegaContradiction.
+ (* call that remains a call *)
  left. eexists (Callstate (Stackframe res (transf_function f) (Vptr sp0 Ptrofs.zero) pc' rs' :: s')
                          _ _ (rs'##args) m'); split.
  eapply exec_Icall; eauto. constructor.
  constructor. inversion FPTR. eauto. constructor; auto. apply regs_lessdef_regs; auto. auto.

- (* tailcall *)
  exploit find_function_ptr_translated; eauto. i; des.
  exploit Mem.free_parallel_extends; eauto. intros [m'1 [FREE EXT]].
  TransfInstr.
  left. eexists (Callstate s' _ _ (rs'##args) m'1); split.
  eapply exec_Itailcall; eauto. constructor.
  rewrite stacksize_preserved; auto.
  constructor. inversion FPTR. eauto. auto. apply regs_lessdef_regs; auto. auto.

- (* builtin *)
  TransfInstr.
  exploit (@eval_builtin_args_lessdef _ ge (fun r => rs#r) (fun r => rs'#r)); eauto.
  intros (vargs' & P & Q).
  exploit external_call_mem_extends; eauto.
  intros [v' [m'1 [A [B [C D]]]]].
  left. exists (State s' (transf_function f) (Vptr sp0 Ptrofs.zero) pc' (regmap_setres res v' rs') m'1); split.
  eapply exec_Ibuiltin; eauto.
  eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
  eapply external_call_symbols_preserved; eauto.
  econstructor; eauto. apply set_res_lessdef; auto.

- (* cond *)
  TransfInstr.
  left. exists (State s' (transf_function f) (Vptr sp0 Ptrofs.zero) (if b then ifso else ifnot) rs' m'); split.
  eapply exec_Icond; eauto.
  apply eval_condition_lessdef with (rs##args) m; auto. apply regs_lessdef_regs; auto.
  constructor; auto.

- (* jumptable *)
  TransfInstr.
  left. exists (State s' (transf_function f) (Vptr sp0 Ptrofs.zero) pc' rs' m'); split.
  eapply exec_Ijumptable; eauto.
  generalize (RLD arg). rewrite H0. intro. inv H2. auto.
  constructor; auto.

- (* return *)
  exploit Mem.free_parallel_extends; eauto. intros [m'1 [FREE EXT]].
  TransfInstr.
  left. exists (Returnstate s' (regmap_optget or Vundef rs') m'1); split.
  apply exec_Ireturn; auto. rewrite stacksize_preserved; auto.
  constructor; auto.
  destruct or; simpl. apply RLD. constructor.

- (* eliminated return None *)
  assert (or = None) by congruence. subst or.
  right. split. simpl. omega. split. auto.
  constructor. auto.
  simpl. constructor.
  eapply Mem.free_left_extends; eauto.

- (* eliminated return Some *)
  assert (or = Some r) by congruence. subst or.
  right. split. simpl. omega. split. auto.
  constructor. auto.
  simpl. auto.
  eapply Mem.free_left_extends; eauto.

- (* internal call *)
  exploit functions_translated; eauto. intro TFPTR. simpl in TFPTR.
  eapply find_funct_lessdef in FPTR0; eauto. des. subst tfptr.
  exploit Mem.alloc_extends; eauto.
    instantiate (1 := 0). omega.
    instantiate (1 := fn_stacksize f). omega.
  intros [m'1 [ALLOC EXT]].
  assert (fn_stacksize (transf_function f) = fn_stacksize f /\
          fn_entrypoint (transf_function f) = fn_entrypoint f /\
          fn_params (transf_function f) = fn_params f).
    unfold transf_function. destruct (zeq (fn_stacksize f) 0); auto.
  destruct H0 as [EQ1 [EQ2 EQ3]].
  left. econstructor; split.
  simpl. erewrite <- sig_preserved. eapply exec_function_internal; eauto. rewrite EQ1; eauto.
  rewrite EQ2. rewrite EQ3. constructor; auto.
  apply regs_lessdef_init_regs. auto.

- (* external call *)
  exploit functions_translated; eauto. intro TFPTR. simpl in TFPTR.
  eapply find_funct_lessdef in FPTR0; eauto. des. subst tfptr.
  exploit external_call_mem_extends; eauto.
  intros [res' [m2' [A [B [C D]]]]].
  left. exists (Returnstate s' res' m2'); split.
  simpl. econstructor; eauto.
  eapply external_call_symbols_preserved; eauto.
  constructor; auto.

- (* returnstate *)
  inv H2.
+ (* synchronous return in both programs *)
  left. econstructor; split.
  apply exec_return.
  constructor; auto. apply set_reg_lessdef; auto.
+ (* return instr in source program, eliminated because of tailcall *)
  right. split. unfold measure. simpl length.
  change (S (length s) * (niter + 2))%nat
   with ((niter + 2) + (length s) * (niter + 2))%nat.
  generalize (return_measure_bounds (fn_code f) pc). omega.
  split. auto.
  econstructor; eauto.
  rewrite Regmap.gss. auto.
Qed.

End CORELEMMA.

Section WHOLE.

Let ge := Genv.globalenv prog.
Let tge := Genv.globalenv tprog.

Let MATCH_GENV: Genv.match_genvs (match_globdef (fun cu f tf => tf = transf_fundef f) eq prog) ge tge.
Proof. apply Genv.globalenvs_match; eauto. Qed.

Lemma transf_initial_states:
  forall st1, initial_state prog st1 ->
  exists st2, initial_state tprog st2 /\ match_states st1 st2.
Proof.
  intros. inv H.
  eexists (Callstate nil _ _ nil m0); split.
  econstructor; eauto. apply (Genv.init_mem_transf TRANSL). auto.
  replace (prog_main tprog) with (prog_main prog).
  erewrite symbols_preserved; eauto.
  symmetry; eapply match_program_main; eauto.
  constructor. constructor. constructor. constructor. apply Mem.extends_refl.
Qed.

Lemma transf_final_states:
  forall st1 st2 r,
  match_states st1 st2 -> final_state st1 r -> final_state st2 r.
Proof.
  intros. inv H0. inv H. inv H5. inv H3. constructor.
Qed.

(** The preservation of the observable behavior of the program then
  follows. *)

Theorem transf_program_correct:
  forward_simulation (RTL.semantics prog) (RTL.semantics tprog).
Proof.
  eapply forward_simulation_opt with (measure := measure); eauto.
  apply senv_preserved; auto.
  eexact transf_initial_states.
  eexact transf_final_states.
  apply transf_step_correct; auto. eapply (Genv.senv_match TRANSL); eauto.
Qed.

End WHOLE.

End PRESERVATION.


Set Implicit Arguments.

Require Import Bedrock.Platform.Cito.examples.FiniteSet.

Import Memory.

Inductive ADTValue :=
| Cell : W -> ADTValue
| Arr : list W -> ADTValue
| FSet : WordSet.t -> ADTValue.

Require Import Bedrock.Platform.Cito.ADT.

Module ExampleADT <: ADT.

  Definition ADTValue := ADTValue.

End ExampleADT.


Require Import JMeq.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Classical.

Require Import foltl.
Require Import set.
Require Import dec.
Require Import finite.
Require Import varset.
Require Import vars.

(*
associer a un predicat p de la signature une liste de predicats g de meme arite

g => (p <-> X p)

conditions du cadre remplacees par I => X I

on doit avoir condition du cadre ==> I stable

==> correction de la cond syntaxique

hyp: r(xi) --> phi(xi)

*)

Section Stability.
  Context {Ts: Type} {Tv: Ts->Type} {Tc: Ts->Type} {Tp: Type}.
  Variable (Sg: @Sig Ts Tv Tc Tp).

  Variable D : Dom Sg.
  Variable itp: Interp D.
  Variable FC : predicate (Sig:=Sg) -> formula Sg.
  Variable FC_fo: forall p, isFO Sg (FC p).
  Variable FCv: forall p (i: Fin.t (pr_arity p)), variable (pr_args p i).
  (*
  Variable FCf: forall p i, vsIn Sg (FCv p i) (free Sg (FC p)).
  Variable FCr: forall (p: @predicate Sg) (s: @Sort Sg) (v: variable s), vsIn Sg v (free Sg (FC p)) -> exists (i: pr_arity p), JMeq (FCv p i) v.
  *)

  Definition inst (p: predicate) m : formula Sg :=
    IEx Sg (uptoFinite (pr_arity p)) (pr_args p)
        (FCv p)
        (And Sg (FC p)
                  (IAnd Sg (uptoFinite (pr_arity p))
                      (fun i => Atom Sg (Eq Sg _ (Var Sg _ (FCv p i)) (m i))))
        ).

  Lemma inst_FO: forall p m, isFO Sg (inst p m).
  Proof.
    intros.
    unfold inst.
    apply isFO_IEx.
    apply isFO_And; split.
    apply FC_fo.
    apply isFO_IAnd; intros.
    simpl; auto.
  Qed.

(*
  r(x) et -r(x) stables si FC(r)(x) est en hypothese
  ==> ajouter r(x) et -r(x) dans l'env a droite de =>
*)

  Inductive atStable (V: SV.set (ltDec Sg)) : atom Sg -> Prop :=
    stbL: forall l, SV.set_In l V -> atStable V (Literal Sg l)
  | stbNL: forall l, SV.set_In l V -> atStable V (NLiteral Sg l)
  | stbEq: forall s t1 t2, atStable V (Eq Sg s t1 t2)
  | stbNEq: forall s t1 t2, atStable V (NEq Sg s t1 t2).

  Inductive isStable (V: SV.set (ltDec Sg)) : formula Sg -> Prop :=
    stbT: isStable V (FTrue _)
  | stbF: isStable V (FFalse _)
  | stbA: forall a, atStable V a -> isStable V (Atom Sg a)
  | stbAnd: forall f1 f2 V1 V2, SV.subset (T:=ltDec Sg) V1 V -> SV.subset (T:=ltDec Sg) V2 V ->
    isStable V1 f1 -> isStable V2 f2 -> isStable V (And Sg f1 f2)
  | stbOr: forall f1 f2 V1 V2, SV.subset (T:=ltDec Sg) V1 V -> SV.subset (T:=ltDec Sg) V2 V ->
    isStable V1 f1 -> isStable V2 f2 -> isStable V (Or Sg f1 f2)
  | stbAll: forall f s (v: variable s), isStable V f ->
    (forall l, SV.set_In l V -> not (vsIn Sg v (lt_vars Sg l))) ->
      isStable V (All Sg s v f)
  | stbEx: forall f s (v: variable s), isStable V f ->
    (forall l, SV.set_In l V -> not (vsIn Sg v (lt_vars Sg l))) ->
      isStable V (Ex Sg s v f)
  | stbFC: forall f p m,
    isStable (SV.add (T:=ltDec Sg) (PApp Sg 0 p m) V) f ->
      isStable V (inst p m) ->
        isStable V (Imp Sg (inst p m) f).

  Definition stable env (f: formula Sg) t: Prop :=
      fm_sem Sg env f t <-> fm_sem Sg env f (S t).

  Definition lt_stable (env: Env Sg D) l t :=
    lt_sem Sg env l t <-> lt_sem Sg env l (S t).

  Lemma stable_And: forall env f1 f2 t,
    stable env f1 t -> stable env f2 t -> stable env (And Sg f1 f2) t.
  Proof.
    repeat (split || intro); simpl in *; auto.
    apply H; now auto.
    apply H0; now auto.

    apply H; now auto.
    apply H0; now auto.
  Qed.

  Lemma stable_Or: forall env f1 f2 t,
    stable env f1 t -> stable env f2 t -> stable env (Or Sg f1 f2) t.
  Proof.
    repeat (split || intro); simpl in *; auto.
    destruct H1; [left; apply H | right; apply H0]; now auto.
    destruct H1; [left; apply H | right; apply H0]; now auto.
  Qed.

  Lemma stable_All: forall V s (v: variable s) f t,
    (forall l, SV.set_In (T:=ltDec Sg) l V -> ~ vsIn Sg v (lt_vars Sg l)) ->
      forall env2,
        (forall env1,
          (forall l s' (w: variable s'), SV.set_In (T:=ltDec Sg) l V -> vsIn Sg w (lt_vars Sg l) ->
            env1 s' w = env2 s' w) -> stable env1 f t) ->
          stable env2 (All Sg s v f) t.
  Proof.
    repeat (intro || split); simpl in *.
    apply H0; intros; auto.
    destruct (eq_dec s s').
    subst s'.
    destruct (eq_dec v w).
    subst w.
    apply H in H3; tauto.
    rewrite add_ne; now auto.
    rewrite add_ne2; auto.
    simpl; intro.
    injection H4; clear H4; intros; subst s'; tauto.

    apply H0; intros; auto.
    destruct (eq_dec s s').
    subst s'.
    destruct (eq_dec v w).
    subst w.
    apply H in H3; tauto.
    rewrite add_ne; now auto.
    rewrite add_ne2; auto.
    simpl; intro.
    injection H4; clear H4; intros; subst s'; tauto.
  Qed.

  Lemma stable_Ex: forall V s (v: variable s) f t,
    (forall l, SV.set_In (T:=ltDec Sg) l V -> ~ vsIn Sg v (lt_vars Sg l)) ->
      forall env2,
        (forall env1,
          (forall l s' (w: variable s'), SV.set_In (T:=ltDec Sg) l V -> vsIn Sg w (lt_vars Sg l) ->
            env1 s' w = env2 s' w) -> stable env1 f t) ->
          stable env2 (Ex Sg s v f) t.
  Proof.
    repeat (intro || split); simpl in *.
    destruct H1 as [d H1]; exists d.
    apply H0; intros; auto.
    destruct (eq_dec s s').
    subst s'.
    destruct (eq_dec v w).
    subst w.
    apply H in H3; tauto.
    rewrite add_ne; now auto.
    rewrite add_ne2; auto.
    simpl; intro.
    injection H4; clear H4; intros; subst s'; tauto.

    destruct H1 as [d H1]; exists d.
    apply H0; intros; auto.
    destruct (eq_dec s s').
    subst s'.
    destruct (eq_dec v w).
    subst w.
    apply H in H3; tauto.
    rewrite add_ne; now auto.
    rewrite add_ne2; auto.
    simpl; intro.
    injection H4; clear H4; intros; subst s'; tauto.
  Qed.

  Ltac psemTac :=
    match goal with
      H:psem _ _ ?sa |- psem _ _ ?sa' => assert (sa' = sa) as ae;
          try (rewrite ae; assumption); (apply functional_extensionality_dep; intros)
    end.

  Lemma lt_stable_env: forall env1 env2 V l t,
    lt_noX Sg l -> SV.set_In (T:=ltDec Sg) l V ->
   (forall l' (s' : Sort) (w : variable s'),
     SV.set_In (T:=ltDec Sg) l' V -> vsIn Sg w (lt_vars Sg l') -> env1 s' w = env2 s' w) ->
   lt_stable env1 l t -> lt_stable env2 l t.
  Proof.
    repeat (split || intro).
    generalize (H1 l); clear H1; intro H1.
    destruct l; simpl in *.
    subst n; simpl in *.
    assert (psem p t (fun i : Fin.t (pr_arity p) => tm_sem Sg env1 (t0 i))).
    psemTac.
    destruct (t0 x) eqn:e; simpl; auto.
    apply H1; simpl; auto.
    apply SV.InCUnion_intro with (u:=x); simpl; try apply fin_all; simpl; intros.
    exact (fin_all (T:=uptoFinite (pr_arity p)) x).
    exact (fin_all (T:=uptoFinite (pr_arity p)) x).
    rewrite e; simpl; auto.
    apply vsSing_intro.
    apply H2 in H; simpl in H.
    psemTac.
    destruct (t0 x) eqn:e; simpl; auto.
    symmetry; apply H1; simpl; auto.
    apply SV.InCUnion_intro with (u:=x); simpl; try apply fin_all; simpl; intros.
    exact (fin_all (T:=uptoFinite (pr_arity p)) x).
    exact (fin_all (T:=uptoFinite (pr_arity p)) x).
    rewrite e; simpl; auto.
    apply vsSing_intro.

    generalize (H1 l); clear H1; intro H1.
    destruct l; simpl in *.
    subst n; simpl in *.
    assert (psem p (S t) (fun i : Fin.t (pr_arity p) => tm_sem Sg env1 (t0 i))).
    psemTac.
    destruct (t0 x) eqn:e; simpl; auto.
    apply H1; simpl; auto.
    apply SV.InCUnion_intro with (u:=x); simpl; try apply fin_all; simpl; intros.
    exact (fin_all (T:=uptoFinite (pr_arity p)) x).
    exact (fin_all (T:=uptoFinite (pr_arity p)) x).
    rewrite e; simpl; auto.
    apply vsSing_intro.
    apply H2 in H; simpl in H.
    psemTac.
    destruct (t0 x) eqn:e; simpl; auto.
    symmetry; apply H1; simpl; auto.
    apply SV.InCUnion_intro with (u:=x); simpl; try apply fin_all; simpl; intros.
    exact (fin_all (T:=uptoFinite (pr_arity p)) x).
    exact (fin_all (T:=uptoFinite (pr_arity p)) x).
    rewrite e; simpl; auto.
    apply vsSing_intro.
  Qed.

  Hypothesis stability:
    forall env t p m,
      fm_sem Sg env (inst p m) t -> lt_stable env (PApp Sg 0 p m) t.

  Theorem isStable_stable:
    forall f V env t (fo: isFO Sg f)
      (nx: forall l, SV.set_In (T:=ltDec Sg) l V -> lt_noX Sg l),
      (forall l, SV.set_In (T:=ltDec Sg) l V -> lt_stable env l t) ->
        isStable V f -> stable env f t.
  Proof.
    intros.
    revert env H; induction H0; intros; simpl in *; auto.
  - repeat (split || intro); simpl in *; auto.
  - repeat (split || intro); simpl in *; auto.
  - destruct a; simpl in *; auto.
    inversion H; clear H.
    apply H0 in H2; clear H0.
    repeat (split || intro); simpl in *; auto; apply H2; now auto.
    inversion H; clear H.
    apply H0 in H2; clear H0.
    repeat (split || intro); simpl in *; apply H; apply H2; now auto.
    repeat (split || intro); simpl in *; now auto.
    repeat (split || intro); simpl in *; now auto.
  - apply stable_And.
    apply IHisStable1; clear IHisStable1 IHisStable2; intros; auto; try tauto.
    apply nx; apply H; now auto.
    apply H1; clear H1; intros; auto.
    apply H; now auto.
    apply IHisStable2; clear IHisStable1 IHisStable2; intros; auto; try tauto.
    apply nx; apply H0; now auto.
    apply H1; clear H1; intros; auto.
    apply H0; now auto.
  - apply stable_Or.
    apply IHisStable1; clear IHisStable1 IHisStable2; intros; auto; try tauto.
    apply nx; apply H; now auto.
    apply H1; clear H1; intros; auto.
    apply H; now auto.
    apply IHisStable2; clear IHisStable1 IHisStable2; intros; auto; try tauto.
    apply nx; apply H0; now auto.
    apply H1; clear H1; intros; auto.
    apply H0; now auto.
  - apply stable_All with (V:=V); intros.
    apply H; now auto.
    apply IHisStable; clear IHisStable; auto.
    intros.
    generalize (H1 _ H3); apply lt_stable_env with (V:=V); intros; auto.
    symmetry; apply H2 with (l:=l'); clear H2; intros; auto.
  - apply stable_Ex with (V:=V); intros.
    apply H; now auto.
    apply IHisStable; clear IHisStable; auto.
    intros.
    generalize (H1 _ H3); apply lt_stable_env with (V:=V); intros; auto.
    symmetry; apply H2 with (l:=l'); clear H2; intros; auto.
  - split; intro.
    rewrite Imp_sem in H0; rewrite Imp_sem; intro.
    destruct (classic (fm_sem Sg env (inst p m) t)).
    apply IHisStable1; clear IHisStable1; intros; auto; try tauto.
    apply SV.InAdd in H3; destruct H3; auto.
    subst l; simpl; now auto.
    apply SV.InAdd in H3; destruct H3; auto.
    subst l.
    apply stability; now auto.
    exfalso; apply H2; clear H2.
    apply IHisStable2; intros; auto; try tauto.
    apply inst_FO.

    rewrite Imp_sem in H0; rewrite Imp_sem; intro.
    assert (fm_sem Sg env (inst p m) (S t)).
    apply IHisStable2; clear IHisStable2; intros; auto; try tauto.
    apply inst_FO.
    apply H0 in H2.
    apply IHisStable1; clear IHisStable1; intros; auto; try tauto.
    apply SV.InAdd in H3; destruct H3; auto.
    subst l; simpl; now auto.
    apply SV.InAdd in H3; destruct H3; auto.
    subst l.
    apply stability; now auto.
  Qed.

End Stability.


Lemma LP12P13 : forall P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 ,
rk(P1 :: P2 :: P3 ::  nil) = 3 -> rk(P4 :: P5 :: P6 ::  nil) = 3 -> rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 ::  nil) = 4 ->
rk(P7 :: P8 :: P9 ::  nil) = 3 -> rk(P1 :: P2 :: P3 :: P7 :: P8 :: P9 ::  nil) = 4 -> rk(P4 :: P5 :: P6 :: P7 :: P8 :: P9 ::  nil) = 4 ->
rk(P1 :: P2 :: P3 :: P10 ::  nil) = 3 -> rk(P4 :: P5 :: P6 :: P10 ::  nil) = 3 -> rk(P7 :: P8 :: P9 :: P10 ::  nil) = 4 ->
rk(P1 :: P2 :: P3 :: P11 ::  nil) = 3 -> rk(P4 :: P5 :: P6 :: P11 ::  nil) = 3 -> rk(P7 :: P8 :: P9 :: P11 ::  nil) = 4 ->
rk(P1 :: P2 :: P3 :: P12 ::  nil) = 3 -> rk(P4 :: P5 :: P6 :: P12 ::  nil) = 3 -> rk(P7 :: P8 :: P9 :: P12 ::  nil) = 3 ->
rk(P1 :: P2 :: P3 :: P13 ::  nil) = 3 -> rk(P4 :: P5 :: P6 :: P13 ::  nil) = 3 -> rk(P7 :: P8 :: P9 :: P13 ::  nil) = 3 ->
rk(P12 :: P13 ::  nil) = 1.
Proof.

intros P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13
HP1P2P3eq HP4P5P6eq HP1P2P3P4P5P6eq HP7P8P9eq HP1P2P3P7P8P9eq HP4P5P6P7P8P9eq HP1P2P3P10eq HP4P5P6P10eq HP7P8P9P10eq HP1P2P3P11eq
HP4P5P6P11eq HP7P8P9P11eq HP1P2P3P12eq HP4P5P6P12eq HP7P8P9P12eq HP1P2P3P13eq HP4P5P6P13eq HP7P8P9P13eq .

assert(HP7P8P9P12P13m3 : rk(P7 :: P8 :: P9 :: P12 :: P13 :: nil) >= 3).
{
	try assert(HP7P8P9eq : rk(P7 :: P8 :: P9 :: nil) = 3) by (apply LP7P8P9 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9mtmp : rk(P7 :: P8 :: P9 :: nil) >= 3) by (solve_hyps_min HP7P8P9eq HP7P8P9m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P7 :: P8 :: P9 :: nil) (P7 :: P8 :: P9 :: P12 :: P13 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P7 :: P8 :: P9 :: nil) (P7 :: P8 :: P9 :: P12 :: P13 :: nil) 3 3 HP7P8P9mtmp Hcomp Hincl);apply HT.
}

assert(HP7P8P9P12P13M3 : rk(P7 :: P8 :: P9 :: P12 :: P13 :: nil) <= 3).
{
	try assert(HP7P8P9P12eq : rk(P7 :: P8 :: P9 :: P12 :: nil) = 3) by (apply LP7P8P9P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9P12Mtmp : rk(P7 :: P8 :: P9 :: P12 :: nil) <= 3) by (solve_hyps_max HP7P8P9P12eq HP7P8P9P12M3).
	try assert(HP7P8P9P13eq : rk(P7 :: P8 :: P9 :: P13 :: nil) = 3) by (apply LP7P8P9P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9P13Mtmp : rk(P7 :: P8 :: P9 :: P13 :: nil) <= 3) by (solve_hyps_max HP7P8P9P13eq HP7P8P9P13M3).
	try assert(HP7P8P9eq : rk(P7 :: P8 :: P9 :: nil) = 3) by (apply LP7P8P9 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9mtmp : rk(P7 :: P8 :: P9 :: nil) >= 3) by (solve_hyps_min HP7P8P9eq HP7P8P9m3).
	assert(Hincl : incl (P7 :: P8 :: P9 :: nil) (list_inter (P7 :: P8 :: P9 :: P12 :: nil) (P7 :: P8 :: P9 :: P13 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P7 :: P8 :: P9 :: P12 :: P13 :: nil) (P7 :: P8 :: P9 :: P12 :: P7 :: P8 :: P9 :: P13 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P7 :: P8 :: P9 :: P12 :: P7 :: P8 :: P9 :: P13 :: nil) ((P7 :: P8 :: P9 :: P12 :: nil) ++ (P7 :: P8 :: P9 :: P13 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P7 :: P8 :: P9 :: P12 :: nil) (P7 :: P8 :: P9 :: P13 :: nil) (P7 :: P8 :: P9 :: nil) 3 3 3 HP7P8P9P12Mtmp HP7P8P9P13Mtmp HP7P8P9mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP7P8P9P13M1. try clear HP7P8P9P13M2. try clear HP7P8P9P13M3. try clear HP7P8P9P13m4. try clear HP7P8P9P13m3. try clear HP7P8P9P13m2. try clear HP7P8P9P13m1.

assert(HP1P2P3P10P13m3 : rk(P1 :: P2 :: P3 :: P10 :: P13 :: nil) >= 3).
{
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P10 :: P13 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P10 :: P13 :: nil) 3 3 HP1P2P3mtmp Hcomp Hincl);apply HT.
}

assert(HP1P2P3P10P13M3 : rk(P1 :: P2 :: P3 :: P10 :: P13 :: nil) <= 3).
{
	try assert(HP1P2P3P10eq : rk(P1 :: P2 :: P3 :: P10 :: nil) = 3) by (apply LP1P2P3P10 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3P10Mtmp : rk(P1 :: P2 :: P3 :: P10 :: nil) <= 3) by (solve_hyps_max HP1P2P3P10eq HP1P2P3P10M3).
	try assert(HP1P2P3P13eq : rk(P1 :: P2 :: P3 :: P13 :: nil) = 3) by (apply LP1P2P3P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3P13Mtmp : rk(P1 :: P2 :: P3 :: P13 :: nil) <= 3) by (solve_hyps_max HP1P2P3P13eq HP1P2P3P13M3).
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (list_inter (P1 :: P2 :: P3 :: P10 :: nil) (P1 :: P2 :: P3 :: P13 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P1 :: P2 :: P3 :: P10 :: P13 :: nil) (P1 :: P2 :: P3 :: P10 :: P1 :: P2 :: P3 :: P13 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P1 :: P2 :: P3 :: P10 :: P1 :: P2 :: P3 :: P13 :: nil) ((P1 :: P2 :: P3 :: P10 :: nil) ++ (P1 :: P2 :: P3 :: P13 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P1 :: P2 :: P3 :: P10 :: nil) (P1 :: P2 :: P3 :: P13 :: nil) (P1 :: P2 :: P3 :: nil) 3 3 3 HP1P2P3P10Mtmp HP1P2P3P13Mtmp HP1P2P3mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP1P2P3P10M1. try clear HP1P2P3P10M2. try clear HP1P2P3P10M3. try clear HP1P2P3P10m4. try clear HP1P2P3P10m3. try clear HP1P2P3P10m2. try clear HP1P2P3P10m1. try clear HP1P2P3P13M1. try clear HP1P2P3P13M2. try clear HP1P2P3P13M3. try clear HP1P2P3P13m4. try clear HP1P2P3P13m3. try clear HP1P2P3P13m2. try clear HP1P2P3P13m1.

assert(HP1P2P3P10P12P13m3 : rk(P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil) >= 3).
{
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil) 3 3 HP1P2P3mtmp Hcomp Hincl);apply HT.
}

assert(HP1P2P3P10P12P13M3 : rk(P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil) <= 3).
{
	try assert(HP1P2P3P12eq : rk(P1 :: P2 :: P3 :: P12 :: nil) = 3) by (apply LP1P2P3P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3P12Mtmp : rk(P1 :: P2 :: P3 :: P12 :: nil) <= 3) by (solve_hyps_max HP1P2P3P12eq HP1P2P3P12M3).
	try assert(HP1P2P3P10P13eq : rk(P1 :: P2 :: P3 :: P10 :: P13 :: nil) = 3) by (apply LP1P2P3P10P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3P10P13Mtmp : rk(P1 :: P2 :: P3 :: P10 :: P13 :: nil) <= 3) by (solve_hyps_max HP1P2P3P10P13eq HP1P2P3P10P13M3).
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (list_inter (P1 :: P2 :: P3 :: P12 :: nil) (P1 :: P2 :: P3 :: P10 :: P13 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil) (P1 :: P2 :: P3 :: P12 :: P1 :: P2 :: P3 :: P10 :: P13 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P1 :: P2 :: P3 :: P12 :: P1 :: P2 :: P3 :: P10 :: P13 :: nil) ((P1 :: P2 :: P3 :: P12 :: nil) ++ (P1 :: P2 :: P3 :: P10 :: P13 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P1 :: P2 :: P3 :: P12 :: nil) (P1 :: P2 :: P3 :: P10 :: P13 :: nil) (P1 :: P2 :: P3 :: nil) 3 3 3 HP1P2P3P12Mtmp HP1P2P3P10P13Mtmp HP1P2P3mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP1P2P3P12M1. try clear HP1P2P3P12M2. try clear HP1P2P3P12M3. try clear HP1P2P3P12m4. try clear HP1P2P3P12m3. try clear HP1P2P3P12m2. try clear HP1P2P3P12m1. try clear HP1P2P3P10P13M1. try clear HP1P2P3P10P13M2. try clear HP1P2P3P10P13M3. try clear HP1P2P3P10P13m4. try clear HP1P2P3P10P13m3. try clear HP1P2P3P10P13m2. try clear HP1P2P3P10P13m1.

assert(HP4P5P6P10P13m3 : rk(P4 :: P5 :: P6 :: P10 :: P13 :: nil) >= 3).
{
	try assert(HP4P5P6eq : rk(P4 :: P5 :: P6 :: nil) = 3) by (apply LP4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP4P5P6mtmp : rk(P4 :: P5 :: P6 :: nil) >= 3) by (solve_hyps_min HP4P5P6eq HP4P5P6m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P4 :: P5 :: P6 :: nil) (P4 :: P5 :: P6 :: P10 :: P13 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P4 :: P5 :: P6 :: nil) (P4 :: P5 :: P6 :: P10 :: P13 :: nil) 3 3 HP4P5P6mtmp Hcomp Hincl);apply HT.
}

assert(HP4P5P6P10P13M3 : rk(P4 :: P5 :: P6 :: P10 :: P13 :: nil) <= 3).
{
	try assert(HP4P5P6P10eq : rk(P4 :: P5 :: P6 :: P10 :: nil) = 3) by (apply LP4P5P6P10 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP4P5P6P10Mtmp : rk(P4 :: P5 :: P6 :: P10 :: nil) <= 3) by (solve_hyps_max HP4P5P6P10eq HP4P5P6P10M3).
	try assert(HP4P5P6P13eq : rk(P4 :: P5 :: P6 :: P13 :: nil) = 3) by (apply LP4P5P6P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP4P5P6P13Mtmp : rk(P4 :: P5 :: P6 :: P13 :: nil) <= 3) by (solve_hyps_max HP4P5P6P13eq HP4P5P6P13M3).
	try assert(HP4P5P6eq : rk(P4 :: P5 :: P6 :: nil) = 3) by (apply LP4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP4P5P6mtmp : rk(P4 :: P5 :: P6 :: nil) >= 3) by (solve_hyps_min HP4P5P6eq HP4P5P6m3).
	assert(Hincl : incl (P4 :: P5 :: P6 :: nil) (list_inter (P4 :: P5 :: P6 :: P10 :: nil) (P4 :: P5 :: P6 :: P13 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P4 :: P5 :: P6 :: P10 :: P13 :: nil) (P4 :: P5 :: P6 :: P10 :: P4 :: P5 :: P6 :: P13 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P4 :: P5 :: P6 :: P10 :: P4 :: P5 :: P6 :: P13 :: nil) ((P4 :: P5 :: P6 :: P10 :: nil) ++ (P4 :: P5 :: P6 :: P13 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P4 :: P5 :: P6 :: P10 :: nil) (P4 :: P5 :: P6 :: P13 :: nil) (P4 :: P5 :: P6 :: nil) 3 3 3 HP4P5P6P10Mtmp HP4P5P6P13Mtmp HP4P5P6mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP4P5P6P10M1. try clear HP4P5P6P10M2. try clear HP4P5P6P10M3. try clear HP4P5P6P10m4. try clear HP4P5P6P10m3. try clear HP4P5P6P10m2. try clear HP4P5P6P10m1. try clear HP4P5P6P13M1. try clear HP4P5P6P13M2. try clear HP4P5P6P13M3. try clear HP4P5P6P13m4. try clear HP4P5P6P13m3. try clear HP4P5P6P13m2. try clear HP4P5P6P13m1.

assert(HP4P5P6P10P12P13m3 : rk(P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) >= 3).
{
	try assert(HP4P5P6eq : rk(P4 :: P5 :: P6 :: nil) = 3) by (apply LP4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP4P5P6mtmp : rk(P4 :: P5 :: P6 :: nil) >= 3) by (solve_hyps_min HP4P5P6eq HP4P5P6m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P4 :: P5 :: P6 :: nil) (P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P4 :: P5 :: P6 :: nil) (P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) 3 3 HP4P5P6mtmp Hcomp Hincl);apply HT.
}

assert(HP4P5P6P10P12P13M3 : rk(P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) <= 3).
{
	try assert(HP4P5P6P12eq : rk(P4 :: P5 :: P6 :: P12 :: nil) = 3) by (apply LP4P5P6P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP4P5P6P12Mtmp : rk(P4 :: P5 :: P6 :: P12 :: nil) <= 3) by (solve_hyps_max HP4P5P6P12eq HP4P5P6P12M3).
	try assert(HP4P5P6P10P13eq : rk(P4 :: P5 :: P6 :: P10 :: P13 :: nil) = 3) by (apply LP4P5P6P10P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP4P5P6P10P13Mtmp : rk(P4 :: P5 :: P6 :: P10 :: P13 :: nil) <= 3) by (solve_hyps_max HP4P5P6P10P13eq HP4P5P6P10P13M3).
	try assert(HP4P5P6eq : rk(P4 :: P5 :: P6 :: nil) = 3) by (apply LP4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP4P5P6mtmp : rk(P4 :: P5 :: P6 :: nil) >= 3) by (solve_hyps_min HP4P5P6eq HP4P5P6m3).
	assert(Hincl : incl (P4 :: P5 :: P6 :: nil) (list_inter (P4 :: P5 :: P6 :: P12 :: nil) (P4 :: P5 :: P6 :: P10 :: P13 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) (P4 :: P5 :: P6 :: P12 :: P4 :: P5 :: P6 :: P10 :: P13 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P4 :: P5 :: P6 :: P12 :: P4 :: P5 :: P6 :: P10 :: P13 :: nil) ((P4 :: P5 :: P6 :: P12 :: nil) ++ (P4 :: P5 :: P6 :: P10 :: P13 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P4 :: P5 :: P6 :: P12 :: nil) (P4 :: P5 :: P6 :: P10 :: P13 :: nil) (P4 :: P5 :: P6 :: nil) 3 3 3 HP4P5P6P12Mtmp HP4P5P6P10P13Mtmp HP4P5P6mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP4P5P6P12M1. try clear HP4P5P6P12M2. try clear HP4P5P6P12M3. try clear HP4P5P6P12m4. try clear HP4P5P6P12m3. try clear HP4P5P6P12m2. try clear HP4P5P6P12m1. try clear HP4P5P6P10P13M1. try clear HP4P5P6P10P13M2. try clear HP4P5P6P10P13M3. try clear HP4P5P6P10P13m4. try clear HP4P5P6P10P13m3. try clear HP4P5P6P10P13m2. try clear HP4P5P6P10P13m1. try clear HP4P5P6M1. try clear HP4P5P6M2. try clear HP4P5P6M3. try clear HP4P5P6m4. try clear HP4P5P6m3. try clear HP4P5P6m2. try clear HP4P5P6m1.

assert(HP1P2P3P4P5P6P10P12P13m3 : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) >= 3).
{
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) 3 3 HP1P2P3mtmp Hcomp Hincl);apply HT.
}
try clear HP1P2P3M1. try clear HP1P2P3M2. try clear HP1P2P3M3. try clear HP1P2P3m4. try clear HP1P2P3m3. try clear HP1P2P3m2. try clear HP1P2P3m1.

assert(HP1P2P3P4P5P6P10P12P13m4 : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) >= 4).
{
	try assert(HP1P2P3P4P5P6eq : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: nil) = 4) by (apply LP1P2P3P4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3P4P5P6mtmp : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: nil) >= 4) by (solve_hyps_min HP1P2P3P4P5P6eq HP1P2P3P4P5P6m4).
	assert(Hcomp : 4 <= 4) by (repeat constructor).
	assert(Hincl : incl (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: nil) (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: nil) (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) 4 4 HP1P2P3P4P5P6mtmp Hcomp Hincl);apply HT.
}
try clear HP1P2P3P4P5P6M1. try clear HP1P2P3P4P5P6M2. try clear HP1P2P3P4P5P6M3. try clear HP1P2P3P4P5P6m4. try clear HP1P2P3P4P5P6m3. try clear HP1P2P3P4P5P6m2. try clear HP1P2P3P4P5P6m1.

assert(HP7P8P9P10P12P13m3 : rk(P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) >= 3).
{
	try assert(HP7P8P9eq : rk(P7 :: P8 :: P9 :: nil) = 3) by (apply LP7P8P9 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9mtmp : rk(P7 :: P8 :: P9 :: nil) >= 3) by (solve_hyps_min HP7P8P9eq HP7P8P9m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P7 :: P8 :: P9 :: nil) (P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P7 :: P8 :: P9 :: nil) (P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) 3 3 HP7P8P9mtmp Hcomp Hincl);apply HT.
}
try clear HP7P8P9M1. try clear HP7P8P9M2. try clear HP7P8P9M3. try clear HP7P8P9m4. try clear HP7P8P9m3. try clear HP7P8P9m2. try clear HP7P8P9m1.

assert(HP7P8P9P10P12P13m4 : rk(P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) >= 4).
{
	try assert(HP7P8P9P10eq : rk(P7 :: P8 :: P9 :: P10 :: nil) = 4) by (apply LP7P8P9P10 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9P10mtmp : rk(P7 :: P8 :: P9 :: P10 :: nil) >= 4) by (solve_hyps_min HP7P8P9P10eq HP7P8P9P10m4).
	assert(Hcomp : 4 <= 4) by (repeat constructor).
	assert(Hincl : incl (P7 :: P8 :: P9 :: P10 :: nil) (P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P7 :: P8 :: P9 :: P10 :: nil) (P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) 4 4 HP7P8P9P10mtmp Hcomp Hincl);apply HT.
}
try clear HP7P8P9P10M1. try clear HP7P8P9P10M2. try clear HP7P8P9P10M3. try clear HP7P8P9P10m4. try clear HP7P8P9P10m3. try clear HP7P8P9P10m2. try clear HP7P8P9P10m1.

assert(HP10P12P13m2 : rk(P10 :: P12 :: P13 :: nil) >= 2).
{
	try assert(HP7P8P9P12eq : rk(P7 :: P8 :: P9 :: P12 :: nil) = 3) by (apply LP7P8P9P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9P12Mtmp : rk(P7 :: P8 :: P9 :: P12 :: nil) <= 3) by (solve_hyps_max HP7P8P9P12eq HP7P8P9P12M3).
	try assert(HP7P8P9P10P12P13eq : rk(P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) = 4) by (apply LP7P8P9P10P12P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9P10P12P13mtmp : rk(P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) >= 4) by (solve_hyps_min HP7P8P9P10P12P13eq HP7P8P9P10P12P13m4).
	try assert(HP12eq : rk(P12 :: nil) = 1) by (apply LP12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP12mtmp : rk(P12 :: nil) >= 1) by (solve_hyps_min HP12eq HP12m1).
	assert(Hincl : incl (P12 :: nil) (list_inter (P7 :: P8 :: P9 :: P12 :: nil) (P10 :: P12 :: P13 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) (P7 :: P8 :: P9 :: P12 :: P10 :: P12 :: P13 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P7 :: P8 :: P9 :: P12 :: P10 :: P12 :: P13 :: nil) ((P7 :: P8 :: P9 :: P12 :: nil) ++ (P10 :: P12 :: P13 :: nil))) by (clear_all_rk;my_inO).
	try rewrite HT1 in HP7P8P9P10P12P13mtmp;try rewrite HT2 in HP7P8P9P10P12P13mtmp.
	assert(HT := rule_4 (P7 :: P8 :: P9 :: P12 :: nil) (P10 :: P12 :: P13 :: nil) (P12 :: nil) 4 1 3 HP7P8P9P10P12P13mtmp HP12mtmp HP7P8P9P12Mtmp Hincl); apply HT.
}
try clear HP7P8P9P12M1. try clear HP7P8P9P12M2. try clear HP7P8P9P12M3. try clear HP7P8P9P12m4. try clear HP7P8P9P12m3. try clear HP7P8P9P12m2. try clear HP7P8P9P12m1. try clear HP12M1. try clear HP12M2. try clear HP12M3. try clear HP12m4. try clear HP12m3. try clear HP12m2. try clear HP12m1.

assert(HP10P12P13M2 : rk(P10 :: P12 :: P13 :: nil) <= 2).
{
	try assert(HP1P2P3P10P12P13eq : rk(P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil) = 3) by (apply LP1P2P3P10P12P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3P10P12P13Mtmp : rk(P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil) <= 3) by (solve_hyps_max HP1P2P3P10P12P13eq HP1P2P3P10P12P13M3).
	try assert(HP4P5P6P10P12P13eq : rk(P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) = 3) by (apply LP4P5P6P10P12P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP4P5P6P10P12P13Mtmp : rk(P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) <= 3) by (solve_hyps_max HP4P5P6P10P12P13eq HP4P5P6P10P12P13M3).
	try assert(HP1P2P3P4P5P6P10P12P13eq : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) = 4) by (apply LP1P2P3P4P5P6P10P12P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP1P2P3P4P5P6P10P12P13mtmp : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) >= 4) by (solve_hyps_min HP1P2P3P4P5P6P10P12P13eq HP1P2P3P4P5P6P10P12P13m4).
	assert(Hincl : incl (P10 :: P12 :: P13 :: nil) (list_inter (P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil) (P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) (P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) ((P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil) ++ (P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil))) by (clear_all_rk;my_inO).
	try rewrite HT1 in HP1P2P3P4P5P6P10P12P13mtmp;try rewrite HT2 in HP1P2P3P4P5P6P10P12P13mtmp.
	assert(HT := rule_3 (P1 :: P2 :: P3 :: P10 :: P12 :: P13 :: nil) (P4 :: P5 :: P6 :: P10 :: P12 :: P13 :: nil) (P10 :: P12 :: P13 :: nil) 3 3 4 HP1P2P3P10P12P13Mtmp HP4P5P6P10P12P13Mtmp HP1P2P3P4P5P6P10P12P13mtmp Hincl);apply HT.
}
try clear HP1P2P3P10P12P13M1. try clear HP1P2P3P10P12P13M2. try clear HP1P2P3P10P12P13M3. try clear HP1P2P3P10P12P13m4. try clear HP1P2P3P10P12P13m3. try clear HP1P2P3P10P12P13m2. try clear HP1P2P3P10P12P13m1. try clear HP4P5P6P10P12P13M1. try clear HP4P5P6P10P12P13M2. try clear HP4P5P6P10P12P13M3. try clear HP4P5P6P10P12P13m4. try clear HP4P5P6P10P12P13m3. try clear HP4P5P6P10P12P13m2. try clear HP4P5P6P10P12P13m1. try clear HP1P2P3P4P5P6P10P12P13M1. try clear HP1P2P3P4P5P6P10P12P13M2. try clear HP1P2P3P4P5P6P10P12P13M3. try clear HP1P2P3P4P5P6P10P12P13m4. try clear HP1P2P3P4P5P6P10P12P13m3. try clear HP1P2P3P4P5P6P10P12P13m2. try clear HP1P2P3P4P5P6P10P12P13m1.

assert(HP12P13M1 : rk(P12 :: P13 :: nil) <= 1).
{
	try assert(HP7P8P9P12P13eq : rk(P7 :: P8 :: P9 :: P12 :: P13 :: nil) = 3) by (apply LP7P8P9P12P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9P12P13Mtmp : rk(P7 :: P8 :: P9 :: P12 :: P13 :: nil) <= 3) by (solve_hyps_max HP7P8P9P12P13eq HP7P8P9P12P13M3).
	try assert(HP10P12P13eq : rk(P10 :: P12 :: P13 :: nil) = 2) by (apply LP10P12P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP10P12P13Mtmp : rk(P10 :: P12 :: P13 :: nil) <= 2) by (solve_hyps_max HP10P12P13eq HP10P12P13M2).
	try assert(HP7P8P9P10P12P13eq : rk(P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) = 4) by (apply LP7P8P9P10P12P13 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) (P13 := P13) ;try assumption).
	assert(HP7P8P9P10P12P13mtmp : rk(P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) >= 4) by (solve_hyps_min HP7P8P9P10P12P13eq HP7P8P9P10P12P13m4).
	assert(Hincl : incl (P12 :: P13 :: nil) (list_inter (P7 :: P8 :: P9 :: P12 :: P13 :: nil) (P10 :: P12 :: P13 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P7 :: P8 :: P9 :: P10 :: P12 :: P13 :: nil) (P7 :: P8 :: P9 :: P12 :: P13 :: P10 :: P12 :: P13 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P7 :: P8 :: P9 :: P12 :: P13 :: P10 :: P12 :: P13 :: nil) ((P7 :: P8 :: P9 :: P12 :: P13 :: nil) ++ (P10 :: P12 :: P13 :: nil))) by (clear_all_rk;my_inO).
	try rewrite HT1 in HP7P8P9P10P12P13mtmp;try rewrite HT2 in HP7P8P9P10P12P13mtmp.
	assert(HT := rule_3 (P7 :: P8 :: P9 :: P12 :: P13 :: nil) (P10 :: P12 :: P13 :: nil) (P12 :: P13 :: nil) 3 2 4 HP7P8P9P12P13Mtmp HP10P12P13Mtmp HP7P8P9P10P12P13mtmp Hincl);apply HT.
}
try clear HP7P8P9P12P13M1. try clear HP7P8P9P12P13M2. try clear HP7P8P9P12P13M3. try clear HP7P8P9P12P13m4. try clear HP7P8P9P12P13m3. try clear HP7P8P9P12P13m2. try clear HP7P8P9P12P13m1. try clear HP10P12P13M1. try clear HP10P12P13M2. try clear HP10P12P13M3. try clear HP10P12P13m4. try clear HP10P12P13m3. try clear HP10P12P13m2. try clear HP10P12P13m1. try clear HP7P8P9P10P12P13M1. try clear HP7P8P9P10P12P13M2. try clear HP7P8P9P10P12P13M3. try clear HP7P8P9P10P12P13m4. try clear HP7P8P9P10P12P13m3. try clear HP7P8P9P10P12P13m2. try clear HP7P8P9P10P12P13m1.

assert(HP12P13M : rk(P12 :: P13 ::  nil) <= 2) by (solve_hyps_max HP12P13eq HP12P13M2).
assert(HP12P13m : rk(P12 :: P13 ::  nil) >= 1) by (solve_hyps_min HP12P13eq HP12P13m1).
intuition.
Qed.


(** Impure monad for interface with impure code
*)

Require Import Program.

Module Type MayReturnMonad.

  Axiom t: Type -> Type.

  Axiom mayRet: forall {A:Type}, t A -> A -> Prop.

  Axiom ret: forall {A}, A -> t A.

  Axiom bind: forall {A B}, (t A) -> (A -> t B) -> t B.

  Axiom mk_annot: forall {A} (k: t A), t { a: A | mayRet k a }.

  Axiom mayRet_ret: forall A (a b:A),
     mayRet (ret a) b -> a=b.

  Axiom mayRet_bind: forall A B k1 k2 (b:B),
     mayRet (bind k1 k2) b -> exists a:A, mayRet k1 a /\ mayRet (k2 a) b.

End MayReturnMonad.

(** Model of impure computation as predicate *)
Module PowerSetMonad<: MayReturnMonad.

   Definition t (A:Type) := A -> Prop.

   Definition mayRet {A:Type} (k: t A) a: Prop := k a.

   Definition ret {A:Type} (a:A) := eq a.

   Definition bind {A B:Type} (k1: t A) (k2: A -> t B) :=
     fun b => exists a, k1 a /\ k2 a b.

   Definition mk_annot {A} (k: t A) : t { a | mayRet k a } := fun _ => True.

   Lemma mayRet_ret A (a b:A): mayRet (ret a) b -> a=b.
   Proof.
     unfold mayRet, ret. firstorder.
   Qed.

   Lemma mayRet_bind A B k1 k2 (b:B):
         mayRet (bind k1 k2) b -> exists (a:A), mayRet k1 a /\ mayRet (k2 a) b.
   Proof.
     unfold mayRet, bind.
     firstorder.
   Qed.

End PowerSetMonad.

(** The identity interpretation *)
Module IdentityMonad<: MayReturnMonad.

   Definition t (A:Type) := A.

   (* may-return semantics of computations *)
   Definition mayRet {A:Type} (a b:A): Prop := a=b.

   Definition ret {A:Type} (a:A) := a.

   Definition bind {A B:Type} (k1: A) (k2: A -> B) := k2 k1.

   Definition mk_annot {A} (k: t A) : t { a: A | mayRet k a }
    := exist _ k (eq_refl k) .

   Lemma mayRet_ret (A:Type) (a b:A): mayRet (ret a) b -> a=b.
   Proof.
     intuition.
   Qed.

   Lemma mayRet_bind (A B:Type) (k1:t A) k2 (b:B):
         mayRet (bind k1 k2) b -> exists (a:A), mayRet k1 a /\ mayRet (k2 a) b.
   Proof.
     firstorder.
   Qed.

End IdentityMonad.

(** Model of impure computation as state-transformers *)
Module StateMonad<: MayReturnMonad.

   Parameter St: Type. (* A global state *)

   Definition t (A:Type) := St -> A * St.

   Definition mayRet {A:Type} (k: t A) a: Prop :=
     exists s, fst (k s)=a.

   Definition ret {A:Type} (a:A) := fun (s:St) => (a,s).

   Definition bind {A B:Type} (k1: t A) (k2: A -> t B) :=
     fun s0 => let r := k1 s0 in k2 (fst r) (snd r).

   Program Definition mk_annot {A} (k: t A) : t { a | mayRet k a } :=
     fun s0 => let r := k s0 in (exist _ (fst r) _, snd r).
   Obligation 1.
     unfold mayRet; eauto.
   Qed.

   Lemma mayRet_ret {A:Type} (a b:A): mayRet (ret a) b -> a=b.
   Proof.
     unfold mayRet, ret. firstorder.
   Qed.

   Lemma mayRet_bind {A B:Type} k1 k2 (b:B):
         mayRet (bind k1 k2) b -> exists (a:A), mayRet k1 a /\ mayRet (k2 a) b.
   Proof.
     unfold mayRet, bind. firstorder eauto.
   Qed.

End StateMonad.

(** The deferred interpretation *)
Module DeferredMonad<: MayReturnMonad.

   Definition t (A:Type) := unit -> A.

   (* may-return semantics of computations *)
   Definition mayRet {A:Type} (a: t A) (b:A): Prop := a tt=b.

   Definition ret {A:Type} (a:A) : t A := fun _ => a.

   Definition bind {A B:Type} (k1: t A) (k2: A -> t B) : t B := fun _ => k2 (k1 tt) tt.

   Definition mk_annot {A} (k: t A) : t { a: A | mayRet k a }
    := fun _ => exist _ (k tt) (eq_refl (k tt)).

   Lemma mayRet_ret (A:Type) (a b: A): mayRet (ret a) b -> a=b.
   Proof.
     intuition.
   Qed.

   Lemma mayRet_bind (A B:Type) (k1:t A) k2 (b:B):
         mayRet (bind k1 k2) b -> exists (a:A), mayRet k1 a /\ mayRet (k2 a) b.
   Proof.
     firstorder.
   Qed.

End DeferredMonad.


Require Export Program.Basics. Open Scope program_scope.
From Paco Require Import paco5 pacotac.
Set Implicit Arguments.

Section GeneralizedPaco5.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable T4 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2), Type.

Local Notation rel := (rel5 T0 T1 T2 T3 T4).

Section RClo.

Inductive rclo5 (clo: rel->rel) (r: rel): rel :=
| rclo5_base
    x0 x1 x2 x3 x4
    (IN: r x0 x1 x2 x3 x4):
    @rclo5 clo r x0 x1 x2 x3 x4
| rclo5_clo'
    r' x0 x1 x2 x3 x4
    (LE: r' <5= rclo5 clo r)
    (IN: clo r' x0 x1 x2 x3 x4):
    @rclo5 clo r x0 x1 x2 x3 x4
.

Lemma rclo5_mon_gen clo clo' r r' x0 x1 x2 x3 x4
      (IN: @rclo5 clo r x0 x1 x2 x3 x4)
      (LEclo: clo <6= clo')
      (LEr: r <5= r') :
  @rclo5 clo' r' x0 x1 x2 x3 x4.
Proof.
  induction IN; intros.
  - econstructor 1. apply LEr, IN.
  - econstructor 2; [intros; eapply H, PR|apply LEclo, IN].
Qed.

Lemma rclo5_mon clo:
  monotone5 (rclo5 clo).
Proof.
  repeat intro. eapply rclo5_mon_gen; [apply IN|intros; apply PR|apply LE].
Qed.

Lemma rclo5_clo clo r:
  clo (rclo5 clo r) <5= rclo5 clo r.
Proof.
  intros. econstructor 2; [|apply PR].
  intros. apply PR0.
Qed.

Lemma rclo5_clo_base clo r:
  clo r <5= rclo5 clo r.
Proof.
  intros. eapply rclo5_clo', PR.
  intros. apply rclo5_base, PR0.
Qed.

Lemma rclo5_rclo clo r:
  rclo5 clo (rclo5 clo r) <5= rclo5 clo r.
Proof.
  intros. induction PR.
  - eapply IN.
  - econstructor 2; [eapply H | eapply IN].
Qed.

Lemma rclo5_compose clo r:
  rclo5 (rclo5 clo) r <5= rclo5 clo r.
Proof.
  intros. induction PR.
  - apply rclo5_base, IN.
  - apply rclo5_rclo.
    eapply rclo5_mon; [apply IN|apply H].
Qed.

End RClo.

Section Main.

Variable gf: rel -> rel.
Hypothesis gf_mon: monotone5 gf.

Variant gpaco5 clo r rg x0 x1 x2 x3 x4 : Prop :=
| gpaco5_intro (IN: @rclo5 clo (paco5 (compose gf (rclo5 clo)) (rg \5/ r) \5/ r) x0 x1 x2 x3 x4)
.

Definition gupaco5 clo r := gpaco5 clo r r.

Lemma gpaco5_def_mon clo : monotone5 (compose gf (rclo5 clo)).
Proof.
  eapply monotone5_compose. apply gf_mon. apply rclo5_mon.
Qed.

#[local] Hint Resolve gpaco5_def_mon : paco.

Lemma gpaco5_mon clo r r' rg rg' x0 x1 x2 x3 x4
      (IN: @gpaco5 clo r rg x0 x1 x2 x3 x4)
      (LEr: r <5= r')
      (LErg: rg <5= rg'):
  @gpaco5 clo r' rg' x0 x1 x2 x3 x4.
Proof.
  destruct IN. econstructor.
  eapply rclo5_mon. apply IN.
  intros. destruct PR; [|right; apply LEr, H].
  left. eapply paco5_mon. apply H.
  intros. destruct PR.
  - left. apply LErg, H0.
  - right. apply LEr, H0.
Qed.

Lemma gupaco5_mon clo r r' x0 x1 x2 x3 x4
      (IN: @gupaco5 clo r x0 x1 x2 x3 x4)
      (LEr: r <5= r'):
  @gupaco5 clo r' x0 x1 x2 x3 x4.
Proof.
  eapply gpaco5_mon. apply IN. apply LEr. apply LEr.
Qed.

Lemma gpaco5_base clo r rg: r <5= gpaco5 clo r rg.
Proof.
  econstructor. apply rclo5_base. right. apply PR.
Qed.

Lemma gpaco5_gen_guard  clo r rg:
  gpaco5 clo r (rg \5/ r) <5= gpaco5 clo r rg.
Proof.
  intros. destruct PR. econstructor.
  eapply rclo5_mon. apply IN. intros.
  destruct PR; [|right; apply H].
  left. eapply paco5_mon_gen; intros. apply H. apply PR.
  destruct PR. apply H0. right. apply H0.
Qed.

Lemma gpaco5_rclo clo r rg:
  rclo5 clo r <5= gpaco5 clo r rg.
Proof.
  intros. econstructor.
  eapply rclo5_mon. apply PR.
  intros. right. apply PR0.
Qed.

Lemma gpaco5_clo clo r rg:
  clo r <5= gpaco5 clo r rg.
Proof.
  intros. apply gpaco5_rclo. eapply rclo5_clo_base, PR.
Qed.

Lemma gpaco5_gen_rclo clo r rg:
  gpaco5 (rclo5 clo) r rg <5= gpaco5 clo r rg.
Proof.
  intros. destruct PR. econstructor.
  apply rclo5_compose.
  eapply rclo5_mon. apply IN. intros.
  destruct PR; [|right; apply H].
  left. eapply paco5_mon_gen; intros; [apply H| |apply PR].
  eapply gf_mon, rclo5_compose. apply PR.
Qed.

Lemma gpaco5_step_gen clo r rg:
  gf (gpaco5 clo (rg \5/ r) (rg \5/ r)) <5= gpaco5 clo r rg.
Proof.
  intros. econstructor. apply rclo5_base. left.
  pstep. eapply gf_mon. apply PR.
  intros. destruct PR0. eapply rclo5_mon. apply IN.
  intros. destruct PR0.
  - left. eapply paco5_mon. apply H. intros. destruct PR0; apply H0.
  - right. apply H.
Qed.

Lemma gpaco5_step clo r rg:
  gf (gpaco5 clo rg rg) <5= gpaco5 clo r rg.
Proof.
  intros. apply gpaco5_step_gen.
  eapply gf_mon. apply PR. intros.
  eapply gpaco5_mon. apply PR0. left; apply PR1. left; apply PR1.
Qed.

Lemma gpaco5_final clo r rg:
  (r \5/ paco5 gf rg) <5= gpaco5 clo r rg.
Proof.
  intros. destruct PR. apply gpaco5_base, H.
  econstructor. apply rclo5_base.
  left. eapply paco5_mon_gen. apply H.
  - intros. eapply gf_mon. apply PR.
    intros. apply rclo5_base. apply PR0.
  - intros. left. apply PR.
Qed.

Lemma gpaco5_unfold clo r rg:
  gpaco5 clo r rg <5= rclo5 clo (gf (gupaco5 clo (rg \5/ r)) \5/ r).
Proof.
  intros. destruct PR.
  eapply rclo5_mon. apply IN.
  intros. destruct PR; cycle 1. right; apply H.
  left. _punfold H; [|apply gpaco5_def_mon].
  eapply gf_mon. apply H.
  intros. econstructor.
  eapply rclo5_mon. apply PR.
  intros. destruct PR0; cycle 1. right. apply H0.
  left. eapply paco5_mon. apply H0.
  intros. left. apply PR0.
Qed.

Lemma gpaco5_cofix clo r rg
      l (OBG: forall rr (INC: rg <5= rr) (CIH: l <5= rr), l <5= gpaco5 clo r rr):
  l <5= gpaco5 clo r rg.
Proof.
  assert (IN: l <5= gpaco5 clo r (rg \5/ l)).
  { intros. apply OBG; [left; apply PR0 | right; apply PR0 | apply PR]. }
  clear OBG. intros. apply IN in PR.
  destruct PR. econstructor.
  eapply rclo5_mon. apply IN0.
  clear x0 x1 x2 x3 x4 IN0.
  intros. destruct PR; [|right; apply H].
  left. revert x0 x1 x2 x3 x4 H.
  pcofix CIH. intros.
  _punfold H0; [..|apply gpaco5_def_mon]. pstep.
  eapply gf_mon. apply H0. intros.
  apply rclo5_rclo. eapply rclo5_mon. apply PR.
  intros. destruct PR0.
  - apply rclo5_base. right. apply CIH. apply H.
  - destruct H; [destruct H|].
    + apply rclo5_base. right. apply CIH0. left. apply H.
    + apply IN in H. destruct H.
      eapply rclo5_mon. apply IN0.
      intros. destruct PR0.
      * right. apply CIH. apply H.
      * right. apply CIH0. right. apply H.
    + apply rclo5_base. right. apply CIH0. right. apply H.
Qed.

Lemma gpaco5_gupaco clo r rg:
  gupaco5 clo (gpaco5 clo r rg) <5= gpaco5 clo r rg.
Proof.
  eapply gpaco5_cofix.
  intros. destruct PR. econstructor.
  apply rclo5_rclo. eapply rclo5_mon. apply IN.
  intros. destruct PR.
  - apply rclo5_base. left.
    eapply paco5_mon. apply H.
    intros. left; apply CIH.
    econstructor. apply rclo5_base. right.
    destruct PR; apply H0.
  - destruct H. eapply rclo5_mon. apply IN0.
    intros. destruct PR; [| right; apply H].
    left. eapply paco5_mon. apply H.
    intros. destruct PR.
    + left. apply INC. apply H0.
    + right. apply H0.
Qed.

Lemma gpaco5_gpaco clo r rg:
  gpaco5 clo (gpaco5 clo r rg) (gupaco5 clo (rg \5/ r)) <5= gpaco5 clo r rg.
Proof.
  intros. apply gpaco5_unfold in PR.
  econstructor. apply rclo5_rclo. eapply rclo5_mon. apply PR. clear x0 x1 x2 x3 x4 PR. intros.
  destruct PR; [|destruct H; apply IN].
  apply rclo5_base. left. pstep.
  eapply gf_mon. apply H. clear x0 x1 x2 x3 x4 H. intros.
  cut (@gupaco5 clo (rg \5/ r) x0 x1 x2 x3 x4).
  { intros. destruct H. eapply rclo5_mon. apply IN. intros.
    destruct PR0; [|right; apply H].
    left. eapply paco5_mon. apply H. intros. destruct PR0; apply H0.
  }
  apply gpaco5_gupaco. eapply gupaco5_mon. apply PR. intros.
  destruct PR0; [apply H|].
  eapply gpaco5_mon; [apply H|right|left]; intros; apply PR0.
Qed.

Lemma gpaco5_uclo uclo clo r rg
      (LEclo: uclo <6= gupaco5 clo) :
  uclo (gpaco5 clo r rg) <5= gpaco5 clo r rg.
Proof.
  intros. apply gpaco5_gupaco. apply LEclo, PR.
Qed.

Lemma gpaco5_weaken  clo r rg:
  gpaco5 (gupaco5 clo) r rg <5= gpaco5 clo r rg.
Proof.
  intros. apply gpaco5_unfold in PR.
  induction PR.
  - destruct IN; cycle 1. apply gpaco5_base, H.
    apply gpaco5_step_gen. eapply gf_mon. apply H.
    clear x0 x1 x2 x3 x4 H.
    eapply gpaco5_cofix. intros.
    apply gpaco5_unfold in PR.
    induction PR.
    + destruct IN; cycle 1. apply gpaco5_base, H.
      apply gpaco5_step. eapply gf_mon. apply H.
      intros. apply gpaco5_base. apply CIH.
      eapply gupaco5_mon. apply PR.
      intros. destruct PR0; apply H0.
    + apply gpaco5_gupaco.
      eapply gupaco5_mon. apply IN. apply H.
  - apply gpaco5_gupaco.
    eapply gupaco5_mon. apply IN. apply H.
Qed.

End Main.

#[local] Hint Resolve gpaco5_def_mon : paco.

Section GeneralMonotonicity.

Variable gf: rel -> rel.

Lemma gpaco5_mon_gen (gf' clo clo': rel -> rel) x0 x1 x2 x3 x4 r r' rg rg'
      (IN: @gpaco5 gf clo r rg x0 x1 x2 x3 x4)
      (gf_mon: monotone5 gf)
      (LEgf: gf <6= gf')
      (LEclo: clo <6= clo')
      (LEr: r <5= r')
      (LErg: rg <5= rg') :
  @gpaco5 gf' clo' r' rg' x0 x1 x2 x3 x4.
Proof.
  eapply gpaco5_mon; [|apply LEr|apply LErg].
  destruct IN. econstructor.
  eapply rclo5_mon_gen. apply IN. apply LEclo.
  intros. destruct PR; [| right; apply H].
  left. eapply paco5_mon_gen. apply H.
  - intros. eapply LEgf.
    eapply gf_mon. apply PR.
    intros. eapply rclo5_mon_gen. apply PR0. apply LEclo. intros; apply PR1.
  - intros. apply PR.
Qed.

Lemma gpaco5_mon_bot (gf' clo clo': rel -> rel) x0 x1 x2 x3 x4 r' rg'
      (IN: @gpaco5 gf clo bot5 bot5 x0 x1 x2 x3 x4)
      (gf_mon: monotone5 gf)
      (LEgf: gf <6= gf')
      (LEclo: clo <6= clo'):
  @gpaco5 gf' clo' r' rg' x0 x1 x2 x3 x4.
Proof.
  eapply gpaco5_mon_gen. apply IN. apply gf_mon. apply LEgf. apply LEclo. contradiction. contradiction.
Qed.

Lemma gupaco5_mon_gen (gf' clo clo': rel -> rel) x0 x1 x2 x3 x4 r r'
      (IN: @gupaco5 gf clo r x0 x1 x2 x3 x4)
      (gf_mon: monotone5 gf)
      (LEgf: gf <6= gf')
      (LEclo: clo <6= clo')
      (LEr: r <5= r'):
  @gupaco5 gf' clo' r' x0 x1 x2 x3 x4.
Proof.
  eapply gpaco5_mon_gen. apply IN. apply gf_mon. apply LEgf. apply LEclo. apply LEr. apply LEr.
Qed.

End GeneralMonotonicity.

Section Compatibility.

Variable gf: rel -> rel.
Hypothesis gf_mon: monotone5 gf.

Structure compatible5 (clo: rel -> rel) : Prop :=
  compat5_intro {
      compat5_mon: monotone5 clo;
      compat5_compat : forall r,
          clo (gf r) <5= gf (clo r);
    }.

Structure wcompatible5 clo : Prop :=
  wcompat5_intro {
      wcompat5_mon: monotone5 clo;
      wcompat5_wcompat : forall r,
          clo (gf r) <5= gf (gupaco5 gf clo r);
    }.

Lemma rclo5_dist clo
      (MON: monotone5 clo)
      (DIST: forall r1 r2, clo (r1 \5/ r2) <5= (clo r1 \5/ clo r2)):
  forall r1 r2, rclo5 clo (r1 \5/ r2) <5= (rclo5 clo r1 \5/ rclo5 clo r2).
Proof.
  intros. induction PR.
  + destruct IN; [left|right]; apply rclo5_base, H.
  + assert (REL: clo (rclo5 clo r1 \5/ rclo5 clo r2) x0 x1 x2 x3 x4).
    { eapply MON. apply IN. apply H. }
    apply DIST in REL. destruct REL; [left|right]; apply rclo5_clo, H0.
Qed.

Lemma rclo5_compat clo
      (COM: compatible5 clo):
  compatible5 (rclo5 clo).
Proof.
  econstructor.
  - apply rclo5_mon.
  - intros. induction PR.
    + eapply gf_mon. apply IN.
      intros. eapply rclo5_base. apply PR.
    + eapply gf_mon.
      * eapply COM. eapply COM. apply IN. apply H.
      * intros. eapply rclo5_clo. apply PR.
Qed.

Lemma rclo5_wcompat clo
      (COM: wcompatible5 clo):
  wcompatible5 (rclo5 clo).
Proof.
  econstructor.
  - apply rclo5_mon.
  - intros. induction PR.
    + eapply gf_mon. apply IN.
      intros. apply gpaco5_base. apply PR.
    + eapply gf_mon.
      * eapply COM. eapply COM. apply IN. apply H.
      * intros. eapply gpaco5_gupaco. apply gf_mon.
        eapply gupaco5_mon_gen; intros; [apply PR|apply gf_mon|apply PR0| |apply PR0].
        apply rclo5_clo_base, PR0.
Qed.

Lemma compat5_wcompat clo
      (CMP: compatible5 clo):
  wcompatible5 clo.
Proof.
  econstructor. apply CMP.
  intros. apply CMP in PR.
  eapply gf_mon. apply PR.
  intros. apply gpaco5_clo, PR0.
Qed.

Lemma wcompat5_compat clo
      (WCMP: wcompatible5 clo) :
  compatible5 (gupaco5 gf clo).
Proof.
  econstructor.
  { red; intros. eapply gpaco5_mon. apply IN. apply LE. apply LE. }

  intros. apply gpaco5_unfold in PR; [|apply gf_mon].
  induction PR.
  - destruct IN; cycle 1.
    + eapply gf_mon. apply H.
      intros. apply gpaco5_base, PR.
    + eapply gf_mon. apply H.
      intros. apply gpaco5_gupaco. apply gf_mon.
      eapply gupaco5_mon. apply PR.
      intros. apply gpaco5_step. apply gf_mon.
      eapply gf_mon. destruct PR0 as [X|X]; apply X.
      intros. apply gpaco5_base, PR1.
  - eapply gf_mon, gpaco5_gupaco, gf_mon.
    apply WCMP. eapply WCMP. apply IN.
    intros. apply H, PR.
Qed.

Lemma wcompat5_union clo1 clo2
      (WCMP1: wcompatible5 clo1)
      (WCMP2: wcompatible5 clo2):
  wcompatible5 (clo1 \6/ clo2).
Proof.
  econstructor.
  - apply monotone5_union. apply WCMP1. apply WCMP2.
  - intros. destruct PR.
    + apply WCMP1 in H. eapply gf_mon. apply H.
      intros. eapply gupaco5_mon_gen. apply PR. apply gf_mon.
      intros; apply PR0. left; apply PR0. intros; apply PR0.
    + apply WCMP2 in H. eapply gf_mon. apply H.
      intros. eapply gupaco5_mon_gen. apply PR. apply gf_mon.
      intros; apply PR0. right; apply PR0. intros; apply PR0.
Qed.

End Compatibility.

Section Soundness.

Variable gf: rel -> rel.
Hypothesis gf_mon: monotone5 gf.

Lemma gpaco5_compat_init clo
      (CMP: compatible5 gf clo):
  gpaco5 gf clo bot5 bot5 <5= paco5 gf bot5.
Proof.
  intros. destruct PR. revert x0 x1 x2 x3 x4 IN.
  pcofix CIH. intros.
  pstep. eapply gf_mon; [| right; apply CIH, rclo5_rclo, PR].
  apply compat5_compat with (gf:=gf). apply rclo5_compat. apply gf_mon. apply CMP.
  eapply rclo5_mon. apply IN.
  intros. destruct PR; [|contradiction]. _punfold H; [..|apply gpaco5_def_mon, gf_mon].
  eapply gpaco5_def_mon. apply gf_mon. apply H.
  intros. destruct PR; [|destruct H0; contradiction]. left. apply H0.
Qed.

Lemma gpaco5_init clo
      (WCMP: wcompatible5 gf clo):
  gpaco5 gf clo bot5 bot5 <5= paco5 gf bot5.
Proof.
  intros. eapply gpaco5_compat_init.
  - apply wcompat5_compat, WCMP. apply gf_mon.
  - eapply gpaco5_mon_bot. apply PR. apply gf_mon. intros; apply PR0.
    intros. apply gpaco5_clo, PR0.
Qed.

Lemma gpaco5_unfold_bot clo
      (WCMP: wcompatible5 gf clo):
  gpaco5 gf clo bot5 bot5 <5= gf (gpaco5 gf clo bot5 bot5).
Proof.
  intros. apply gpaco5_init in PR; [|apply WCMP].
  _punfold PR; [..|apply gf_mon].
  eapply gf_mon. apply PR.
  intros. destruct PR0; [|contradiction]. apply gpaco5_final. apply gf_mon. right. apply H.
Qed.

End Soundness.

Section Distributivity.

Variable gf: rel -> rel.
Hypothesis gf_mon: monotone5 gf.

Lemma gpaco5_dist clo r rg
      (CMP: wcompatible5 gf clo)
      (DIST: forall r1 r2, clo (r1 \5/ r2) <5= (clo r1 \5/ clo r2)):
  gpaco5 gf clo r rg <5= (paco5 gf (rclo5 clo (rg \5/ r)) \5/ rclo5 clo r).
Proof.
  intros. apply gpaco5_unfold in PR; [|apply gf_mon].
  apply rclo5_dist in PR; [|apply CMP|apply DIST].
  destruct PR; [|right; apply H].
  left. revert x0 x1 x2 x3 x4 H.
  pcofix CIH; intros.
  apply rclo5_wcompat in H0; [|apply gf_mon|apply CMP].
  pstep. eapply gf_mon. apply H0. clear  x0 x1 x2 x3 x4 H0. intros.
  apply gpaco5_unfold in PR; [|apply gf_mon].
  apply rclo5_compose in PR.
  apply rclo5_dist in PR; [|apply CMP|apply DIST].
  destruct PR.
  - right. apply CIH.
    eapply rclo5_mon. apply H. intros.
    eapply gf_mon. apply PR. intros.
    apply gpaco5_gupaco. apply gf_mon.
    apply gpaco5_gen_rclo. apply gf_mon.
    eapply gupaco5_mon. apply PR0. intros.
    destruct PR1; apply H0.
  - assert (REL: @rclo5 clo (rclo5 clo (gf (gupaco5 gf clo ((rg \5/ r) \5/ (rg \5/ r))) \5/ (rg \5/ r))) x0 x1 x2 x3 x4).
    { eapply rclo5_mon. apply H. intros. apply gpaco5_unfold in PR. apply PR. apply gf_mon. }
    apply rclo5_rclo in REL.
    apply rclo5_dist in REL; [|apply CMP|apply DIST].
    right. destruct REL; cycle 1.
    + apply CIH0, H0.
    + apply CIH.
      eapply rclo5_mon. apply H0. intros.
      eapply gf_mon. apply PR. intros.
      eapply gupaco5_mon. apply PR0. intros.
      destruct PR1; apply H1.
Qed.

Lemma gpaco5_dist_reverse clo r rg:
  (paco5 gf (rclo5 clo (rg \5/ r)) \5/ rclo5 clo r) <5= gpaco5 gf clo r rg.
Proof.
  intros. destruct PR; cycle 1.
  - eapply gpaco5_rclo. apply H.
  - econstructor. apply rclo5_base. left.
    revert x0 x1 x2 x3 x4 H. pcofix CIH; intros.
    _punfold H0; [|apply gf_mon]. pstep.
    eapply gf_mon. apply H0. intros.
    destruct PR.
    + apply rclo5_base. right. apply CIH, H.
    + eapply rclo5_mon. apply H. intros.
      right. apply CIH0. apply PR.
Qed.

End Distributivity.

Section Companion.

Variable gf: rel -> rel.
Hypothesis gf_mon: monotone5 gf.

Inductive cpn5 (r: rel) x0 x1 x2 x3 x4 : Prop :=
| cpn5_intro
    clo
    (COM: compatible5 gf clo)
    (CLO: clo r x0 x1 x2 x3 x4)
.

Lemma cpn5_mon: monotone5 cpn5.
Proof.
  red. intros.
  destruct IN. exists clo.
  - apply COM.
  - eapply compat5_mon; [apply COM|apply CLO|apply LE].
Qed.

Lemma cpn5_greatest: forall clo (COM: compatible5 gf clo), clo <6= cpn5.
Proof. intros. econstructor;[apply COM|apply PR]. Qed.

Lemma cpn5_compat: compatible5 gf cpn5.
Proof.
  econstructor; [apply cpn5_mon|intros].
  destruct PR; eapply gf_mon with (r:=clo r).
  - eapply (compat5_compat COM); apply CLO.
  - intros. econstructor; [apply COM|apply PR].
Qed.

Lemma cpn5_wcompat: wcompatible5 gf cpn5.
Proof. apply compat5_wcompat, cpn5_compat. apply gf_mon. Qed.

Lemma cpn5_gupaco:
  gupaco5 gf cpn5 <6= cpn5.
Proof.
  intros. eapply cpn5_greatest, PR. apply wcompat5_compat. apply gf_mon. apply cpn5_wcompat.
Qed.

Lemma cpn5_cpn r:
  cpn5 (cpn5 r) <5= cpn5 r.
Proof.
  intros. apply cpn5_gupaco, gpaco5_gupaco, gpaco5_clo. apply gf_mon.
  eapply cpn5_mon, gpaco5_clo. apply PR.
Qed.

Lemma cpn5_base r:
  r <5= cpn5 r.
Proof.
  intros. apply cpn5_gupaco. apply gpaco5_base, PR.
Qed.

Lemma cpn5_clo
      r clo (LE: clo <6= cpn5):
  clo (cpn5 r) <5= cpn5 r.
Proof.
  intros. apply cpn5_cpn, LE, PR.
Qed.

Lemma cpn5_step r:
  gf (cpn5 r) <5= cpn5 r.
Proof.
  intros. apply cpn5_gupaco. apply gpaco5_step. apply gf_mon.
  eapply gf_mon, gpaco5_clo. apply PR.
Qed.

Lemma cpn5_uclo uclo
      (MON: monotone5 uclo)
      (WCOM: forall r, uclo (gf r) <5= gf (gupaco5 gf (uclo \6/ cpn5) r)):
  uclo <6= gupaco5 gf cpn5.
Proof.
  intros. apply gpaco5_clo.
  exists (gupaco5 gf (uclo \6/ cpn5)).
  - apply wcompat5_compat. apply gf_mon.
    econstructor.
    + apply monotone5_union. apply MON. apply cpn5_mon.
    + intros. destruct PR0.
      * apply WCOM, H.
      * apply compat5_compat with (gf:=gf) in H; [| apply cpn5_compat].
        eapply gf_mon. apply H. intros.
        apply gpaco5_clo. right. apply PR0.
  - apply gpaco5_clo. left. apply PR.
Qed.

End Companion.

Section Respectful.

Variable gf: rel -> rel.
Hypothesis gf_mon: monotone5 gf.

Structure wrespectful5 (clo: rel -> rel) : Prop :=
  wrespect5_intro {
      wrespect5_mon: monotone5 clo;
      wrespect5_respect :
        forall l r
               (LE: l <5= r)
               (GF: l <5= gf r),
        clo l <5= gf (rclo5 clo r);
    }.

Structure prespectful5 (clo: rel -> rel) : Prop :=
  prespect5_intro {
      prespect5_mon: monotone5 clo;
      prespect5_respect :
        forall l r
               (LE: l <5= r)
               (GF: l <5= gf r),
        clo l <5= paco5 gf (r \5/ clo r);
    }.

Structure grespectful5 (clo: rel -> rel) : Prop :=
  grespect5_intro {
      grespect5_mon: monotone5 clo;
      grespect5_respect :
        forall l r
               (LE: l <5= r)
               (GF: l <5= gf r),
        clo l <5= rclo5 (cpn5 gf) (gf (rclo5 (clo \6/ gupaco5 gf (cpn5 gf)) r));
    }.

Definition gf'5 := id /6\ gf.

Definition compatible'5 := compatible5 gf'5.

Lemma wrespect5_compatible'
      clo (RES: wrespectful5 clo):
  compatible'5 (rclo5 clo).
Proof.
  intros. econstructor. apply rclo5_mon.
  intros. destruct RES. split.
  { eapply rclo5_mon. apply PR. intros. apply PR0. }
  induction PR; intros.
  - eapply gf_mon. apply IN.
    intros. apply rclo5_base, PR.
  - eapply gf_mon.
    + eapply wrespect5_respect0; [|apply H|apply IN].
      intros. eapply rclo5_mon; intros; [apply LE, PR|apply PR0].
    + intros. apply rclo5_rclo, PR.
Qed.

Lemma prespect5_compatible'
      clo (RES: prespectful5 clo):
  compatible'5 (fun r => upaco5 gf (r \5/ clo r)).
Proof.
  econstructor.
  { red; intros. eapply upaco5_mon. apply IN.
    intros. destruct PR.
    - left. apply LE, H.
    - right. eapply RES. apply H. intros. apply LE, PR. }

  intros r.
  assert (LEM: (gf'5 r \5/ clo (gf'5 r)) <5= (r \5/ clo r)).
  { intros. destruct PR.
    - left. apply H.
    - right. eapply RES. apply H. intros. apply PR.
  }

  intros. destruct PR.
  - split.
    + left. eapply paco5_mon. apply H. apply LEM.
    + apply paco5_unfold; [apply gf_mon|].
      eapply paco5_mon. apply H. apply LEM.
  - split.
    + right. apply LEM. apply H.
    + destruct H.
      * eapply gf_mon. apply H. intros. right. left. apply PR.
      * apply paco5_unfold; [apply gf_mon|].
        eapply RES, H; intros; apply PR.
Qed.

Lemma grespect5_compatible'
      clo (RES: grespectful5 clo):
  compatible'5 (rclo5 (clo \6/ cpn5 gf)).
Proof.
  apply wrespect5_compatible'.
  econstructor.
  { red; intros. destruct IN.
    - left. eapply RES; [apply H|]. apply LE.
    - right. eapply cpn5_mon; [apply H|]. apply LE. }
  intros. destruct PR.
  - eapply RES.(grespect5_respect) in H; [|apply LE|apply GF].
    apply (@compat5_compat gf (rclo5 (cpn5 gf))) in H.
    2: { apply rclo5_compat; [apply gf_mon|]. apply cpn5_compat. apply gf_mon. }
    eapply gf_mon; [apply H|].
    intros. apply rclo5_clo. right.
    exists (rclo5 (cpn5 gf)).
    { apply rclo5_compat; [apply gf_mon|]. apply cpn5_compat. apply gf_mon. }
    eapply rclo5_mon; [eapply PR|].
    intros. eapply rclo5_mon_gen; [eapply PR0|..].
    + intros. destruct PR1.
      * left. apply H0.
      * right. apply cpn5_gupaco; [apply gf_mon|apply H0].
    + intros. apply PR1.
  - eapply gf_mon.
    + apply (@compat5_compat gf (rclo5 (cpn5 gf))).
      { apply rclo5_compat; [apply gf_mon|]. apply cpn5_compat. apply gf_mon. }
      eapply rclo5_clo_base. eapply cpn5_mon; [apply H|apply GF].
    + intros. eapply rclo5_mon_gen; [eapply PR|..].
      * intros. right. apply PR0.
      * intros. apply PR0.
Qed.

Lemma compat5_compatible'
      clo (COM: compatible5 gf clo):
  compatible'5 clo.
Proof.
  destruct COM. econstructor; [apply compat5_mon0|].
  intros. split.
  - eapply compat5_mon0; intros; [apply PR| apply PR0].
  - apply compat5_compat0.
    eapply compat5_mon0; intros; [apply PR| apply PR0].
Qed.

Lemma compatible'5_companion
      clo (RES: compatible'5 clo):
  clo <6= cpn5 gf.
Proof.
  assert (MON: monotone5 gf'5).
  { econstructor. apply LE, IN.
    eapply gf_mon, LE. apply IN.
  }
  assert (CPN: clo <6= cpn5 gf'5).
  { intros. econstructor. apply RES. apply PR.
  }
  intros. apply CPN in PR.
  econstructor; [|apply PR].
  econstructor; [apply cpn5_mon|]; intros.
  assert (PR1: cpn5 gf'5 (gf r) <5= cpn5 gf'5 (gf'5 (cpn5 gf r))).
  { intros. eapply cpn5_mon. apply PR1.
    intros. assert (TMP: gf (cpn5 gf r) <5= (cpn5 gf r /5\ gf (cpn5 gf r))).
    { split; [apply cpn5_step; [apply gf_mon|]|]; assumption. }
    apply TMP.
    eapply gf_mon. apply PR2. intros. apply cpn5_base; assumption.
  }
  apply PR1 in PR0. clear PR1.
  eapply compat5_compat with (gf:=gf'5) in PR0; [|apply cpn5_compat, MON].
  eapply gf_mon; [apply PR0|].
  intros. eapply cpn5_cpn; [apply MON|].
  eapply cpn5_mon; [apply PR1|].
  intros. econstructor; [|apply PR2].
  apply compat5_compatible', cpn5_compat, gf_mon.
Qed.

Lemma wrespect5_companion
      clo (RES: wrespectful5 clo):
  clo <6= cpn5 gf.
Proof.
  intros. eapply wrespect5_compatible' in RES.
  eapply (@compatible'5_companion (rclo5 clo)) in RES; [apply RES|].
  eapply rclo5_clo_base, PR.
Qed.

Lemma prespect5_companion
      clo (RES: prespectful5 clo):
  clo <6= cpn5 gf.
Proof.
  intros. eapply compatible'5_companion. apply prespect5_compatible'. apply RES.
  right. right. apply PR.
Qed.

Lemma grespect5_companion
      clo (RES: grespectful5 clo):
  clo <6= cpn5 gf.
Proof.
  intros. eapply grespect5_compatible' in RES.
  eapply (@compatible'5_companion (rclo5 (clo \6/ cpn5 gf))); [apply RES|].
  apply rclo5_clo_base. left. apply PR.
Qed.

Lemma wrespect5_uclo
      clo (RES: wrespectful5 clo):
  clo <6= gupaco5 gf (cpn5 gf).
Proof.
  intros. eapply gpaco5_clo, wrespect5_companion, PR. apply RES.
Qed.

Lemma prespect5_uclo
      clo (RES: prespectful5 clo):
  clo <6= gupaco5 gf (cpn5 gf).
Proof.
  intros. eapply gpaco5_clo, prespect5_companion, PR. apply RES.
Qed.

Lemma grespect5_uclo
      clo (RES: grespectful5 clo):
  clo <6= gupaco5 gf (cpn5 gf).
Proof.
  intros. eapply gpaco5_clo, grespect5_companion, PR. apply RES.
Qed.

End Respectful.

End GeneralizedPaco5.

#[export] Hint Resolve gpaco5_def_mon : paco.
#[export] Hint Unfold gupaco5 : paco.
#[export] Hint Resolve gpaco5_base : paco.
#[export] Hint Resolve gpaco5_step : paco.
#[export] Hint Resolve gpaco5_final : paco.
#[export] Hint Resolve rclo5_base : paco.
#[export] Hint Constructors gpaco5 : paco.
#[export] Hint Resolve wrespect5_uclo : paco.
#[export] Hint Resolve prespect5_uclo : paco.


Require Import Coqlib.
Require Import Errors.
Require Import Integers.
Require Import Tree.
Require Import String.
Require Import Asm.

Require TransExpression.
Require TransBranchInfo.

Local Open Scope error_monad_scope.

Set Implicit Arguments.

Fixpoint cons_branch_info_list (cl : list (list condition)) (sl : list statement) : res (list branch_info) :=
  match cl with
  | nil =>
    OK nil
  | hd :: tl =>
    do v2 <- cons_branch_info_list tl sl;
    OK ({| cond := hd; stmt := sl |} :: v2)
  end.

Definition trans_if_branch
  (ib : if_branch)
  (pil : list pin_info) : res (list branch_info) :=
  match ib with
  | If_Branch expr stmt_list =>
    do expr_list <- TransExpression.reorder_expression expr;
    do cond_list_list <- TransExpression.layer_expression_list_to_condition_list expr_list pil;
    cons_branch_info_list cond_list_list stmt_list
  end.

Fixpoint trans_if_branch_list
  (ibl : list if_branch)
  (pil : list pin_info) : res (list branch_info) :=
  match ibl with
  | nil =>
    OK nil
  | hd :: tl =>
    do v1 <- trans_if_branch hd pil;
    do v2 <- trans_if_branch_list tl pil;
    OK (v1 ++ v2)
  end.

Definition trans_select_statement
  (s : select_statement)
  (pil : list pin_info) : res (list branch_info) :=
  match s with
  | As_If if_stmt =>
    match if_stmt with
    | If_Statement if_branch_list else_branch =>
      trans_if_branch_list if_branch_list pil
    end
  | As_Simple simple_stmt =>
    OK ({| cond := nil; stmt := (simple_stmt :: nil) |} :: nil)
  end.

Fixpoint trans_select_statement_list
  (sl : list select_statement)
  (pil : list pin_info) : res (list branch_info) :=
  match sl with
  | nil =>
    OK nil
  | hd :: tl =>
    do v1 <- trans_select_statement hd pil;
    do v2 <- trans_select_statement_list tl pil;
    TransBranchInfo.multiply_branch_info v1 v2
  end.

Definition translate
  (sl : list select_statement)
  (pil : list pin_info) : res (list branch_info) :=
  trans_select_statement_list sl pil.


Require Import Coq.Program.Basics.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Combinators.
Require Import Setoid.
Require Import ZArith.
Require Import Psatz.

Require Import FinProof.Common.
Require Import FinProof.CommonInstances.
Require Import FinProof.StateMonad2.
Require Import FinProof.StateMonadInstances.
Require Import FinProof.ProgrammingWith.

Local Open Scope struct_scope.

Require Import FinProof.CommonProofs.
Require Import depoolContract.ProofEnvironment.
Require Import depoolContract.DePoolClass.
Require Import depoolContract.SolidityNotations.

Require Import depoolContract.NewProofs.ProofHelpers.
Require Import depoolContract.DePoolFunc.

(* Set Typeclasses Iterative Deepening.
Set Typeclasses Depth 100. *)

Require Import depoolContract.Lib.CommonModelProofs.
Module CommonModelProofs := CommonModelProofs StateMonadSig.
Import CommonModelProofs.
Require Import depoolContract.Lib.Tactics.
Require Import depoolContract.Lib.ErrorValueProofs.
Require Import depoolContract.Lib.CommonCommon.

(* Require Import MultiSigWallet.Proofs.tvmFunctionsProofs. *)

Import DePoolSpec.LedgerClass.SolidityNotations.

Local Open Scope struct_scope.
Local Open Scope Z_scope.
Local Open Scope solidity_scope.
Require Import Lists.List.
Import ListNotations.
Local Open Scope list_scope.

Require Import depoolContract.DePoolConsts.
Module RoundsBase_Ф_stakeSum (dc : DePoolConstsTypesSig XTypesSig StateMonadSig).
Module DePoolFuncs := DePoolFuncs XTypesSig StateMonadSig dc.
Module ProofHelpers := ProofHelpers dc.

Import dc.
Import ProofHelpers.
Import DePoolFuncs.
Import DePoolSpec.
Import LedgerClass.

Lemma RoundsBase_Ф_stakeSum_exec : forall (stakes: RoundsBase_ι_StakeValue)
                                          (l: Ledger) ,
    exec_state (↓ RoundsBase_Ф_stakeSum stakes) l = l .
Proof.
  intros.
  destruct l. compute.
  repeat destructIf; auto.
Qed.

Lemma RoundsBase_Ф_stakeSum_eval : forall (stakes: RoundsBase_ι_StakeValue)
                                          (l: Ledger) ,
let ordStake := RoundsBase_ι_StakeValue_ι_ordinary stakes in
let vestingStake := RoundsBase_ι_InvestParams_ι_remainingAmount (maybeGet (RoundsBase_ι_StakeValue_ι_vesting stakes)) in
let lockStake := RoundsBase_ι_InvestParams_ι_remainingAmount (maybeGet (RoundsBase_ι_StakeValue_ι_lock stakes)) in

    eval_state (↓ RoundsBase_Ф_stakeSum stakes) l = ordStake + vestingStake + lockStake.
Proof.
  intros.
  destruct l. compute.
  destruct stakes;
  destruct RoundsBase_ι_StakeValue_ι_vesting;
  destruct RoundsBase_ι_StakeValue_ι_lock; try lia.
Qed.

Lemma RoundsBase_Ф_stakeSum_run : forall (stakes: RoundsBase_ι_StakeValue)
                                          (l: Ledger) ,
let ordStake := RoundsBase_ι_StakeValue_ι_ordinary stakes in
let vestingStake := RoundsBase_ι_InvestParams_ι_remainingAmount (maybeGet (RoundsBase_ι_StakeValue_ι_vesting stakes)) in
let lockStake := RoundsBase_ι_InvestParams_ι_remainingAmount (maybeGet (RoundsBase_ι_StakeValue_ι_lock stakes)) in

    run (↓ RoundsBase_Ф_stakeSum stakes) l = (ordStake + vestingStake + lockStake, l).
Proof.
  intros.
  rewrite run_eval_exec.
  rewrite RoundsBase_Ф_stakeSum_eval ,  RoundsBase_Ф_stakeSum_exec.
  auto.
Qed.

End RoundsBase_Ф_stakeSum.


Require Import Fiat.Common Fiat.Computation
        Fiat.ADT.ADTSig Fiat.ADT.Core
        Fiat.ADTRefinement.Core Fiat.ADTRefinement.GeneralRefinements
        Fiat.ADTRefinement.SetoidMorphisms.

Section DelegateMethods.

  (* One way to implement some common functionality is to delegate it
     to the methods of some ADT.

     The first step in this process is to augment the representation
     of the delegating ADT with an instance of the ADT to delegate to.
     *)

  (* Signature of the ADT doing the delegating. *)
  Variable delegatorSig : ADTSig.

  (* ADT doing the delegating. *)
  Variable delegatorADT : ADT delegatorSig.

  (* Indices of the methods that will be delegated to. *)
  Variable delegateIndex : Type.

  (* Codomain of the new methods. *)
  Variable delegateCod : MethodIndex delegatorSig -> option Type.

  (* Signature of the ADT being delegated to. *)
  Definition delegateSig :=
    {| ConstructorIndex := ConstructorIndex delegatorSig;
       MethodIndex := MethodIndex delegatorSig;
       ConstructorDom := ConstructorDom delegatorSig;
       MethodDomCod idx :=
         (fst (MethodDomCod delegatorSig idx), delegateCod idx)
    |}.

  (* ADT being delegated to. *)
  Variable delegateADT : ADT delegateSig.

  Local Open Scope comp_scope.

  (*Definition ADTwDelegatedMethods : ADT delegatorSig :=
    {| Rep := Rep delegatorADT * Rep delegateADT;
       Constructors idx x :=
         (r1 <- Constructors delegatorADT idx x;
          r2 <- Constructors delegateADT idx x;
          ret (r1, r2));
       Methods idx r x :=
         (r1 <- Methods delegatorADT idx (fst r) x;
          r2 <- Methods delegateADT idx (snd r) x;
          ret ((fst r1, fst r2), snd r1 ))
    |}.

  Lemma refineADT_DelegatedMethods :
    refineADT delegatorADT ADTwDelegatedMethods.
  Proof.
    unfold ADTwDelegatedMethods; destruct delegatorADT;
    eapply refineADT_Build_ADT_Rep with
    (AbsR := fun or nr => or = fst nr); simpl; intros; subst.
    - unfold refine; intros; computes_to_inv; subst;
      computes_to_econstructor; eauto.
    - f_equiv; unfold pointwise_relation, refine; intros.
      computes_to_inv; subst.
      repeat computes_to_econstructor; eauto.
  Qed. *)

End DelegateMethods.


Require Import Coq.Sets.Ensembles.

Require Import SpecCert.Address.
Require Import SpecCert.Formalism.
Require Import SpecCert.Smm.Delta.Behavior.
Require Import SpecCert.Smm.Delta.Invariant.
Require Import SpecCert.Smm.Delta.Secure.Secure_def.
Require Import SpecCert.Smm.Software.
Require Import SpecCert.x86.

Lemma lock_smramc_inv_is_secure:
  inv_is_secure LockSmramc.
Proof.
  trivial_inv_is_secure.
Qed.