Section funspecs2jspec.
Variable Z : Type.
Variable Espec : juicy_ext_spec Z.
Definition symb2genv_upper_bound (s: PTree.t block) : block :=
Pos.succ (fold_right Pos.max  1%positive (map snd (PTree.elements s))).
Definition symb2genv (ge_s: injective_PTree block) : genv.
refine (Build_genv (@Genv.mkgenv _ _ nil (proj1_sig ge_s) (PTree.empty _) (symb2genv_upper_bound (proj1_sig ge_s)) _ _ _) (PTree.empty _)).
*
intros.
unfold Coqlib.Plt.
apply Pos.lt_le_trans with (Pos.succ b).
apply Pos.lt_succ_r.
apply Pos.le_refl.
unfold symb2genv_upper_bound.
apply -> Pos.succ_le_mono.
apply PTree.elements_correct in H.
revert H.
induction (PTree.elements (proj1_sig ge_s)); intros. inv H.
destruct H. subst. simpl.
apply Pos.le_max_l.
simpl.
eapply Pos.le_trans; [  | apply Pos.le_max_r].
auto.
*
intros.
rewrite PTree.gempty in H. inv H.
*
intros.
destruct ge_s; simpl in *.
revert id1 id2 b H H0.
simpl.
auto.
Defined.
Definition funspec2pre (ext_link: Strings.String.string -> ident) (A : TypeTree)
(P: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred)
(ids: list ident) (id: ident) (sig : signature) (ef: external_function) x (ge_s: injective_PTree block)
(tys : list typ) args (z : Z) m : Prop :=
match oi_eq_dec (Some (id, sig)) (ef_id_sig ext_link ef) as s
return ((if s then (rmap* (sigT (fun ts => dependent_type_functor_rec ts A mpred)))%type else ext_spec_type Espec ef) -> Prop)
with
| left _ => fun x' => Val.has_type_list args (sig_args (ef_sig ef)) /\
exists phi0 phi1, join phi0 phi1 (m_phi m)
/\ P (projT1 (snd x')) (projT2 (snd x'))
(seplog.make_args ids args (empty_environ (symb2genv ge_s)) ) phi0
/\ necR (fst x') phi1 /\ joins (ghost_of (m_phi m)) (Some (ghost_PCM.ext_ref z, NoneP) :: nil)
| right n => fun x' => ext_spec_pre Espec ef x' ge_s tys args z m
end x.
Definition funspec2post (ext_link: Strings.String.string -> ident) (A : TypeTree)
(Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred)
id sig ef x ge_s (tret : option typ) ret (z : Z) m : Prop :=
match oi_eq_dec (Some (id, sig)) (ef_id_sig ext_link ef) as s
return ((if s then (rmap*(sigT (fun ts => dependent_type_functor_rec ts A mpred)))%type else ext_spec_type Espec ef) -> Prop)
with
| left _ => fun x' => exists phi0 phi1, join phi0 phi1 (m_phi m)
/\ Q (projT1 (snd x')) (projT2 (snd x')) (make_ext_rval (filter_genv (symb2genv ge_s)) ret) phi0
/\ necR (fst x') phi1 /\ joins (ghost_of (m_phi m)) (Some (ghost_PCM.ext_ref z, NoneP) :: nil)
| right n => fun x' => ext_spec_post Espec ef x' ge_s tret ret z m
end x.
Definition funspec2extspec (ext_link: Strings.String.string -> ident) (f : (ident*funspec))
: external_specification juicy_mem external_function Z :=
match f with
| (id, mk_funspec ((params, sigret) as fsig) cc A P Q NEP NEQ) =>
let sig := funsig2signature fsig cc in
Build_external_specification juicy_mem external_function Z
(fun ef => if oi_eq_dec (Some (id, sig)) (ef_id_sig ext_link ef) then (rmap* (sigT (fun ts => dependent_type_functor_rec ts A mpred)))%type else ext_spec_type Espec ef)
(funspec2pre ext_link A P (fst (split params)) id sig)
(funspec2post ext_link A Q id sig)
(fun rv z m => True)
end.
Local Open Scope pred.
Definition wf_funspec (f : funspec) :=
match f with
| mk_funspec sig cc A P Q _ _ =>
forall ts a (ge ge': genv) n args,
Genv.genv_symb ge = Genv.genv_symb ge' ->
P ts a (seplog.make_args n args (empty_environ ge))
|-- P ts a (seplog.make_args n args (empty_environ ge'))
end.
Program Definition funspec2jspec (ext_link: Strings.String.string -> ident) f : juicy_ext_spec Z :=
Build_juicy_ext_spec _ (funspec2extspec ext_link f) _ _ _.
Next Obligation.
destruct f; simpl; unfold funspec2pre, pureat; simpl; destruct f; simpl;
destruct f; simpl; intros.
if_tac [e0|e0].
* destruct e; try discriminate; injection e0 as E; subst i sg; intros a a' Hage.
intros [Hargs [phi0 [phi1 [Hjoin [Hx [Hy Hg]]]]]].
apply age1_juicy_mem_unpack in Hage.
destruct Hage as [Hage Hdry].
destruct (age1_join2 phi0 Hjoin Hage) as [x' [y' [Hjoin' [Hage' H]]]].
split; auto. exists x', y'; split; auto.
destruct P. split. eapply h; eauto.
split. apply (necR_trans (fst t0) phi1 y'); auto.
unfold necR. constructor; auto.
erewrite age1_ghost_of by eauto.
change (Some (ghost_PCM.ext_ref z, NoneP) :: nil) with
(own.ghost_approx (m_phi a') (Some (ghost_PCM.ext_ref z, NoneP) :: nil)).
destruct Hg; eexists; apply ghost_fmap_join; eauto.
* intros ? ?; auto.
destruct Espec; simpl; apply JE_pre_hered.
Qed.
Next Obligation.
destruct f; simpl; unfold funspec2post, pureat; simpl; destruct f; simpl;
destruct f; simpl; intros.
if_tac [e0|e0].
* destruct e; try discriminate; injection e0 as E; subst i sg. intros a a' Hage. destruct Q; simpl.
intros [phi0 [phi1 [Hjoin [Hx [Hy Hg]]]]].
apply age1_juicy_mem_unpack in Hage.
destruct Hage as [Hage Hdry].
destruct (age1_join2 phi0 Hjoin Hage) as [x' [y' [Hjoin' [Hage' H]]]].
exists x', y'; split; auto.
split; [solve[eapply h; eauto]|].
split. apply (necR_trans (fst t0) phi1 y'); auto.
unfold necR. constructor; auto.
erewrite age1_ghost_of by eauto.
change (Some (ghost_PCM.ext_ref z, NoneP) :: nil) with
(own.ghost_approx (m_phi a') (Some (ghost_PCM.ext_ref z, NoneP) :: nil)).
destruct Hg; eexists; apply ghost_fmap_join; eauto.
* intros ? ?; auto.
destruct Espec; simpl; apply JE_post_hered.
Qed.
Next Obligation.
intros ? ? ? ?; destruct f; destruct f; destruct f; simpl.
intros a' Hage; auto.
Qed.
End funspecs2jspec.
Definition funspecs_norepeat (fs : funspecs) := list_norepet (map fst fs).
Fixpoint add_funspecs_rec (ext_link: Strings.String.string -> ident) (Z : Type) (Espec : juicy_ext_spec Z) (fs : funspecs) :=
match fs with
| nil => Espec
| cons (i,f) fs' => funspec2jspec Z (add_funspecs_rec ext_link Z Espec fs') ext_link (i,f)
end.

Lemma add_funspecs_post (ext_link: Strings.String.string -> ident){Z Espec tret fs id sig cc A P Q NEP NEQ x ret m z ge_s} :
let ef := EF_external id (funsig2signature sig cc) in
funspecs_norepeat fs ->
In (ext_link id, (mk_funspec sig cc A P Q NEP NEQ)) fs ->
ext_spec_post (add_funspecs_rec ext_link Z Espec fs) ef x ge_s tret ret z m ->
exists (phi0 phi1 phi1' : rmap) (x': sigT (fun ts => dependent_type_functor_rec ts A mpred)),
join phi0 phi1 (m_phi m)
/\ necR phi1' phi1
/\ JMeq x (phi1',x')
/\ Q (projT1 x') (projT2 x') (make_ext_rval (filter_genv (symb2genv ge_s)) ret) phi0.