Commit 003116b9 authored by Ralf Jung's avatar Ralf Jung

finally, working parallel substitution

parent bd333237
This diff is collapsed.
......@@ -53,7 +53,6 @@ Proof.
sim_apply sim_simple_let_val=>/=.
sim_apply (sim_simple_call 10 [] [] ε); [done|done|solve_res|].
intros rf frs frt FREL.
apply sim_simple_val.
Admitted.
......
......@@ -51,12 +51,12 @@ Definition sem_post (r: resUR) (n: nat) rs css' rt cst': Prop :=
(** We define a "semantic well-formedness", in some context. *)
Definition sem_wf (r: resUR) es et :=
xs : list (string * (result * result)),
Forall (λ '(_, (rs, rt)), rrel r rs rt) xs
xs : gmap string (result * result),
map_Forall (λ _ '(rs, rt), rrel r rs rt) xs
r ⊨ˢ{sem_steps,fs,ft}
(subst_map (prod_map id fst <$> xs) es, css)
(subst_map (fst <$> xs) es, css)
(subst_map (prod_map id snd <$> xs) et, cst)
(subst_map (snd <$> xs) et, cst)
: sem_post.
Lemma value_wf_soundness r v :
......@@ -69,32 +69,25 @@ Proof.
+ apply IHv. done.
Qed.
Lemma list_find_var {A B : Type} x (f : A B) (xs : list (string * A)):
list_find (is_var x) (prod_map id f <$> xs) =
prod_map id (prod_map id f) <$> list_find (is_var x) xs.
Proof.
rewrite list_find_fmap. f_equal. apply list_find_proper. auto.
Qed.
Lemma expr_wf_soundness r e :
expr_wf e sem_wf r e e.
Proof.
intros Hwf. induction e using expr_ind; simpl in Hwf.
revert r. induction e using expr_ind; simpl; intros r Hwf.
- (* Value *)
move=>_ _ /=.
apply sim_simple_val.
split; first admit.
split; first done.
split; first done. split; first done.
apply value_wf_soundness. done.
- (* Variable *)
move=>{Hwf} xs Hxswf /=.
rewrite !list_find_var. destruct (list_find (is_var x) xs) eqn:Hfind; simpl.
+ destruct p as [i [x' [rs rt]]]. simpl.
destruct (list_find_Some _ _ _ _ Hfind).
rewrite !lookup_fmap. specialize (Hxswf x).
destruct (xs !! x); simplify_eq/=.
+ destruct p as [rs rt].
intros σs σt ??. eapply sim_body_result=>_.
split; first admit.
split; first done.
split; first done. split; first done.
eapply (Forall_lookup_1 _ _ _ _ Hxswf H).
eapply (Hxswf (rs, rt)). done.
+ simpl.
(* FIXME: need lemma for when both sides are stuck on an unbound var. *)
admit.
......@@ -122,7 +115,11 @@ Proof.
intros r' n' rs css' rt cst' (-> & -> & -> & Hrel). simpl.
intros σs σt ??. eapply sim_body_let.
{ destruct rs; eauto. } { destruct rt; eauto. }
rewrite !subst'_subst_map.
change rs with (fst (rs, rt)). change rt with (snd (rs, rt)) at 2.
rewrite !binder_insert_map.
eapply sim_simplify', IHe2; [done..|by apply Hwf|].
admit. (* resources dont match?? *)
- (* Case *) admit.
Admitted.
......@@ -145,29 +142,9 @@ Proof.
admit. (* end_call_sat *)
- done.
}
rewrite (subst_l_map _ _ _ _ Hsubst1).
rewrite (subst_l_map _ _ _ _ Hsubst2).
set subst := fn_lists_to_subst (fun_args f) (zip (ValR <$> vs) (ValR <$> vt)).
(* FIXME: we do 3 very similar inductions here. Not sure how to generalize though. *)
replace (fn_lists_to_subst (fun_args f) (ValR <$> vs)) with (prod_map id fst <$> subst); last first.
{ rewrite /subst /fn_lists_to_subst. rewrite list_fmap_omap.
apply omap_ext'. revert Hrel. clear. revert vs vt.
induction (fun_args f); intros vs vt Hrel; simpl; first constructor.
inversion Hrel; simplify_eq/=; first constructor.
constructor. by destruct a. exact: IHl. }
replace (fn_lists_to_subst (fun_args f) (ValR <$> vt)) with (prod_map id snd <$> subst); last first.
{ rewrite /subst /fn_lists_to_subst. rewrite list_fmap_omap.
apply omap_ext'. revert Hrel. clear. revert vs vt.
induction (fun_args f); intros vs vt Hrel; simpl; first constructor.
inversion Hrel; simplify_eq/=; first constructor.
constructor. by destruct a. exact: IHl. }
destruct (subst_l_map _ _ _ _ _ _ _ _ Hsubst1 Hsubst2 Hrel) as (map & -> & -> & Hmap).
eapply sim_simplify, expr_wf_soundness; [done..|].
subst subst. revert Hrel. clear. revert vs vt.
induction (fun_args f); intros vs vt Hrel; simpl; first constructor.
inversion Hrel; simplify_eq/=; first constructor.
destruct a; first exact: IHl. constructor.
{ admit. (* resource stuff. *) }
exact: IHl.
admit. (* resource stuff. *)
Admitted.
Lemma sim_mod_funs_refl prog :
......
......@@ -41,6 +41,18 @@ Proof.
intros HΦ HH. eapply sim_local_body_post_mono; last exact: HH.
apply HΦ.
Qed.
Lemma sim_simplify'
(Φnew: resUR nat result call_id_stack result call_id_stack Prop)
(Φ: resUR nat result state result state Prop)
r n fs ft es σs et σt css cst :
( r n vs σs vt σt, Φnew r n vs σs.(scs) vt σt.(scs) Φ r n vs σs vt σt)
σs.(scs) = css
σt.(scs) = cst
r ⊨ˢ{ n , fs , ft } (es, css) (et, cst) : Φnew
r { n , fs , ft } (es, σs) (et, σt) : Φ.
Proof.
intros HΦ <-<-. eapply sim_simplify. done.
Qed.
Lemma sim_simple_post_mono Φ1 Φ2 r n fs ft es css et cst :
Φ1 <6= Φ2
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment