Require Export VST.msl.iter_sepcon.
Require Export VST.concurrency.semax_conc_pred.
Require Export VST.concurrency.semax_conc.
Require Export VST.floyd.proofauto.
Require Export VST.floyd.sublist.
(* general list lemmas *)
Notation vint z := (Vint (Int.repr z)).
Notation vptrofs z := (Vptrofs (Ptrofs.repr z)).
Hint Resolve repable_0.
Definition complete MAX l := l ++ repeat (vptrofs 0) (Z.to_nat MAX - length l).
Definition remove_at {A} i (l : list A) := firstn i l ++ skipn (S i) l.
Open Scope logic.
Definition rotate {A} (l : list A) n m := sublist (m - n) (Zlength l) l ++
sublist 0 (m - n) l.
(* Lemma Znth_indep : forall {A} i (l : list A) d d', 0 <= i < Zlength l -> Znth i l d = Znth i l d'. *)
Fixpoint upto n :=
match n with
| O => []
| S n' => 0 :: map Z.succ (upto n')
end.
Opaque Z.of_nat.
(* Lemma Znth_map' : forall {A B} i (f : A -> B) al b, Znth i (map f al) (f b) = f (Znth i al b). *)
Transparent Z.of_nat.
Hint Resolve incl_nil.
Definition nil_dec {A} (l : list A) : {l = []} + {l <> []}.
Arguments eq_dec _ _ _ _ : simpl never.
Fixpoint extend {A} (l : list A) ls :=
match l, ls with
| x :: xs, y :: ys => (x :: y) :: extend xs ys
| _, _ => ls
end.
Fixpoint extendr {A} (l : list A) ls :=
match l, ls with
| x :: xs, y :: ys => (y ++ [x]) :: extendr xs ys
| _, _ => ls
end.
(* We could also consider an alpha-renaming axiom, although this may be unnecessary. *)
Hint Resolve lock_inv_isptr cond_var_isptr : saturate_local.
Hint Resolve unreadable_bot.
Definition join_Bot := join_Bot.
(* It's often useful to split Tsh in half. *)
Definition gsh1 := fst (slice.cleave Tsh).
Definition gsh2 := snd (slice.cleave Tsh).
Hint Resolve readable_gsh1 readable_gsh2 gsh1_gsh2_join.
Hint Resolve gsh1_not_bot gsh2_not_bot.
(* Lemma data_at_Tsh_conflict : forall {cs : compspecs} sh t v v' p, sepalg.nonidentity sh -> 0 < sizeof t -> data_at Tsh t v p * data_at sh t v' p |-- FF. *)
Definition remove_Znth {A} i (al : list A) := sublist 0 i al ++ sublist (i + 1) (Zlength al) al.
Instance Inhabitant_share : Inhabitant share := Share.bot. (* TODO: remove this, it's already in sublist.v *)
Instance Inhabitant_mpred : Inhabitant mpred := @FF mpred Nveric. (* TODO: remove this, it's already in sublist.v *)
Hint Resolve valid_pointer_isptr : saturate_local.
Definition super_non_expansive' {A} P := forall n ts x, compcert_rmaps.RML.R.approx n (P ts x) =
compcert_rmaps.RML.R.approx n (P ts (functors.MixVariantFunctor.fmap (rmaps.dependent_type_functor_rec ts A)
(compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x)).
(* Lemma malloc_compat : forall {cs : compspecs} sh t p, complete_legal_cosu_type t = true -> natural_aligned natural_alignment t = true -> malloc_token sh (sizeof t) p = !!field_compatible t [] p && malloc_token sh (sizeof t) p. *)
Ltac lock_props := rewrite ?sepcon_assoc; rewrite <- sepcon_emp at 1; rewrite sepcon_comm; apply sepcon_derives;
[repeat apply andp_right; auto; eapply derives_trans;
try (apply exclusive_weak_exclusive || (apply rec_inv_weak_rec_inv; try apply selflock_rec)); auto |
try timeout 20 cancel].
Ltac join_sub := repeat (eapply sepalg.join_sub_trans;
[eexists; first [eassumption | simple eapply sepalg.join_comm; eassumption]|]); eassumption.
Ltac join_inj := repeat match goal with H1 : sepalg.join ?a ?b ?c, H2 : sepalg.join ?a ?b ?d |- _ =>
pose proof (sepalg.join_eq H1 H2); clear H1 H2; subst; auto end.
Ltac fast_cancel := rewrite ?sepcon_emp, ?emp_sepcon; rewrite ?sepcon_assoc;
repeat match goal with
| |- ?P |-- ?P => apply derives_refl
| |- ?P * _ |-- ?P * _ => apply sepcon_derives; [apply derives_refl|]
| |- _ |-- ?P * _ => rewrite <- !sepcon_assoc, (sepcon_comm _ P), !sepcon_assoc end;
try cancel_frame.
(*Ltac forward_malloc t n := forward_call (sizeof t); [simpl; try computable | Intros n; rewrite malloc_compat by (auto; reflexivity); Intros; rewrite memory_block_data_at_ by auto]. *)
Ltac get_global_function'' _f :=
eapply (semax_fun_id'' _f); try reflexivity.
(* revised start_function that mostly works for dependent specs *)
Ltac start_dep_function :=
(* leaf_function; match goal with |- semax_body ?V ?G ?F ?spec => check_normalized F; let s := fresh "spec" in pose (s:=spec); hnf in s; cbn zeta in s; (* dependent specs defined with Program Definition often have extra lets *)
match goal with
| s :=  (DECLARE _ WITH _: globals
PRE  [] main_pre _ nil _
POST [ tint ] _) |- _ => idtac
| s := ?spec' |- _ => check_canonical_funspec spec'
end;
change (semax_body V G F s); subst s
end;
let DependedTypeList := fresh "DependedTypeList" in
match goal with |- semax_body _ _ _ (pair _ (mk_funspec _ _ _ ?Pre _ _ _)) =>
split; [split3; [check_parameter_types' | check_return_type
| try (apply compute_list_norepet_e; reflexivity);
fail "Duplicate formal parameter names in funspec signature"  ]
|];
match Pre with
| (fun x => match _ with (a,b) => _ end) => intros Espec DependedTypeList [a b]
| (fun i => _) => intros Espec DependedTypeList i
end;
simpl fn_body; simpl fn_params; simpl fn_return
end;
try match goal with |- semax _ (fun rho => ?A rho * ?B rho) _ _ =>
change (fun rho => ?A rho * ?B rho) with (A * B)
end;
simpl functors.MixVariantFunctor._functor in *;
simpl rmaps.dependent_type_functor_rec;
clear DependedTypeList;
repeat match goal with
| |- @semax _ _ _ (match ?p with (a,b) => _ end * _) _ _ =>
destruct p as [a b]
| |- @semax _ _ _ (Clight_seplog.close_precondition _ _ match ?p with (a,b) => _ end * _) _ _ =>
destruct p as [a b]
| |- @semax _ _ _ ((match ?p with (a,b) => _ end) eq_refl * _) _ _ =>
destruct p as [a b]
| |- @semax _ _ _ (Clight_seplog.close_precondition _ _ ((match ?p with (a,b) => _ end) eq_refl) * _) _ _ =>
destruct p as [a b]
end;
first [apply elim_close_precondition; [solve [auto 50 with closed] | solve [auto 50 with closed] | ]
| erewrite compute_close_precondition by reflexivity];
simplify_func_tycontext;
repeat match goal with
| |- context [Sloop (Ssequence (Sifthenelse ?e Sskip Sbreak) ?s) Sskip] =>
fold (Swhile e s)
| |- context [Ssequence ?s1 (Sloop (Ssequence (Sifthenelse ?e Sskip Sbreak) ?s2) ?s3) ] =>
match s3 with
| Sset ?i _ => match s1 with Sset ?i' _ => unify i i' | Sskip => idtac end
end;
fold (Sfor s1 e s2 s3)
end;
try expand_main_pre;
process_stackframe_of;
repeat change_mapsto_gvar_to_data_at;  (* should really restrict this to only in main,
but it needs to come after process_stackframe_of *)
repeat rewrite <- data_at__offset_zero;
try apply start_function_aux1;
repeat (apply semax_extract_PROP;
match goal with
| |- _ ?sh -> _ =>
match type of sh with
| share => intros ?SH
| Share.t => intros ?SH
| _ => intro
end
| |- _ => intro
end);
first [ eapply eliminate_extra_return'; [ reflexivity | reflexivity | ]
| eapply eliminate_extra_return; [ reflexivity | reflexivity | ]
| idtac];
abbreviate_semax;
lazymatch goal with
| |- semax ?Delta (PROPx _ (LOCALx ?L _)) _ _ => check_parameter_vals Delta L
| _ => idtac
end;
try match goal with DS := @abbreviate (PTree.t funspec) PTree.Leaf |- _ =>
clearbody DS
end;
start_function_hint.*) start_function.
(* Notations for dependent funspecs *)
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2) =>
match x with (x1,x2) => P%assert end)
(fun (ts: list Type) (x: t1*t2) =>
match x with (x1,x2) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3) =>
match x with (x1,x2,x3) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3) =>
match x with (x1,x2,x3) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4) =>
match x with (x1,x2,x3,x4) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4) =>
match x with (x1,x2,x3,x4) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5) =>
match x with (x1,x2,x3,x4,x5) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5) =>
match x with (x1,x2,x3,x4,x5) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6) =>
match x with (x1,x2,x3,x4,x5,x6) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6) =>
match x with (x1,x2,x3,x4,x5,x6) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7) =>
match x with (x1,x2,x3,x4,x5,x6,x7) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7) =>
match x with (x1,x2,x3,x4,x5,x6,x7) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0, x10 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0, x10 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
x10 at level 0, x11 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
x10 at level 0, x11 at level 0, x12 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
x10 at level 0, x11 at level 0, x12 at level 0, x13 at level 0,
P at level 100, Q at level 100).
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => P%assert end)
(fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14) =>
match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => Q%assert end) _ _)
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
x10 at level 0, x11 at level 0, x12 at level 0, x13 at level 0, x14 at level 0,
P at level 100, Q at level 100).
(* automation for dependent funspecs moved to call_lemmas and forward.v*)

Lemma PROP_into_SEP : forall P Q R, PROPx P (LOCALx Q (SEPx R)) =
PROPx [] (LOCALx Q (SEPx (!!fold_right and True P && emp :: R))).