From Hammer Require Import Hammer.

Require Import ExtLib.Structures.Maps.
Require Import ExtLib.Structures.Functor.
Require Import ExtLib.Data.Option.
Require Import ExtLib.Data.Positive.
Require Import ExtLib.Tactics.Cases.

Set Implicit Arguments.
Set Strict Implicit.

Section pmap.
Variable T : Type.
Inductive pmap : Type :=
| Empty
| Branch : option T -> pmap -> pmap -> pmap.

Definition pmap_here (m : pmap) : option T :=
match m with
| Empty => None
| Branch d _ _ => d
end.

Definition pmap_left (m : pmap) : pmap :=
match m with
| Empty => Empty
| Branch _ l _ => l
end.

Definition pmap_right (m : pmap) : pmap :=
match m with
| Empty => Empty
| Branch _ _ r => r
end.

Fixpoint pmap_lookup (p : positive) (m : pmap) {struct p} : option T :=
match m with
| Empty => None
| Branch d l r =>
match p with
| xH => d
| xO p => pmap_lookup p l
| xI p => pmap_lookup p r
end
end.

Fixpoint pmap_insert (p : positive) (v : T) (m : pmap) {struct p} : pmap :=
match p with
| xH => Branch (Some v) (pmap_left m) (pmap_right m)
| xO p =>
Branch (pmap_here m) (pmap_insert p v (pmap_left m)) (pmap_right m)
| xI p =>
Branch (pmap_here m) (pmap_left m) (pmap_insert p v (pmap_right m))
end.

Definition branch (o : option T) (l r : pmap) : pmap :=
match o , l , r with
| None , Empty , Empty => Empty
| _ , _ , _ => Branch o l r
end.

Fixpoint pmap_remove (p : positive) (m : pmap) {struct p} : pmap :=
match m with
| Empty => Empty
| Branch d l r =>
match p with
| xH => branch None l r
| xO p => branch d (pmap_remove p l) r
| xI p => branch d l (pmap_remove p r)
end
end.

Definition pmap_empty : pmap := Empty.

Fixpoint pmap_union (f m : pmap) : pmap :=
match f with
| Empty => m
| Branch d l r =>
Branch (match d with
| Some x => Some x
| None => pmap_here m
end) (pmap_union l (pmap_left m)) (pmap_union r (pmap_right m))
end.

Global Instance Map_pmap : Map positive T pmap :=
{ empty := pmap_empty
; add := pmap_insert
; remove := pmap_remove
; lookup := pmap_lookup
; union := pmap_union
}.

