Require Export Coq.Sorting.Permutation.
Local Open Scope logic.
Inductive localdef : Type :=
| temp: ident -> val -> localdef
| lvar: ident -> type -> val -> localdef   (* local variable *)
| gvars: globals -> localdef.              (* global variables *)
Arguments temp i%positive v.
Definition lvar_denote (i: ident) (t: type) (v: val) rho :=
match Map.get (ve_of rho) i with
| Some (b, ty') => t=ty' /\ v = Vptr b Ptrofs.zero
| None => False
end.
Definition gvars_denote (gv: globals) rho :=
gv = (fun i => match Map.get (ge_of rho) i with Some b => Vptr b Ptrofs.zero | None => Vundef end).
Definition locald_denote (d: localdef) : environ -> Prop :=
match d with
| temp i v => `and (`(eq v) (eval_id i)) `(v <> Vundef)
| lvar i t v => lvar_denote i t v
| gvars gv => gvars_denote gv
end.
Fixpoint fold_right_andp rho (l: list (environ -> Prop)) : Prop :=
match l with
| nil => True
| b::nil => b rho
| b::r => b rho /\ fold_right_andp rho r
end.
Definition PROPx (P: list Prop): forall (Q: environ->mpred), environ->mpred :=
andp (prop (fold_right and True P)).
Notation "'PROP' ( x ; .. ; y )   z" := (PROPx (cons x%type .. (cons y%type nil) ..) z) (at level 10).
Notation "'PROP' ()   z" :=   (PROPx nil z) (at level 10).
Notation "'PROP' ( )   z" :=   (PROPx nil z) (at level 10).
Definition LOCALx (Q: list localdef) : forall (R: environ->mpred), environ->mpred :=
andp (local (fold_right (`and) (`True) (map locald_denote Q))).
Notation " 'LOCAL' ( )   z" := (LOCALx nil z)  (at level 9).
Notation " 'LOCAL' ()   z" := (LOCALx nil z)  (at level 9).
Notation " 'LOCAL' ( x ; .. ; y )   z" := (LOCALx (cons x%type .. (cons y%type nil) ..) z)
(at level 9).
Definition SEPx (R: list mpred) : environ->mpred :=
fun _ => (fold_right_sepcon R).
Arguments SEPx R _ : simpl never.
Notation " 'SEP' ( x ; .. ; y )" := (SEPx (cons x%logic .. (cons y%logic nil) ..))
(at level 8).
Notation " 'SEP' ( ) " := (SEPx nil) (at level 8).
Notation " 'SEP' () " := (SEPx nil) (at level 8).
Declare Scope assert.
Delimit Scope assert with assert.
Opaque rmaps.dependent_type_functor_rec.
(* Possible ?? *)
(* Lemma SEPx_super_non_expansive: forall A (R: list (forall ts, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (rmaps.ArrowType A rmaps.Mpred)) mpred)), Forall (fun R0: (forall ts, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (rmaps.ArrowType A rmaps.Mpred)) mpred) => @super_non_expansive A (fun ts (a: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred) (_: environ) => R0 ts a)) R -> @super_non_expansive A (fun ts (a: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred) (rho: environ) => SEPx (map (fun R0: forall ts, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (rmaps.ArrowType A rmaps.Mpred)) mpred => R0 ts a) R) rho).*)
Notation "'EX' x .. y , P " :=
(@exp (environ->mpred) _ _ (fun x =>
..
(@exp (environ->mpred) _ _ (fun y => P%assert))
..
)) (at level 65, x binder, y binder, right associativity) : assert.
Notation " 'ENTAIL' d ',' P '|--' Q " :=
(@derives (environ->mpred) _ (andp (local (tc_environ d)) P%assert) Q%assert) (at level 80, P at level 79, Q at level 79).
Arguments semax {CS} {Espec} Delta Pre%assert cmd Post%assert.
Ltac find_in_list A L :=
match L with
| A :: _ => constr:(O)
| _ :: ?Y => let n := find_in_list A Y in constr:(S n)
| nil => fail
end.
Ltac length_of R :=
match R with
|  nil => constr:(O)
|  _:: ?R1 => let n := length_of R1 in constr:(S n)
end.
Fixpoint insert {A} (n: nat) (x: A) (ys: list A) {struct n} : list A :=
match n with
| O => x::ys
| S n' => match ys with nil => x::ys | y::ys' => y::insert n' x ys' end
end.
(* Note: in the grab_indexes function, it's important that the {struct} induction NOT be on xs, because that list might not be concrete all the way to the end, where the ns list will be concrete. Thus we do it this particular way.  *)
Fixpoint  grab_indexes' {A} (ns: list (option nat)) (xs: list A) {struct ns} : list A * list A :=
match ns, xs with
| nil, xs => (nil, xs)
| _, nil => (nil,nil)
| Some n::ns', x::xs' => let (al,bl) := grab_indexes' ns' xs'
in (insert n x al, bl)
| None :: ns', x::xs' => let (al,bl) := grab_indexes' ns' xs'
in (al, x::bl)
end.
Fixpoint grab_calc' (k: Z) (z: nat) (ns: list (option nat)): list (option nat) :=
match z, ns with
| O, _::ns' => Some (Z.to_nat k) :: ns'
| S z', None::ns' => None :: grab_calc' k z' ns'
| S z', Some n :: ns => Some n :: grab_calc' (k-1) z' ns
| O, nil => Some O :: nil
| S z', nil => None :: grab_calc' k z' nil
end.
Fixpoint grab_calc (k: Z) (zs: list Z) (ns: list (option nat)) : list (option nat) :=
match zs with
| nil => ns
| z::zs' => grab_calc (k+1) zs' (grab_calc' k (Z.to_nat z) ns)
end.
(* Eval compute in grab_calc 0 (3::1::5::nil) nil. *)
(* Define app_alt, just like app, so we have better control over which things get unfolded *)
Definition app_alt {A: Type} :=
fix app (l m : list A) : list A :=
match l with
| nil => m
| a :: l1 => a :: app l1 m
end.
Definition grab_indexes {A} (ns: list Z) (xs: list A) : list A :=
let (al,bl) := grab_indexes' (grab_calc 0 ns nil) xs in app_alt al bl.
(* TESTING Variables (a b c d e f g h i j : assert). Eval compute in grab_indexes (1::4::6::nil) (a::b::c::d::e::f::g::h::i::j::nil). Eval compute in grab_indexes (1::6::4::nil) (a::b::c::d::e::f::g::h::i::j::nil). *)
(* The simpl_nat_of_P tactic is a complete hack, needed for compatibility between Coq 8.3/8.4, because the name of the thing to unfold varies between the two versions *)
Ltac simpl_nat_of_P :=
match goal with |- context [nat_of_P ?n] =>
match n with xI _ => idtac | xO _ => idtac | xH => idtac | _ => fail end;
let N := fresh "N" in
set (N:= nat_of_P n);
compute in N;
unfold N; clear N
end.
Ltac grab_indexes_SEP ns :=
rewrite (grab_indexes_SEP ns);
unfold grab_indexes; simpl grab_calc;
unfold grab_indexes', insert;
repeat simpl_nat_of_P; cbv beta iota;
unfold app_alt; fold @app_alt.
Tactic Notation "focus_SEP" constr(a) :=
grab_indexes_SEP (a::nil).
Tactic Notation "focus_SEP" constr(a) constr(b) :=
grab_indexes_SEP (a::b::nil).
Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) :=
grab_indexes_SEP (a::b::c::nil).
Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) :=
grab_indexes_SEP (a::b::c::d::nil).
Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) :=
grab_indexes_SEP (a::b::c::d::e::nil).
Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) :=
grab_indexes_SEP (a::b::c::d::e::f::nil).
Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) :=
grab_indexes_SEP (a::b::c::d::e::f::g::nil).
Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) :=
grab_indexes_SEP (a::b::c::d::e::f::g::h::nil).
Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) :=
grab_indexes_SEP (a::b::c::d::e::f::g::h::i::nil).
Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) constr(j) :=
grab_indexes_SEP (a::b::c::d::e::f::g::h::i::j::nil).
(* TESTING Variables (a b c d e f g h i j : assert). Goal (SEP (a;b;c;d;e;f;g;h;i;j) = SEP (b;d;a;c;e;f;g;h;i;j)). focus_SEP 1 3. auto. Qed. Goal (SEP (a;b;c;d;e;f;g;h;i;j) = SEP (d;b;a;c;e;f;g;h;i;j)). focus_SEP 3 1. auto. Qed.  *)
(* Lemma semax_post0: forall (R': ret_assert) Espec {cs: compspecs} Delta (R: ret_assert) P c, (R' |-- R) -> @semax cs Espec Delta P c R' ->  @semax cs Espec Delta P c R. *)

Lemma local_unfold: forall P rho, local P rho = !! (P rho).