Lemma tilde_1_inj_neg : forall k k',
(k~1)%positive <> (k'~1)%positive -> k <> k'.
Proof. hammer_hook "FMapPositive" "FMapPositive.tilde_1_inj_neg".
induction k; destruct k'; intuition;
try match goal with
| H : _ = _ |- _ => inversion H; clear H; subst
end; intuition eauto.
Qed.

Lemma tilde_0_inj_neg : forall k k',
(k~0)%positive <> (k'~0)%positive -> k <> k'.
Proof. hammer_hook "FMapPositive" "FMapPositive.tilde_0_inj_neg".
induction k; destruct k'; intuition;
try match goal with
| H : _ = _ |- _ => inversion H; clear H; subst
end; intuition eauto.
Qed.

Lemma pmap_lookup_insert_empty : forall k k' v,
k <> k' ->
pmap_lookup k' (pmap_insert k v Empty) = None.
Proof. hammer_hook "FMapPositive" "FMapPositive.pmap_lookup_insert_empty".
induction k; destruct k'; simpl; intros;
eauto using tilde_0_inj_neg, tilde_1_inj_neg.
destruct k'; simpl; auto.
destruct k'; simpl; auto.
destruct k'; simpl; auto.
destruct k'; simpl; auto.
congruence.
Qed.

Lemma lookup_empty : forall k, pmap_lookup k Empty = None.
Proof. hammer_hook "FMapPositive" "FMapPositive.lookup_empty".
destruct k; reflexivity.
Qed.

Hint Rewrite lookup_empty pmap_lookup_insert_empty
using (eauto using tilde_1_inj_neg, tilde_1_inj_neg) : pmap_rw.

Lemma pmap_lookup_insert_eq
: forall (m : pmap) (k : positive) (v : T),
pmap_lookup k (pmap_insert k v m) = Some v.
Proof. hammer_hook "FMapPositive" "FMapPositive.pmap_lookup_insert_eq".
intros m k; revert m.
induction k; simpl; intros; forward; Cases.rewrite_all_goal; eauto.
Qed.

Lemma pmap_lookup_insert_Some_neq
: forall (m : pmap) (k : positive) (v : T) (k' : positive),
k <> k' ->
forall v' : T,
pmap_lookup k' m = Some v' <-> pmap_lookup k' (pmap_insert k v m) = Some v'.
Proof. hammer_hook "FMapPositive" "FMapPositive.pmap_lookup_insert_Some_neq".
intros m k; revert m.
induction k; simpl; intros; forward; Cases.rewrite_all_goal;
autorewrite with pmap_rw; eauto.
{ destruct k'; simpl; destruct m; simpl;
autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity.
erewrite IHk; eauto using tilde_1_inj_neg. reflexivity. }
{ destruct k'; simpl; destruct m; simpl;
autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity; try congruence.
erewrite IHk. reflexivity. eauto using tilde_0_inj_neg. }
{ destruct k'; simpl; destruct m; simpl;
autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity; try congruence. }
Qed.

Lemma pmap_lookup_insert_None_neq
: forall (m : pmap) (k : positive) (v : T) (k' : positive),
k <> k' ->
pmap_lookup k' m = None <-> pmap_lookup k' (pmap_insert k v m) = None.
Proof. hammer_hook "FMapPositive" "FMapPositive.pmap_lookup_insert_None_neq".
intros m k; revert m.
induction k; simpl; intros; forward; Cases.rewrite_all_goal;
autorewrite with pmap_rw; eauto.
{ destruct k'; simpl; destruct m; simpl;
autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity.
erewrite IHk; eauto using tilde_1_inj_neg. reflexivity. }
{ destruct k'; simpl; destruct m; simpl;
autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity; try congruence.
erewrite IHk. reflexivity. eauto using tilde_0_inj_neg. }
{ destruct k'; simpl; destruct m; simpl;
autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity; try congruence. }
Qed.

Lemma pmap_lookup_insert_neq
: forall (m : pmap) (k : positive) (v : T) (k' : positive),
k <> k' ->
forall v' : T,
pmap_lookup k' (pmap_insert k v m) = pmap_lookup k' m.
Proof. hammer_hook "FMapPositive" "FMapPositive.pmap_lookup_insert_neq".
intros.
remember (pmap_lookup k' m).
destruct o; [
apply pmap_lookup_insert_Some_neq; intuition |
apply pmap_lookup_insert_None_neq; intuition].
Qed.

Lemma pmap_lookup_remove_eq
: forall (m : pmap) (k : positive) (v : T),
pmap_lookup k (pmap_remove k m) <> Some v.
Proof. hammer_hook "FMapPositive" "FMapPositive.pmap_lookup_remove_eq".
induction m; destruct k; simpl; intros; try congruence.
{ destruct o; simpl; eauto.
destruct m1; simpl; eauto.
destruct (pmap_remove k m2) eqn:?; try congruence.
rewrite <- Heqp. eauto. }
{ destruct o; simpl; eauto.
destruct (pmap_remove k m1) eqn:?; try congruence.
- destruct m2; try congruence; eauto.
destruct k; simpl; congruence.
- rewrite <- Heqp. eauto. }
{ destruct m1; try congruence.
destruct m2; try congruence. }
Qed.

Lemma pmap_lookup_remove_neq
: forall (m : pmap) (k k' : positive),
k <> k' ->
forall v' : T, pmap_lookup k' m = Some v' <-> pmap_lookup k' (pmap_remove k m) = Some v'.
Proof. hammer_hook "FMapPositive" "FMapPositive.pmap_lookup_remove_neq".
induction m.
Local Ltac t :=
unfold branch;
repeat match goal with
| |- context [ match ?X with _ => _ end ] =>
lazymatch X with
| match _ with _ => _ end => fail
| _ => destruct X eqn:?; subst; try tauto
end
end.
{ destruct k; simpl; split; try congruence. }
{ destruct k', k; simpl; intros; try solve [ t; rewrite lookup_empty; tauto ].
{ assert (k <> k') by congruence.
rewrite IHm2; eauto. simpl. t. rewrite lookup_empty. tauto. }
{ assert (k <> k') by congruence.
rewrite IHm1; eauto. simpl. t. rewrite lookup_empty. tauto. } }
Qed.

Global Instance MapOk_pmap : MapOk (@eq _) Map_pmap.
Proof. hammer_hook "FMapPositive" "FMapPositive.MapOk_pmap".
refine {| mapsto := fun k v m => pmap_lookup k m = Some v |}.
{ abstract (induction k; simpl; congruence). }
{ abstract (induction k; simpl; intros; forward). }
{ eauto using pmap_lookup_insert_eq. }
{ eauto using pmap_lookup_insert_Some_neq. }
{ eauto using pmap_lookup_remove_eq. }
{ eauto using pmap_lookup_remove_neq. }
Defined.

Definition from_list : list T -> pmap :=
(fix from_list acc i ls {struct ls} :=
match ls with
| nil => acc
| List.cons l ls =>
from_list (pmap_insert i l acc) (Pos.succ i) ls
end) Empty 1%positive.

End pmap.

Arguments Empty {_}.
Arguments Branch {_} _ _ _.

Section fmap.
Variables T U : Type.
Variable f : T -> U.

Fixpoint fmap_pmap (m : pmap T) : pmap U :=
match m with
| Empty => Empty
| Branch h l r => Branch (fmap f h) (fmap_pmap l) (fmap_pmap r)
end.

Theorem fmap_lookup : forall a b m,
mapsto a b m ->
mapsto a (f b) (fmap_pmap m).
Proof. hammer_hook "FMapPositive" "FMapPositive.fmap_lookup".
induction a; destruct m; simpl; intros; try congruence.
{ eapply IHa. eapply H. }
{ eapply IHa; eapply H. }
{ subst. auto. }
Qed.

Theorem fmap_lookup_bk : forall a b m,
mapsto a b (fmap_pmap m) ->
exists b', mapsto a b' m /\ f b' = b.
Proof. hammer_hook "FMapPositive" "FMapPositive.fmap_lookup_bk".
induction a; destruct m; simpl; intros; try congruence.
{ eapply IHa. eapply H. }
{ eapply IHa. eapply H. }
{ destruct o; try congruence. eexists; split; eauto. inversion H; auto. }
Qed.

End fmap.

Require Import ExtLib.Core.Type.

Section type.
Variable T : Type.
Variable tT : type T.

Instance type_pmap : type (pmap T) :=
type_from_equal
(fun l r =>
(forall k v,
mapsto k v l -> exists v', mapsto k v' r /\ equal v v')
/\ (forall k v,
mapsto k v r -> exists v', mapsto k v' l /\ equal v v')).

End type.

Global Instance Functor_pmap : Functor pmap :=
{ fmap := fmap_pmap }.


(***
 * Oqarina
 * Copyright 2021 Carnegie Mellon University.
 *
 * NO WARRANTY. THIS CARNEGIE MELLON UNIVERSITY AND SOFTWARE ENGINEERING
 * INSTITUTE MATERIAL IS FURNISHED ON AN "AS-IS" BASIS. CARNEGIE MELLON
 * UNIVERSITY MAKES NO WARRANTIES OF ANY KIND, EITHER EXPRESSED OR
 * IMPLIED, AS TO ANY MATTER INCLUDING, BUT NOT LIMITED TO, WARRANTY OF
 * FITNESS FOR PURPOSE OR MERCHANTABILITY, EXCLUSIVITY, OR RESULTS
 * OBTAINED FROM USE OF THE MATERIAL. CARNEGIE MELLON UNIVERSITY DOES NOT
 * MAKE ANY WARRANTY OF ANY KIND WITH RESPECT TO FREEDOM FROM PATENT,
 * TRADEMARK, OR COPYRIGHT INFRINGEMENT.
 *
 * Released under a BSD (SEI)-style license, please see license.txt or
 * contact permission@sei.cmu.edu for full terms.
 *
 * [DISTRIBUTION STATEMENT A] This material has been approved for public
 * release and unlimited distribution.  Please see Copyright notice for
 * non-US Government use and distribution.
 *
 * This Software includes and/or makes use of the following Third-Party
 * Software subject to its own license:
 *
 * 1. Coq theorem prover (https://github.com/coq/coq/blob/master/LICENSE)
 * Copyright 2021 INRIA.
 *
 * 2. Coq JSON (https://github.com/liyishuai/coq-json/blob/comrade/LICENSE)
 * Copyright 2021 Yishuai Li.
 *
 * DM21-0762
***)

Require Import Coq.Lists.List.
Import ListNotations. (* from List *)

Require Import Oqarina.coq_utils.all.
Require Import Oqarina.core.all.
Import NaturalTime.
Require Import Oqarina.formalisms.DEVS.classic.all.
Require Import Oqarina.formalisms.lts.

Section Traffic_Light.

(*

Traffic Light example
=====================

In this section, we model the traffic light example from
:math:`\cite{vantendelooIntroductionClassicDEVS2018}`. This example is a direct transcription in Coq of the various types and functions definitions and yield no complexity. It is kept for testing and documentation purposes.

*)

Inductive X_tl :=
    | toAuto | toManual.

Inductive Y_tl :=
    | show_green | show_yellow | show_red | turn_off.

Inductive S_tl :=
    | GREEN | YELLOW | RED | GOING_MANUAL | GOING_AUTO | MANUAL.

Definition Q_tl : Type := Q S_tl.

Definition Q_init_tl : Q_tl := {| st := GREEN ; e := 0 |}.

Definition δint_tl (s : S_tl) : S_tl :=
    match s with
        | GREEN => YELLOW
        | YELLOW => RED
        | RED => GREEN
        | GOING_MANUAL => MANUAL
        | GOING_AUTO => RED
        | _ => s
    end.

Definition δext_tl (q : Q_tl) (x : X_tl) : S_tl :=
    match q.(st), x  with
        | GREEN,toManual => GOING_MANUAL
        | YELLOW, toManual => GOING_MANUAL
        | RED,toManual => GOING_MANUAL
        | MANUAL, toAuto => GOING_AUTO
        |  _, _ => q.(st)
    end.

Definition Y_output_tl : Type := Y_output Y_tl.

Definition λ_tl (s : S_tl) : Y_output_tl :=
    match s with
        | GREEN  => y show_yellow
        | YELLOW  => y show_red
        | RED  => y show_green
        | GOING_MANUAL  => y turn_off
        | GOING_AUTO  => y show_red
        | _ => no_output Y_tl
    end.

Definition ta_tl (s : S_tl) : Time :=
    match s with
        | GREEN  => 1
        | YELLOW  => 2
        | RED  => 3
        | GOING_MANUAL  => 0
        | GOING_AUTO  => 0
        | MANUAL => 10 (* infinity *)
    end.

(* From these specifications, we define the corresponding Coq data types.
First, a type representing the interface of a TrafficLight_Devs
(:coq:`TrafficLight_DEVS_Type`), then the DEVS atomic model itself.
*)

Definition TrafficLight_DEVS_type : Type := DEVS_Atomic_Model S_tl X_tl Y_tl.

Definition TrafficLight_DEVS : TrafficLight_DEVS_type := {|
    devs_atomic_id := (Id "TrafficLight");

    Q_init := Q_init_tl;

    ta := ta_tl;
    δint := δint_tl;
    λ := λ_tl ;
    δext := δext_tl;
|}.

(* Then, we instantiate the DEVS model to build on instance, or simulator. *)

Definition TrafficLight_DEVS_Simulator_type : Type :=
    DEVS_Simulator S_tl X_tl Y_tl.

Definition TL_Initial := Instantiate_DEVS_Simulator
    (Id "TrafficLighti") TrafficLight_DEVS.

(* From that point, we can simulate the Traffic Light. *)

Definition TL_Coordinator := Iniitialize_DEVS_Root_Coordinator TL_Initial.

Definition TLC_Step1 := DEVS_Simulation_Step TL_Coordinator None.
Lemma TLC_Step1_OK :
    (Print_DEVS_State TLC_Step1) = dbg 0 1 GREEN [].
Proof.
    trivial.
Qed.

Definition TLC_Step2 := DEVS_Simulation_Step TLC_Step1 None.
Lemma TLC_Step2_OK :
    (Print_DEVS_State TLC_Step2) = dbg 1 3 YELLOW [].
Proof.
    trivial.
Qed.

Definition TLC_Step3 := DEVS_Simulation_Step TLC_Step2 None.
Lemma TLC_Step3_OK :
    (Print_DEVS_State TLC_Step3) = dbg 3 6 RED [].
Proof.
    trivial.
Qed.

Definition TLC_Step4 := DEVS_Simulation_Step TLC_Step3 None.
Lemma TLC_Step4_OK :
    (Print_DEVS_State TLC_Step4) = dbg 6 7 GREEN [].
Proof.
    trivial.
Qed.

(* LTS variant of the Traffic LIght DEVS. We introduce a variant of the step
function that drops the output to compare the states with the previous
simulation run.*)

Definition TL_LTS := LTS_Of_DEVS TL_Initial.

Example TL_LTS_1 := step_lts (Init TL_LTS) (i X_tl Y_tl 0) .
Compute Print_DEVS_Simulator TL_LTS_1.

Lemma TL_LTS_1_OK :
    Print_DEVS_Simulator TL_LTS_1 = Print_DEVS_Simulator TLC_Step1.(astate).
Proof.
    trivial.
Qed.

End Traffic_Light.
(*| .. coq:: |*)

Section Traffic_Light_Coupled.
(*

Traffic Light couple example
============================

In this section, we build a naive coupled DEVS model out of the Traffic Light example. The coupled model is made of a single node. We use this as a first verification step that the coupled DEVS model made of one atonmic model has the same behavior.

*)

Definition Traffic_Light_Coupled := {|
    devs_coupled_model_id := Id "traffic_light_coupled" ;
    D := [ TL_Initial ] ;
    Select := @Default_Select_Function S_tl X_tl Y_tl ;
    Z_f :=  (fun (i : identifier) (y : Y_output_tl) => toManual) ;
    I := Default_I_Function;
|}.

Definition TL_coupled_atomic := Map_DEVS_Coupled_Model Traffic_Light_Coupled.

Definition TL_coupled_initial :=
    Instantiate_DEVS_Simulator (Id "traffic_light_coupled_instance")
    TL_coupled_atomic.

Definition TL_Coordinator_coupled := Iniitialize_DEVS_Root_Coordinator TL_coupled_initial.

Definition TLCC_Step1 := DEVS_Simulation_Step TL_Coordinator_coupled None.
Lemma TLCC_Step1_OK :
    (Print_DEVS_Simulator TLCC_Step1.(astate)) =
        dbg 0 1 [{| st := GREEN; e := 0 |}] [].
Proof.
    trivial.
Qed.

Definition TLCC_Step2 := DEVS_Simulation_Step TLCC_Step1 None.
Lemma TLCC_Step2_OK :
    (Print_DEVS_Simulator TLCC_Step2.(astate)) =
    dbg 1 3 [{| st := YELLOW; e := 0 |}] [].
Proof.
    trivial.
Qed.

Definition TLCC_Step3 := DEVS_Simulation_Step TLCC_Step2 None.
Lemma TLCC_Step3_OK :
    (Print_DEVS_Simulator TLCC_Step3.(astate)) =
    dbg 3 6 [{| st := RED; e := 0 |}] [].
Proof.
    trivial.
Qed.

Definition TLCC_Step4 := DEVS_Simulation_Step TLCC_Step3 None.
Lemma TLCC_Step4_OK :
    (Print_DEVS_Simulator TLCC_Step4.(astate)) =
    dbg 6 7 [{| st := GREEN; e := 0 |}] [].
Proof.
    trivial.
Qed.

End Traffic_Light_Coupled.
(*| .. coq:: |*)


Require Import Raft.
Require Import CommonDefinitions.
Require Import TraceUtil.

Section OutputImpliesApplied.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Section inner.

  Variables client id : nat.

  Definition in_applied_entries (net : network) : Prop :=
    exists e,
      eClient e = client /\
      eId e = id /\
      In e (applied_entries (nwState net)).

  End inner.

  Class output_implies_applied_interface : Prop :=
    {
      output_implies_applied :
        forall client id failed net tr,
          step_f_star step_f_init (failed, net) tr ->
          key_in_output_trace client id tr ->
          in_applied_entries client id net
    }.
End OutputImpliesApplied.


Require Import floyd.proofauto.
Local Open Scope logic.
Require Import List. Import ListNotations.
Require Import ZArith.
Require Import tweetnacl20140427.tweetNaclBase.
Require Import tweetnacl20140427.Salsa20.
Require Import tweetnacl20140427.verif_salsa_base.
Require Import tweetnacl20140427.tweetnaclVerifiableC.
Require Import tweetnacl20140427.Snuffle.
Require Import tweetnacl20140427.spec_salsa.

Require Import tweetnacl20140427.verif_fcore_jbody.

Opaque Snuffle.Snuffle.

Lemma SnuffleS i l: Snuffle (S i) l = bind (Snuffle i l) (Snuffle 1). reflexivity. Qed.

Fixpoint WcontI (xs: list int) (j:nat) (l:list val):Prop :=
   match j with O => Zlength l = 16
   | (S n) => Zlength l = 16 /\
              exists t0 t1 t2 t3,
              Znth ((5 * (Z.of_nat n) + 4 * 0) mod 16) (map Vint xs) Vundef = Vint t0 /\
              Znth ((5 * (Z.of_nat n) + 4 * 1) mod 16) (map Vint xs) Vundef = Vint t1 /\
              Znth ((5 * (Z.of_nat n) + 4 * 2) mod 16) (map Vint xs) Vundef = Vint t2 /\
              Znth ((5 * (Z.of_nat n) + 4 * 3) mod 16) (map Vint xs) Vundef = Vint t3 /\
              exists wl, WcontI xs n wl /\
                match Wcopyspec t0 t1 t2 t3 with
                 (s0,s1,s2,s3) => wlistJ' wl (Z.of_nat n) s0 s1 s2 s3 l
                end
  end.

Lemma WcontI_Zlength xs j l: WcontI xs j l -> Zlength l=16.
Proof. intros. destruct j; eapply H. Qed.

Lemma WWI r w (W: WcontI r 4 w) (R:Zlength r = 16):
      exists wi, w=map Vint wi /\ snuffleRound r = Some wi.
Proof.
apply listD16 in R.
destruct R as [x0 [x1 [x2 [x3 [x4 [x5 [x6 [x7
              [x8 [x9 [x10 [x11 [x12 [x13 [x14 [x15 XX]]]]]]]]]]]]]]]]. subst r.
destruct W as [HW H1].
destruct H1 as [t0 [t1 [t2 [t3 [T0 [T1 [T2 [T3 [w1 [[_ H1] W1]]]]]]]]]]. simpl in T0, T1, T2, T3.
rewrite Z.mod_small in T0. 2: omega.
rewrite Zmod_eq in T1. 2: omega.
rewrite Zmod_eq in T2. 2: omega.
rewrite Zmod_eq in T3. 2: omega. simpl in T0, T1, T2, T3.
destruct H1 as [t4 [t5 [t6 [t7 [T4 [T5 [T6 [T7 [w2 [[_ H1] W2]]]]]]]]]]. simpl in T4, T5, T6, T7.
rewrite Zmod_eq in T4. 2: omega.
rewrite Zmod_eq in T5. 2: omega.
rewrite Zmod_eq in T6. 2: omega.
rewrite Zmod_eq in T7. 2: omega. simpl in T4, T5, T6, T7.
destruct H1 as [t8 [t9 [t10 [t11 [T8 [T9 [T10 [T11 [w3 [[_ H1] W3]]]]]]]]]]. simpl in T8, T9, T10, T11.
rewrite Z.mod_small in T8. 2: omega.
rewrite Z.mod_small in T9. 2: omega.
rewrite Zmod_eq in T10. 2: omega.
rewrite Zmod_eq in T11. 2: omega. simpl in T8, T9, T10, T11.
destruct H1 as [t12 [t13 [t14 [t15 [T12 [T13 [T14 [T15 [w4 [L4 W4]]]]]]]]]]. simpl in T12, T13, T14, T15.
rewrite Z.mod_small in T12. 2: omega.
rewrite Z.mod_small in T13. 2: omega.
rewrite Z.mod_small in T14. 2: omega.
rewrite Z.mod_small in T15. 2: omega.
unfold Znth in *. simpl in  T0, T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, T12, T13, T14, T15.
symmetry in T0; inv T0. symmetry in T1; inv T1. symmetry in T2; inv T2. symmetry in T3; inv T3.
symmetry in T4; inv T4. symmetry in T5; inv T5. symmetry in T6; inv T6. symmetry in T7; inv T7.
symmetry in T8; inv T8. symmetry in T9; inv T9. symmetry in T10; inv T10. symmetry in T11; inv T11.
symmetry in T12; inv T12. symmetry in T13; inv T13. symmetry in T14; inv T14. symmetry in T15; inv T15.
red in L4.
simpl in W4.
remember (Int.xor x4 (Int.rol (Int.add x0 x12) (Int.repr 7))) as z1.
remember (Int.xor x8 (Int.rol (Int.add z1 x0) (Int.repr 9))) as z2.
remember (Int.xor x12 (Int.rol (Int.add z2 z1) (Int.repr 13))) as z3.
remember (Int.xor x0 (Int.rol (Int.add z3 z2) (Int.repr 18))) as z0.
apply listD16 in L4.
destruct L4 as [y0 [y1 [y2 [y3 [y4 [y5 [y6 [y7
               [y8 [y9 [y10 [y11 [y12 [y13 [y14 [y15 XX]]]]]]]]]]]]]]]]. subst w4.
destruct W4 as [_ W4]; simpl in W4.
(*rewrite Z.mod_small in W4. 2: omega.
rewrite Z.mod_small in W4. 2: omega.
rewrite Z.mod_small in W4. 2: omega.
rewrite Z.mod_small in W4. 2: omega.*)
unfold upd_Znth, sublist in W4; simpl in W4. subst w3.
simpl in W3.
remember (Int.xor x9 (Int.rol (Int.add x5 x1) (Int.repr 7))) as z6.
remember (Int.xor x13 (Int.rol (Int.add z6 x5) (Int.repr 9))) as z7.
remember (Int.xor x1 (Int.rol (Int.add z7 z6) (Int.repr 13))) as z4.
remember (Int.xor x5 (Int.rol (Int.add z4 z7) (Int.repr 18))) as z5.
destruct W3 as [_ W3]; simpl in W3.
unfold upd_Znth, sublist in W3; simpl in W3. subst w2.
destruct W2 as [_ W2]. simpl in W2.
remember (Int.xor x14 (Int.rol (Int.add x10 x6) (Int.repr 7))) as z11.
remember (Int.xor x2 (Int.rol (Int.add z11 x10) (Int.repr 9))) as z8.
remember (Int.xor x6 (Int.rol (Int.add z8 z11) (Int.repr 13))) as z9.
remember (Int.xor x10 (Int.rol (Int.add z9 z8) (Int.repr 18))) as z10.
unfold upd_Znth, sublist in W2; simpl in W2. subst w1.
destruct W1 as [_ W1]; simpl in W1.
remember (Int.xor x3 (Int.rol (Int.add x15 x11) (Int.repr 7))) as z12.
remember (Int.xor x7 (Int.rol (Int.add z12 x15) (Int.repr 9))) as z13.
remember (Int.xor x11 (Int.rol (Int.add z13 z12) (Int.repr 13))) as z14.
remember (Int.xor x15 (Int.rol (Int.add z14 z13) (Int.repr 18))) as z15.
unfold upd_Znth, sublist in W1; simpl in W1. subst w. clear HW.
exists [z0; z1; z2; z3; z4; z5; z6; z7;
        z8; z9; z10; z11; z12; z13; z14; z15].
split. reflexivity.
rewrite Int.add_commut in Heqz0, Heqz2, Heqz3, Heqz4, Heqz5, Heqz7, Heqz8,
  Heqz9, Heqz10, Heqz13, Heqz14, Heqz15.
subst z0 z1 z2 z3 z4 z5 z6 z7 z8 z9 z10 z11 z12 z13 z14 z15. reflexivity.
Qed.

Lemma array_copy3 Espec:
forall FR c k h nonce out
       i w x y t (xlist wlist:list val)
       (WZ: forall m, 0<=m<16 -> exists mval, Znth m wlist Vundef =Vint mval),
@semax CompSpecs Espec
  (initialized_list [_i; _j]
     (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs))
  (PROP  ()
   LOCAL  (temp _j (Vint (Int.repr 4)); temp _i (Vint (Int.repr i)); lvar _t (tarray tuint 4) t;
   lvar _y (tarray tuint 16) y; lvar _x (tarray tuint 16) x;
   lvar _w (tarray tuint 16) w; temp _in nonce; temp _out out; temp _c c;
   temp _k k; temp _h (Vint (Int.repr h)))
   SEP  (FR; data_at Tsh (tarray tuint 16) wlist w;
         data_at Tsh (tarray tuint 16) xlist x))
  (Sfor (Sset _m (Econst_int (Int.repr 0) tint))
     (Ebinop Olt (Etempvar _m tint) (Econst_int (Int.repr 16) tint) tint)
     (Ssequence
        (Sset _aux
           (Ederef
              (Ebinop Oadd (Evar _w (tarray tuint 16)) (Etempvar _m tint)
                 (tptr tuint)) tuint))
        (Sassign
           (Ederef
              (Ebinop Oadd (Evar _x (tarray tuint 16)) (Etempvar _m tint)
                 (tptr tuint)) tuint) (Etempvar _aux tuint)))
     (Sset _m
        (Ebinop Oadd (Etempvar _m tint) (Econst_int (Int.repr 1) tint) tint)))
  (normal_ret_assert
  (PROP  ()
   LOCAL  (temp _j (Vint (Int.repr 4)); temp _i (Vint (Int.repr i)); lvar _t (tarray tuint 4) t;
      lvar _y (tarray tuint 16) y; lvar _x (tarray tuint 16) x;
      lvar _w (tarray tuint 16) w; temp _in nonce; temp _out out; temp _c c;
      temp _k k; temp _h (Vint (Int.repr h)))
   SEP  (FR; data_at Tsh (tarray tuint 16) wlist w;
         data_at Tsh (tarray tuint 16) wlist x))).
Proof. intros. abbreviate_semax.
Time assert_PROP (Zlength wlist = 16 /\ Zlength xlist = 16) as WXL by entailer!. (*1.4 versus 5.4*)
destruct WXL as [WL XL].
Time forward_for_simple_bound 16 (EX m:Z,
  (PROP  ()
   LOCAL  (temp _j (Vint (Int.repr 4)); temp _i (Vint (Int.repr i)); lvar _t (tarray tuint 4) t;
   lvar _y (tarray tuint 16) y; lvar _x (tarray tuint 16) x;
   lvar _w (tarray tuint 16) w; temp _in nonce; temp _out out; temp _c c;
   temp _k k; temp _h (Vint (Int.repr h)))
   SEP  (FR; data_at Tsh (tarray tuint 16) wlist w;
         EX mlist:_, !!(forall mm, 0<=mm<m -> Znth mm mlist Vundef = Znth mm wlist Vundef)
                && data_at Tsh (tarray tuint 16) mlist x))).
  (*1.2 versus 2.7*)
{ Exists xlist. Time entailer!. (*2.6 versus 6.7*) intros; omega. }
{ Intros mlist. rename H into M. rename i0 into m. rename H0 into HM.
  destruct (WZ _ M) as [mval MVAL].
  freeze [0;2] FR1.
  Time forward; rewrite MVAL. (*3.5 versus 8.7*)
  Time solve[entailer!]. (*0.9 versus 3.3*)
  thaw FR1.
  Time assert_PROP (Zlength mlist = 16) as ML by entailer!. (*1.2 versus 3.5*)
  Time forward. (*3.2 versus 9*)
   { Exists (upd_Znth m mlist (Vint mval)).
     Time entailer!. (*2.8 versus 5.6*)
     intros mm ?.
     destruct (zeq mm m); subst.
     + rewrite MVAL, upd_Znth_same; trivial. omega.
     + rewrite <- HM. 2: omega.
       apply upd_Znth_diff; trivial; omega. }
}
{ Time entailer!. (*1.8 versus 4.3*)
  Intros mlist.
  assert_PROP (Zlength mlist = 16) as ML by entailer.
  apply derives_refl'. f_equal.
  eapply Znth_extensional with (d:=Vundef). omega.
  intros kk K. apply H1. omega. }
Time Qed. (*16.8*)

Lemma f_core_loop3: forall (Espec : OracleKind) FR
c k h nonce out w x y t (xI:list int),
@semax CompSpecs Espec
  (initialized_list [_i] (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs))
  (PROP  ()
   LOCAL  (temp _i (Vint (Int.repr 16)); lvar _t (tarray tuint 4) t;
   lvar _y (tarray tuint 16) y; lvar _x (tarray tuint 16) x;
   lvar _w (tarray tuint 16) w; temp _in nonce; temp _out out; temp _c c;
   temp _k k; temp _h (Vint (Int.repr h)))
   SEP  (FR; data_at_ Tsh (tarray tuint 4) t;
         data_at_ Tsh (tarray tuint 16) w;
         data_at Tsh (tarray tuint 16) (map Vint xI) x))
         (Sfor (Sset _i (Econst_int (Int.repr 0) tint))
            (Ebinop Olt (Etempvar _i tint) (Econst_int (Int.repr 20) tint) tint)
            (Ssequence
               (Sfor (Sset _j (Econst_int (Int.repr 0) tint))
                  (Ebinop Olt (Etempvar _j tint) (Econst_int (Int.repr 4) tint) tint)
                  (Ssequence
                     (Sfor (Sset _m (Econst_int (Int.repr 0) tint))
                        (Ebinop Olt (Etempvar _m tint) (Econst_int (Int.repr 4) tint) tint)
                        (Ssequence
                           (Sset _index
                              (Ebinop Omod
                                 (Ebinop Oadd
                                    (Ebinop Omul (Econst_int (Int.repr 5) tint)
                                       (Etempvar _j tint) tint)
                                    (Ebinop Omul (Econst_int (Int.repr 4) tint)
                                       (Etempvar _m tint) tint) tint) (Econst_int (Int.repr 16) tint)
                                 tint))
                           (Ssequence
                              (Sset _aux
                                 (Ederef
                                    (Ebinop Oadd (Evar _x (tarray tuint 16))
                                       (Etempvar _index tint) (tptr tuint)) tuint))
                              (Sassign
                                 (Ederef
                                    (Ebinop Oadd (Evar _t (tarray tuint 4))
                                       (Etempvar _m tint) (tptr tuint)) tuint)
                                 (Etempvar _aux tuint))))
                        (Sset _m (Ebinop Oadd (Etempvar _m tint) (Econst_int (Int.repr 1) tint) tint)))
                     (Ssequence
                        (Ssequence
                           (Sset _aux
                              (Ederef
                                 (Ebinop Oadd (Evar _t (tarray tuint 4))
                                    (Econst_int (Int.repr 0) tint) (tptr tuint)) tuint))
                           (Ssequence
                              (Sset _aux1
                                 (Ederef
                                    (Ebinop Oadd (Evar _t (tarray tuint 4))
                                       (Econst_int (Int.repr 3) tint) (tptr tuint)) tuint))
                              (Ssequence
                                 (Sset _aux
                                    (Ebinop Oadd (Etempvar _aux tuint) (Etempvar _aux1 tuint) tuint))
                                 (Ssequence
                                    (Ssequence
                                       (Scall (Some _t'5)
                                          (Evar _L32
                                             (Tfunction (Tcons tuint (Tcons tint Tnil)) tuint
                                                cc_default))
                                          [Etempvar _aux tuint; Econst_int (Int.repr 7) tint])
                                       (Sset _aux (Etempvar _t'5 tuint)))
                                    (Ssequence
                                       (Sset _aux1
                                          (Ederef
                                             (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                (Econst_int (Int.repr 1) tint)
                                                (tptr tuint)) tuint))
                                       (Ssequence
                                          (Sset _aux1
                                             (Ebinop Oxor (Etempvar _aux1 tuint)
                                                (Etempvar _aux tuint) tuint))
                                          (Sassign
                                             (Ederef
                                                (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                   (Econst_int (Int.repr 1) tint)
                                                   (tptr tuint)) tuint) (Etempvar _aux1 tuint))))))))
                        (Ssequence
                           (Ssequence
                              (Sset _aux
                                 (Ederef
                                    (Ebinop Oadd (Evar _t (tarray tuint 4))
                                       (Econst_int (Int.repr 1) tint) (tptr tuint)) tuint))
                              (Ssequence
                                 (Sset _aux1
                                    (Ederef
                                       (Ebinop Oadd (Evar _t (tarray tuint 4))
                                          (Econst_int (Int.repr 0) tint)
                                          (tptr tuint)) tuint))
                                 (Ssequence
                                    (Sset _aux
                                       (Ebinop Oadd (Etempvar _aux tuint)
                                          (Etempvar _aux1 tuint) tuint))
                                    (Ssequence
                                       (Ssequence
                                          (Scall (Some _t'6)
                                             (Evar _L32
                                                (Tfunction (Tcons tuint (Tcons tint Tnil)) tuint
                                                   cc_default))
                                             [Etempvar _aux tuint; Econst_int (Int.repr 9) tint])
                                          (Sset _aux (Etempvar _t'6 tuint)))
                                       (Ssequence
                                          (Sset _aux1
                                             (Ederef
                                                (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                   (Econst_int (Int.repr 2) tint)
                                                   (tptr tuint)) tuint))
                                          (Ssequence
                                             (Sset _aux1
                                                (Ebinop Oxor (Etempvar _aux1 tuint)
                                                   (Etempvar _aux tuint) tuint))
                                             (Sassign
                                                (Ederef
                                                   (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                      (Econst_int (Int.repr 2) tint)
                                                      (tptr tuint)) tuint)
                                                (Etempvar _aux1 tuint))))))))
                           (Ssequence
                              (Ssequence
                                 (Sset _aux
                                    (Ederef
                                       (Ebinop Oadd (Evar _t (tarray tuint 4))
                                          (Econst_int (Int.repr 2) tint)
                                          (tptr tuint)) tuint))
                                 (Ssequence
                                    (Sset _aux1
                                       (Ederef
                                          (Ebinop Oadd (Evar _t (tarray tuint 4))
                                             (Econst_int (Int.repr 1) tint)
                                             (tptr tuint)) tuint))
                                    (Ssequence
                                       (Sset _aux
                                          (Ebinop Oadd (Etempvar _aux tuint)
                                             (Etempvar _aux1 tuint) tuint))
                                       (Ssequence
                                          (Ssequence
                                             (Scall (Some _t'7)
                                                (Evar _L32
                                                   (Tfunction (Tcons tuint (Tcons tint Tnil)) tuint
                                                      cc_default))
                                                [Etempvar _aux tuint; Econst_int (Int.repr 13) tint])
                                             (Sset _aux (Etempvar _t'7 tuint)))
                                          (Ssequence
                                             (Sset _aux1
                                                (Ederef
                                                   (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                      (Econst_int (Int.repr 3) tint)
                                                      (tptr tuint)) tuint))
                                             (Ssequence
                                                (Sset _aux1
                                                   (Ebinop Oxor (Etempvar _aux1 tuint)
                                                      (Etempvar _aux tuint) tuint))
                                                (Sassign
                                                   (Ederef
                                                      (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                         (Econst_int (Int.repr 3) tint)
                                                         (tptr tuint)) tuint)
                                                   (Etempvar _aux1 tuint))))))))
                              (Ssequence
                                 (Ssequence
                                    (Sset _aux
                                       (Ederef
                                          (Ebinop Oadd (Evar _t (tarray tuint 4))
                                             (Econst_int (Int.repr 3) tint)
                                             (tptr tuint)) tuint))
                                    (Ssequence
                                       (Sset _aux1
                                          (Ederef
                                             (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                (Econst_int (Int.repr 2) tint)
                                                (tptr tuint)) tuint))
                                       (Ssequence
                                          (Sset _aux
                                             (Ebinop Oadd (Etempvar _aux tuint)
                                                (Etempvar _aux1 tuint) tuint))
                                          (Ssequence
                                             (Ssequence
                                                (Scall (Some _t'8)
                                                   (Evar _L32
                                                      (Tfunction (Tcons tuint (Tcons tint Tnil))
                                                         tuint cc_default))
                                                   [Etempvar _aux tuint;
                                                   Econst_int (Int.repr 18) tint])
                                                (Sset _aux (Etempvar _t'8 tuint)))
                                             (Ssequence
                                                (Sset _aux1
                                                   (Ederef
                                                      (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                         (Econst_int (Int.repr 0) tint)
                                                         (tptr tuint)) tuint))
                                                (Ssequence
                                                   (Sset _aux1
                                                      (Ebinop Oxor (Etempvar _aux1 tuint)
                                                         (Etempvar _aux tuint) tuint))
                                                   (Sassign
                                                      (Ederef
                                                         (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                            (Econst_int (Int.repr 0) tint)
                                                            (tptr tuint)) tuint)
                                                      (Etempvar _aux1 tuint))))))))
                                 (Sfor (Sset _m (Econst_int (Int.repr 0) tint))
                                    (Ebinop Olt (Etempvar _m tint) (Econst_int (Int.repr 4) tint)
                                       tint)
                                    (Ssequence
                                       (Sset _aux
                                          (Ederef
                                             (Ebinop Oadd (Evar _t (tarray tuint 4))
                                                (Etempvar _m tint) (tptr tuint)) tuint))
                                       (Ssequence
                                          (Sset _aux1
                                             (Ebinop Oadd
                                                (Ebinop Omul (Econst_int (Int.repr 4) tint)
                                                   (Etempvar _j tint) tint)
                                                (Ebinop Omod
                                                   (Ebinop Oadd (Etempvar _j tint)
                                                      (Etempvar _m tint) tint)
                                                   (Econst_int (Int.repr 4) tint) tint) tint))
                                          (Sassign
                                             (Ederef
                                                (Ebinop Oadd (Evar _w (tarray tuint 16))
                                                   (Etempvar _aux1 tuint)
                                                   (tptr tuint)) tuint) (Etempvar _aux tuint))))
                                    (Sset _m
                                       (Ebinop Oadd (Etempvar _m tint) (Econst_int (Int.repr 1) tint)
                                          tint))))))))
                  (Sset _j (Ebinop Oadd (Etempvar _j tint) (Econst_int (Int.repr 1) tint) tint)))
               (Sfor (Sset _m (Econst_int (Int.repr 0) tint))
                  (Ebinop Olt (Etempvar _m tint) (Econst_int (Int.repr 16) tint) tint)
                  (Ssequence
                     (Sset _aux
                        (Ederef
                           (Ebinop Oadd (Evar _w (tarray tuint 16)) (Etempvar _m tint) (tptr tuint))
                           tuint))
                     (Sassign
                        (Ederef
                           (Ebinop Oadd (Evar _x (tarray tuint 16)) (Etempvar _m tint) (tptr tuint))
                           tuint) (Etempvar _aux tuint)))
                  (Sset _m (Ebinop Oadd (Etempvar _m tint) (Econst_int (Int.repr 1) tint) tint))))
            (Sset _i (Ebinop Oadd (Etempvar _i tint) (Econst_int (Int.repr 1) tint) tint)))

  (normal_ret_assert
  (PROP  ()
   LOCAL  (temp _i (Vint (Int.repr 20)); lvar _t (tarray tuint 4) t; lvar _y (tarray tuint 16) y;
       lvar _x (tarray tuint 16) x; lvar _w (tarray tuint 16) w; temp _in nonce;
       temp _out out; temp _c c; temp _k k; temp _h (Vint (Int.repr h)))
   SEP (FR; data_at_ Tsh (tarray tuint 4) t; data_at_ Tsh (tarray tuint 16) w;
        EX r:_, !!(Snuffle 20 xI = Some r) &&
           data_at Tsh (tarray tuint 16) (map Vint r) x))).
Proof. intros. abbreviate_semax.
freeze [0;1;2] FR1.
Time assert_PROP (Zlength (map Vint xI) = 16) as XIZ by entailer!. (*0.9*)
thaw FR1.
rewrite Zlength_map in XIZ.
drop_LOCAL 0%nat.
Time forward_for_simple_bound 20 (EX i:Z,
  (PROP  ()
   LOCAL  (lvar _t (tarray tuint 4) t;
   lvar _y (tarray tuint 16) y; lvar _x (tarray tuint 16) x;
   lvar _w (tarray tuint 16) w; temp _in nonce; temp _out out; temp _c c;
   temp _k k; temp _h (Vint (Int.repr h)))
   SEP  (FR; data_at_ Tsh (tarray tuint 4) t; data_at_ Tsh (tarray tuint 16) w;
         EX r:_, !!(Snuffle (Z.to_nat i) xI = Some r) &&
             data_at Tsh (tarray tuint 16) (map Vint r) x))). (*0.9*)
{ Exists xI. Time entailer!. (*2.6*) }

{ rename H into I. Intros r. rename H into R.
  assert (XI: length xI = 16%nat). eapply (Zlength_length _ _ 16). omega. trivial.
  assert (RL:= Snuffle_length _ _ _ R XI).
  assert (RZL: Zlength r = 16). rewrite Zlength_correct, RL; reflexivity.

  Time forward_for_simple_bound 4 (EX j:Z,
  (PROP  ()
   LOCAL  (temp _i (Vint (Int.repr i)); lvar _t (tarray tuint 4) t;
   lvar _y (tarray tuint 16) y; lvar _x (tarray tuint 16) x;
   lvar _w (tarray tuint 16) w; temp _in nonce; temp _out out; temp _c c;
   temp _k k; temp _h (Vint (Int.repr h)))
   SEP  (FR; data_at_ Tsh (tarray tuint 4) t;
      EX l:_, !!(WcontI r (Z.to_nat j) l) && data_at Tsh (tarray tuint 16) l w;
      data_at Tsh (tarray tuint 16) (map Vint r) x))). (*1.5*)
  { Time entailer!. (*2.5*) Exists (list_repeat 16 Vundef). Time entailer!. (*0.1*) }
  { rename H into J. rename i0 into j.
    Intros wlist. rename H into WCONT.
    destruct (Znth_mapVint r ((5 * j + 4 * 0) mod 16) Vundef) as [t0 T0].
      rewrite RZL; apply Z_mod_lt; omega.
    destruct (Znth_mapVint r ((5 * j + 4 * 1) mod 16) Vundef) as [t1 T1].
      rewrite RZL; apply Z_mod_lt; omega.
    destruct (Znth_mapVint r ((5 * j + 4 * 2) mod 16) Vundef) as [t2 T2].
      rewrite RZL; apply Z_mod_lt; omega.
    destruct (Znth_mapVint r ((5 * j + 4 * 3) mod 16) Vundef) as [t3 T3].
      rewrite RZL; apply Z_mod_lt; omega.
    eapply semax_post.
    2: apply (Jbody _ FR c k h nonce out w x y t i j r I J wlist _ _ _ _ T0 T1 T2 T3).
    intros; apply andp_left2.
    unfold POSTCONDITION, abbreviate.
    apply assert_lemmas.normal_ret_assert_derives'.
    Intros W. Exists W. old_go_lower. Time entailer!. (*6.1*) (*TODO: eliminate old_go_lower*)
    rewrite Z.add_comm, Z2Nat.inj_add; try omega.
    assert (X: (Z.to_nat 1 + Z.to_nat j = S (Z.to_nat j))%nat) by reflexivity.
    rewrite X. simpl. split. assumption.
    exists t0, t1, t2, t3. simpl in T0, T1, T2, T3. rewrite Z2Nat.id, T0, T1, T2, T3.
    repeat split; trivial.
    exists wlist. split; trivial. omega. }

  Intros wlist. rename H into HW.
  destruct (WWI _ _ HW RZL) as [wints [WI SNUFF]]. subst wlist.
  freeze [0;1] FR2.
  eapply semax_post.
  Focus 2. apply (array_copy3 _ (FRZL FR2) c k h nonce out
                  i w x y t (map Vint r) (map Vint wints)); trivial.
           intros. apply Znth_mapVint.
              destruct (snuffleRound_length _ _ SNUFF) as [WL _].
              rewrite Zlength_correct, WL; simpl; omega.
  intros ? ?. apply andp_left2.
    unfold POSTCONDITION, abbreviate.
    apply assert_lemmas.normal_ret_assert_derives'.
  Exists wints. rewrite Z.add_comm, Z2Nat.inj_add; try omega.
  old_go_lower. Time entailer!. (*4.3*)(*TODO: eliminate old_go_lower*)
  rewrite SnuffleS, R; trivial.
  thaw FR2; cancel. }
apply andp_left2; apply derives_refl.
Time Qed. (*11.891 secs (3.562u,0.s) (successful)*)


Require Export VST.concurrency.paco.src.paconotation VST.concurrency.paco.src.pacotac VST.concurrency.paco.src.pacodef VST.concurrency.paco.src.pacotacuser.
Set Implicit Arguments.

(** ** Predicates of Arity 4
*)

(** 1 Mutual Coinduction *)

Section Arg4_1.

Definition monotone4 T0 T1 T2 T3 (gf: rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3) :=
  forall x0 x1 x2 x3 r r' (IN: gf r x0 x1 x2 x3) (LE: r <4= r'), gf r' x0 x1 x2 x3.

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 gf : rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3.
Implicit Arguments gf [].

Theorem paco4_acc: forall
  l r (OBG: forall rr (INC: r <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4 gf rr),
  l <4= paco4 gf r.
Proof.
  intros; assert (SIM: paco4 gf (r \4/ l) x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_mon: monotone4 (paco4 gf).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_mult_strong: forall r,
  paco4 gf (upaco4 gf r) <4= paco4 gf r.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Corollary paco4_mult: forall r,
  paco4 gf (paco4 gf r) <4= paco4 gf r.
Proof. intros; eapply paco4_mult_strong, paco4_mon; eauto. Qed.

Theorem paco4_fold: forall r,
  gf (upaco4 gf r) <4= paco4 gf r.
Proof. intros; econstructor; [ |eauto]; eauto. Qed.

Theorem paco4_unfold: forall (MON: monotone4 gf) r,
  paco4 gf r <4= gf (upaco4 gf r).
Proof. unfold monotone4; intros; destruct PR; eauto. Qed.

End Arg4_1.

Hint Unfold monotone4.
Hint Resolve paco4_fold.

Implicit Arguments paco4_acc            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_mon            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_mult_strong    [ T0 T1 T2 T3 ].
Implicit Arguments paco4_mult           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_fold           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_unfold         [ T0 T1 T2 T3 ].

Instance paco4_inst  T0 T1 T2 T3 (gf : rel4 T0 T1 T2 T3->_) r x0 x1 x2 x3 : paco_class (paco4 gf r x0 x1 x2 x3) :=
{ pacoacc    := paco4_acc gf;
  pacomult   := paco4_mult gf;
  pacofold   := paco4_fold gf;
  pacounfold := paco4_unfold gf }.

(** 2 Mutual Coinduction *)

Section Arg4_2.

Definition monotone4_2 T0 T1 T2 T3 (gf: rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3) :=
  forall x0 x1 x2 x3 r_0 r_1 r'_0 r'_1 (IN: gf r_0 r_1 x0 x1 x2 x3) (LE_0: r_0 <4= r'_0)(LE_1: r_1 <4= r'_1), gf r'_0 r'_1 x0 x1 x2 x3.

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 gf_0 gf_1 : rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

Theorem paco4_2_0_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_0 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_2_0 gf_0 gf_1 rr r_1),
  l <4= paco4_2_0 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco4_2_0 gf_0 gf_1 (r_0 \4/ l) r_1 x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_2_1_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_1 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_2_1 gf_0 gf_1 r_0 rr),
  l <4= paco4_2_1 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco4_2_1 gf_0 gf_1 r_0 (r_1 \4/ l) x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_2_0_mon: monotone4_2 (paco4_2_0 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_2_1_mon: monotone4_2 (paco4_2_1 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_2_0_mult_strong: forall r_0 r_1,
  paco4_2_0 gf_0 gf_1 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_0 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_2_1_mult_strong: forall r_0 r_1,
  paco4_2_1 gf_0 gf_1 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_1 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Corollary paco4_2_0_mult: forall r_0 r_1,
  paco4_2_0 gf_0 gf_1 (paco4_2_0 gf_0 gf_1 r_0 r_1) (paco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco4_2_0_mult_strong, paco4_2_0_mon; eauto. Qed.

Corollary paco4_2_1_mult: forall r_0 r_1,
  paco4_2_1 gf_0 gf_1 (paco4_2_0 gf_0 gf_1 r_0 r_1) (paco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco4_2_1_mult_strong, paco4_2_1_mon; eauto. Qed.

Theorem paco4_2_0_fold: forall r_0 r_1,
  gf_0 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco4_2_1_fold: forall r_0 r_1,
  gf_1 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco4_2_0_unfold: forall (MON: monotone4_2 gf_0) (MON: monotone4_2 gf_1) r_0 r_1,
  paco4_2_0 gf_0 gf_1 r_0 r_1 <4= gf_0 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1).
Proof. unfold monotone4_2; intros; destruct PR; eauto. Qed.

Theorem paco4_2_1_unfold: forall (MON: monotone4_2 gf_0) (MON: monotone4_2 gf_1) r_0 r_1,
  paco4_2_1 gf_0 gf_1 r_0 r_1 <4= gf_1 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1).
Proof. unfold monotone4_2; intros; destruct PR; eauto. Qed.

End Arg4_2.

Hint Unfold monotone4_2.
Hint Resolve paco4_2_0_fold.
Hint Resolve paco4_2_1_fold.

Implicit Arguments paco4_2_0_acc            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_1_acc            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_0_mon            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_1_mon            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_0_mult_strong    [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_1_mult_strong    [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_0_mult           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_1_mult           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_0_fold           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_1_fold           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_0_unfold         [ T0 T1 T2 T3 ].
Implicit Arguments paco4_2_1_unfold         [ T0 T1 T2 T3 ].

Instance paco4_2_0_inst  T0 T1 T2 T3 (gf_0 gf_1 : rel4 T0 T1 T2 T3->_) r_0 r_1 x0 x1 x2 x3 : paco_class (paco4_2_0 gf_0 gf_1 r_0 r_1 x0 x1 x2 x3) :=
{ pacoacc    := paco4_2_0_acc gf_0 gf_1;
  pacomult   := paco4_2_0_mult gf_0 gf_1;
  pacofold   := paco4_2_0_fold gf_0 gf_1;
  pacounfold := paco4_2_0_unfold gf_0 gf_1 }.

Instance paco4_2_1_inst  T0 T1 T2 T3 (gf_0 gf_1 : rel4 T0 T1 T2 T3->_) r_0 r_1 x0 x1 x2 x3 : paco_class (paco4_2_1 gf_0 gf_1 r_0 r_1 x0 x1 x2 x3) :=
{ pacoacc    := paco4_2_1_acc gf_0 gf_1;
  pacomult   := paco4_2_1_mult gf_0 gf_1;
  pacofold   := paco4_2_1_fold gf_0 gf_1;
  pacounfold := paco4_2_1_unfold gf_0 gf_1 }.

(** 3 Mutual Coinduction *)

Section Arg4_3.

Definition monotone4_3 T0 T1 T2 T3 (gf: rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3) :=
  forall x0 x1 x2 x3 r_0 r_1 r_2 r'_0 r'_1 r'_2 (IN: gf r_0 r_1 r_2 x0 x1 x2 x3) (LE_0: r_0 <4= r'_0)(LE_1: r_1 <4= r'_1)(LE_2: r_2 <4= r'_2), gf r'_0 r'_1 r'_2 x0 x1 x2 x3.

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 gf_0 gf_1 gf_2 : rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

Theorem paco4_3_0_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_0 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_3_0 gf_0 gf_1 gf_2 rr r_1 r_2),
  l <4= paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco4_3_0 gf_0 gf_1 gf_2 (r_0 \4/ l) r_1 r_2 x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_3_1_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_1 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_3_1 gf_0 gf_1 gf_2 r_0 rr r_2),
  l <4= paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco4_3_1 gf_0 gf_1 gf_2 r_0 (r_1 \4/ l) r_2 x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_3_2_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_2 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 rr),
  l <4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 (r_2 \4/ l) x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_3_0_mon: monotone4_3 (paco4_3_0 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_1_mon: monotone4_3 (paco4_3_1 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_2_mon: monotone4_3 (paco4_3_2 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_0_mult_strong: forall r_0 r_1 r_2,
  paco4_3_0 gf_0 gf_1 gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_1_mult_strong: forall r_0 r_1 r_2,
  paco4_3_1 gf_0 gf_1 gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_2_mult_strong: forall r_0 r_1 r_2,
  paco4_3_2 gf_0 gf_1 gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Corollary paco4_3_0_mult: forall r_0 r_1 r_2,
  paco4_3_0 gf_0 gf_1 gf_2 (paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco4_3_0_mult_strong, paco4_3_0_mon; eauto. Qed.

Corollary paco4_3_1_mult: forall r_0 r_1 r_2,
  paco4_3_1 gf_0 gf_1 gf_2 (paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco4_3_1_mult_strong, paco4_3_1_mon; eauto. Qed.

Corollary paco4_3_2_mult: forall r_0 r_1 r_2,
  paco4_3_2 gf_0 gf_1 gf_2 (paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco4_3_2_mult_strong, paco4_3_2_mon; eauto. Qed.

Theorem paco4_3_0_fold: forall r_0 r_1 r_2,
  gf_0 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco4_3_1_fold: forall r_0 r_1 r_2,
  gf_1 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco4_3_2_fold: forall r_0 r_1 r_2,
  gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco4_3_0_unfold: forall (MON: monotone4_3 gf_0) (MON: monotone4_3 gf_1) (MON: monotone4_3 gf_2) r_0 r_1 r_2,
  paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 <4= gf_0 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone4_3; intros; destruct PR; eauto. Qed.

Theorem paco4_3_1_unfold: forall (MON: monotone4_3 gf_0) (MON: monotone4_3 gf_1) (MON: monotone4_3 gf_2) r_0 r_1 r_2,
  paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 <4= gf_1 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone4_3; intros; destruct PR; eauto. Qed.

Theorem paco4_3_2_unfold: forall (MON: monotone4_3 gf_0) (MON: monotone4_3 gf_1) (MON: monotone4_3 gf_2) r_0 r_1 r_2,
  paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 <4= gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone4_3; intros; destruct PR; eauto. Qed.

End Arg4_3.

Hint Unfold monotone4_3.
Hint Resolve paco4_3_0_fold.
Hint Resolve paco4_3_1_fold.
Hint Resolve paco4_3_2_fold.

Implicit Arguments paco4_3_0_acc            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_1_acc            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_2_acc            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_0_mon            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_1_mon            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_2_mon            [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_0_mult_strong    [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_1_mult_strong    [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_2_mult_strong    [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_0_mult           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_1_mult           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_2_mult           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_0_fold           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_1_fold           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_2_fold           [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_0_unfold         [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_1_unfold         [ T0 T1 T2 T3 ].
Implicit Arguments paco4_3_2_unfold         [ T0 T1 T2 T3 ].

Instance paco4_3_0_inst  T0 T1 T2 T3 (gf_0 gf_1 gf_2 : rel4 T0 T1 T2 T3->_) r_0 r_1 r_2 x0 x1 x2 x3 : paco_class (paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3) :=
{ pacoacc    := paco4_3_0_acc gf_0 gf_1 gf_2;
  pacomult   := paco4_3_0_mult gf_0 gf_1 gf_2;
  pacofold   := paco4_3_0_fold gf_0 gf_1 gf_2;
  pacounfold := paco4_3_0_unfold gf_0 gf_1 gf_2 }.

Instance paco4_3_1_inst  T0 T1 T2 T3 (gf_0 gf_1 gf_2 : rel4 T0 T1 T2 T3->_) r_0 r_1 r_2 x0 x1 x2 x3 : paco_class (paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3) :=
{ pacoacc    := paco4_3_1_acc gf_0 gf_1 gf_2;
  pacomult   := paco4_3_1_mult gf_0 gf_1 gf_2;
  pacofold   := paco4_3_1_fold gf_0 gf_1 gf_2;
  pacounfold := paco4_3_1_unfold gf_0 gf_1 gf_2 }.

Instance paco4_3_2_inst  T0 T1 T2 T3 (gf_0 gf_1 gf_2 : rel4 T0 T1 T2 T3->_) r_0 r_1 r_2 x0 x1 x2 x3 : paco_class (paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3) :=
{ pacoacc    := paco4_3_2_acc gf_0 gf_1 gf_2;
  pacomult   := paco4_3_2_mult gf_0 gf_1 gf_2;
  pacofold   := paco4_3_2_fold gf_0 gf_1 gf_2;
  pacounfold := paco4_3_2_unfold gf_0 gf_1 gf_2 }.


From iris.proofmode Require Import
  proofmode.

From caml5 Require Import
  prelude.
From caml5 Require Export
  base.
From caml5.algebra Require Import
  lib.auth_Z_max.

Class AuthZMaxG Σ := {
  auth_Z_max_G_inG : inG Σ auth_Z_max_R ;
}.
#[local] Existing Instance auth_Z_max_G_inG.

Definition auth_Z_max_Σ := #[
  GFunctor auth_Z_max_R
].
#[global] Instance subG_auth_Z_max_Σ Σ :
  subG auth_Z_max_Σ Σ →
  AuthZMaxG Σ.
Proof.
  solve_inG.
Qed.

Section auth_Z_max_G.
  Context `{!AuthZMaxG Σ}.
  Implicit Types n m p : Z.

  Definition auth_Z_max_auth γ dq n :=
    own γ (auth_Z_max_auth dq n).
  Definition auth_Z_max_frag γ n :=
    own γ (auth_Z_max_frag n).

  #[global] Instance auth_Z_max_auth_timeless γ dq n :
    Timeless (auth_Z_max_auth γ dq n).
  Proof.
    apply _.
  Qed.
  #[global] Instance auth_Z_max_auth_persistent γ n :
    Persistent (auth_Z_max_auth γ DfracDiscarded n).
  Proof.
    apply _.
  Qed.
  #[global] Instance auth_Z_max_frag_timeless γ n :
    Timeless (auth_Z_max_frag γ n).
  Proof.
    apply _.
  Qed.
  #[global] Instance auth_Z_max_frag_persistent γ n :
    Persistent (auth_Z_max_frag γ n).
  Proof.
    apply _.
  Qed.

  #[global] Instance auth_Z_max_auth_fractional γ n :
    Fractional (λ q, auth_Z_max_auth γ (DfracOwn q) n).
  Proof.
    intros ?*. rewrite -own_op -auth_Z_max_auth_dfrac_op //.
  Qed.
  #[global] Instance auth_Z_max_auth_as_fractional γ q n :
    AsFractional (auth_Z_max_auth γ (DfracOwn q) n) (λ q, auth_Z_max_auth γ (DfracOwn q) n) q.
  Proof.
    split; done || apply _.
  Qed.

  Lemma auth_Z_max_auth_persist γ dq n :
    auth_Z_max_auth γ dq n ==∗
    auth_Z_max_auth γ DfracDiscarded n.
  Proof.
    iApply own_update. apply auth_Z_max_auth_persist.
  Qed.

  Lemma auth_Z_max_alloc n :
    ⊢ |==> ∃ γ,
      auth_Z_max_auth γ (DfracOwn 1) n.
  Proof.
    iMod (own_alloc (auth_Z_max.auth_Z_max_auth (DfracOwn 1) n)) as "(% & ?)".
    { apply auth_Z_max_auth_valid. }
    naive_solver.
  Qed.

  Lemma auth_Z_max_auth_valid γ dq a :
    auth_Z_max_auth γ dq a -∗
    ⌜✓ dq⌝.
  Proof.
    iIntros. iDestruct (own_valid with "[$]") as %?%auth_Z_max_auth_dfrac_valid. done.
  Qed.
  Lemma auth_Z_max_auth_combine γ dq1 n1 dq2 n2 :
    auth_Z_max_auth γ dq1 n1 -∗
    auth_Z_max_auth γ dq2 n2 -∗
      auth_Z_max_auth γ (dq1 ⋅ dq2) n1 ∗
      ⌜n1 = n2⌝.
  Proof.
    iIntros "H●1 H●2". iCombine "H●1 H●2" as "H●".
    iDestruct (own_valid with "H●") as %(? & <-)%auth_Z_max_auth_dfrac_op_valid.
    rewrite -auth_Z_max_auth_dfrac_op. naive_solver.
  Qed.
  Lemma auth_Z_max_auth_valid_2 γ dq1 n1 dq2 n2 :
    auth_Z_max_auth γ dq1 n1 -∗
    auth_Z_max_auth γ dq2 n2 -∗
    ⌜✓ (dq1 ⋅ dq2) ∧ n1 = n2⌝.
  Proof.
    iIntros "H●1 H●2".
    iDestruct (auth_Z_max_auth_combine with "H●1 H●2") as "(H● & %)".
    iDestruct (auth_Z_max_auth_valid with "H●") as %?.
    done.
  Qed.
  Lemma auth_Z_max_auth_agree γ dq1 n1 dq2 n2 :
    auth_Z_max_auth γ dq1 n1 -∗
    auth_Z_max_auth γ dq2 n2 -∗
    ⌜n1 = n2⌝.
  Proof.
    iIntros "H●1 H●2".
    iDestruct (auth_Z_max_auth_valid_2 with "H●1 H●2") as %?. naive_solver.
  Qed.
  Lemma auth_Z_max_auth_exclusive γ n1 n2 :
    auth_Z_max_auth γ (DfracOwn 1) n1 -∗
    auth_Z_max_auth γ (DfracOwn 1) n2 -∗
    False.
  Proof.
    iIntros "H●1 H●2".
    iDestruct (auth_Z_max_auth_valid_2 with "H●1 H●2") as %(? & _). done.
  Qed.

  Lemma auth_Z_max_frag_get γ q n :
    auth_Z_max_auth γ q n -∗
    auth_Z_max_frag γ n.
  Proof.
    apply own_mono, auth_Z_max_included.
  Qed.
  Lemma auth_Z_max_frag_le {γ n} n' :
    (n' ≤ n)%Z →
    auth_Z_max_frag γ n -∗
    auth_Z_max_frag γ n'.
  Proof.
    intros. apply own_mono, auth_Z_max_frag_mono. done.
  Qed.

  Lemma auth_Z_max_valid γ dq n m :
    auth_Z_max_auth γ dq n -∗
    auth_Z_max_frag γ m -∗
    ⌜m ≤ n⌝%Z.
  Proof.
    iIntros "H●1 H●2".
    iDestruct (own_valid_2 with "H●1 H●2") as %?%auth_Z_max_both_dfrac_valid.
    naive_solver.
  Qed.

  Lemma auth_Z_max_update {γ n} n' :
    (n ≤ n')%Z →
    auth_Z_max_auth γ (DfracOwn 1) n ==∗
    auth_Z_max_auth γ (DfracOwn 1) n'.
  Proof.
    iIntros "% H●".
    iMod (own_update with "H●"); first apply auth_Z_max_auth_update; done.
  Qed.
End auth_Z_max_G.

#[global] Opaque auth_Z_max_auth.
#[global] Opaque auth_Z_max_frag.


Require Export unscoped header_extensible.
Require Export existentialsyntax implicativesyntax.
Require Import classical_deduction implicative_deduction.

Reserved Notation "A ⊢ p" (at level 70).
Reserved Notation "A ⊢_exst p" (at level 70).

Notation "∃ p" := (inj (Exist _ p)) (at level 60).

Section Existential.
  Context {Sigma : Signature}.

  Variable form : Type.
  Variable retract : retract (form_existential form) form.
  Variable subst_form : (fin -> term) -> form -> form.

  Variable nd : list form -> form -> Prop.
  Notation "A ⊢ p" := (nd A p) (at level 70).

  Definition up_ctx (A : list form) := map (subst_form (S >> var_term)) A.
  Inductive nd_exst (A : list form) : form -> Prop :=
    | ndEI p t : A ⊢ subst_form (scons t (var_term)) p -> A ⊢_exst (∃ p)
    | ndEE p q : A ⊢ (∃ p) -> p :: (up_ctx A) ⊢ subst_form (S >> var_term) q -> A ⊢_exst q
  where "A ⊢_exst p" := (nd_exst A p).
  Variable agree : forall A p, A ⊢_exst p -> A ⊢ p.

  Variable weakening : forall A B p, A ⊢ p -> incl A B -> B ⊢ p.
  Lemma weakening_exst A B p : A ⊢_exst p -> incl A B -> B ⊢ p.
  Proof. revert B. destruct 1; intro Hinc; apply agree; [ now apply (ndEI _ p t), (weakening A) | apply (ndEE _ p q) ].
    -now apply (weakening A).
    -apply (weakening (p::up_ctx A)), incl_cons; [assumption | now left | apply incl_tl ].
      unfold up_ctx. now apply incl_map.
  Defined.

  Variable retract_implicative : included form_implicative form.

  Variable translate : form -> form.
  Definition translate_exst (p : form_existential form) : _ := match p with
    | Exist _ q => ¬¬(∃ (translate q))
  end.
  Notation "« p »" := (translate p).
  Notation "«/ A »" := (map translate A).

  Variable agree_cls : forall A p, nd_classic _ _ nd A p -> A ⊢ p.
  Variable agree_imp : forall A p, nd_imp _ _ nd A p -> A ⊢ p.
  Variable imp_nd : forall A p, nd_imp _ _ nd A p -> A ⊢ p.
  Variable subst_form_inj : forall sigma p, subst_form sigma (inj p) = subst_form_existential _ subst_form _ sigma p.
  Variable translation_inj : forall p, «inj p» = translate_exst  p.
  Variable aux : forall p, subst_form (scons (var_term 0) (var_term)) (subst_form (up_term_term (S >> var_term)) p) = p.
  Variable translation_bwd : forall A p, A ⊢ «p» <-> A ⊢ p.
  Lemma translation_bwd_exst A p: A ⊢ (translate_exst p) <-> A ⊢ inj p.
  Proof. destruct p. cbn. split; intro.
    - assert (Hc : A ⊢ ∃ «f»). {now apply agree_cls,ndDN. }
      apply (ndEE _ _ (∃ f)) in Hc. now apply agree. rewrite subst_form_inj. cbn. apply agree,(ndEI _ _ (var_term 0)).
      rewrite aux. apply translation_bwd, agree_imp,ndHyp. now left.
    -apply agree_imp,ndII,agree_imp,(ndIE _ _ _ _ (∃«f»)). apply agree_imp,ndHyp. now left.
      apply (weakening A). 2:now apply incl_tl. apply (ndEE _ _ (∃«f»)) in H. now apply agree.
      rewrite subst_form_inj. cbn. apply agree,(ndEI _ _ (var_term 0)). rewrite aux. apply translation_bwd.
      apply agree_imp,ndHyp. now left.
  Defined.

  Variable subst_dn : forall sigma p, subst_form sigma (¬¬p) = ¬¬(subst_form sigma p).
  Variable translation_subst : forall sigma q, «subst_form sigma q» = subst_form sigma «q».
  Lemma translation_subst_exst sigma p :  « subst_form_existential _ subst_form _ sigma p » = subst_form sigma (translate_exst p).
  Proof. destruct p; cbn. unfold Exist_. rewrite translation_inj. cbn. rewrite subst_dn. repeat apply congr_Impl_.
    rewrite subst_form_inj. cbn. apply congr_Exist_; apply translation_subst. all: reflexivity.
  Defined.

  Variable cut : forall A p q,  A ⊢ p -> (p :: A) ⊢ q -> A ⊢ q.
  Lemma translation_helper_exst A p : A ⊢ (¬¬(translate_exst p)) -> A ⊢ translate_exst p.
  Proof. destruct p. cbn. intro. apply (cut _ _ _ H). apply agree_imp,ndII,agree_imp,(ndIE _ _ _ _ (¬¬¬(∃«f»))).
    apply agree_imp,ndHyp. right. now left. apply agree_imp,ndII,agree_imp,(ndIE _ _ _ _ (¬(∃«f»))).
    apply agree_imp,ndHyp. now left. apply agree_imp,ndHyp. right. now left.
  Defined.

  Lemma translation_map A: up_ctx «/A» = «/up_ctx A».
  Proof. unfold up_ctx. repeat rewrite map_map. apply map_ext. intro p. symmetry. apply translation_subst.
  Qed.
End Existential.

Section translation.
  Context {Sigma : Signature}.

  Variable form : Type.
  Variable nd : list form -> form -> Prop.
  Variable cnd : list form -> form -> Prop.
  Variable subst_form : (fin -> term) -> form -> form.
  Variable retract_implicative : included form_implicative form.
  Variable retract_existential : included form_existential form.
  Variable translate : form -> form.

  Notation "A ⊢[ nd ] p" := (@nd_exst _ _ _ subst_form nd A p) (at level 70).
  Notation "« p »" := (translate p).
  Notation "«/ A »" := (map translate A).

  Variable translation_inj : forall p, «inj p» = translate_exst _ _ _ translate p.
  Variable translation_subst : forall sigma q, «subst_form sigma q» = subst_form sigma «q».

  Variable agree_cnd : forall A p, A ⊢[cnd] p -> cnd A p.
  Variable embed : forall A p, nd A p -> cnd A p.
  Lemma embed_exst A p : A ⊢[nd] p -> cnd A p.
  Proof. destruct 1; apply agree_cnd. now apply (ndEI _ _ _ _ _ _ t), embed. apply (ndEE _ _ _ _ _ p); now apply embed.
  Defined.

  Variable weakening : forall A B p, nd A p -> incl A B -> nd B p.

(*   Lemma dn_int_exst A p: A ⊢[nd] p -> A ⊢[nd] (¬¬p).
  Proof. intro. apply imp_nd, ndII, imp_nd, (ndIE _ _ _ _ p).
    -apply imp_nd, ndHyp. now left.
    -now apply (weakening_exst _ _ _ _ weakening A), incl_tl.
  Qed. *)
  Variable dni : forall A p, nd A p -> nd A (¬¬p).

  Variable agree_nd : forall A p, A ⊢[nd] p -> nd A p.
  Variable agree_cls : forall A p, nd_classic _ _ cnd A p -> cnd A p.
  Variable agree_imp : forall A p, nd_imp _ _ nd A p -> nd A p.
  Variable translation_helper : forall A p, nd A (¬¬«p») -> nd A «p».

  Variable translation : forall A p, cnd A p -> nd «/A» «p».
  Lemma translation_exst A p: A ⊢[cnd] p -> nd «/A» «p».
  Proof. destruct 1.
    -rewrite translation_inj. cbn.
     apply agree_imp,ndII,agree_imp,(ndIE _ _ _ _ (∃«p»)). apply agree_imp,ndHyp. now left.
     apply agree_nd. apply (ndEI _ _ _ _ _ _ t). apply (weakening «/A»). 2: now apply incl_tl.
     rewrite <- translation_subst. now apply translation.
    -apply translation_helper,agree_imp,ndII,agree_imp,(ndIE _ _ _ _ (¬∃«p»)).
     apply (weakening «/A»). 2: now apply incl_tl. apply translation in H. rewrite translation_inj in H. now cbn in H.
     apply agree_imp,ndII,agree_imp,(ndIE _ _ _ _ «q»). apply agree_imp,ndHyp. right. now left.
     apply agree_nd,(ndEE _ _ _ _ _ «p»). apply agree_imp,ndHyp. now left.
     apply (weakening «/p::(up_ctx _ subst_form A)»). rewrite <- translation_subst. now apply translation.
     { unfold incl. destruct 1. now left. unfold up_ctx. repeat rewrite map_cons. do 3 right.
       rewrite <- translation_map in H1. now unfold up_ctx in H1. apply translation_subst. }
  Defined.
End translation.