Commit 3d310509 authored by charguer's avatar charguer

renaming_fmap

parent 556f9fd9
LibState Fmap
LambdaSemantics LambdaSemantics
SepFunctor SepFunctor
LambdaSep LambdaSep
......
This diff is collapsed.
...@@ -14,7 +14,7 @@ Require Export LibFix LambdaSep. ...@@ -14,7 +14,7 @@ Require Export LibFix LambdaSep.
Open Scope heap_scope. Open Scope heap_scope.
(********************************************************************) (* ********************************************************************** *)
(* ** Type of a formula *) (* ** Type of a formula *)
(** A formula is a binary relation relating a pre-condition (** A formula is a binary relation relating a pre-condition
...@@ -26,7 +26,7 @@ Global Instance formula_inhab : Inhab formula. ...@@ -26,7 +26,7 @@ Global Instance formula_inhab : Inhab formula.
Proof using. apply (prove_Inhab (fun _ _ => True)). Qed. Proof using. apply (prove_Inhab (fun _ _ => True)). Qed.
(********************************************************************) (* ********************************************************************** *)
(* ** The [local] predicate *) (* ** The [local] predicate *)
(** Nested applications [local] are redundant *) (** Nested applications [local] are redundant *)
...@@ -56,10 +56,10 @@ Proof using. intros. unfolds. rewrite~ local_local. Qed. ...@@ -56,10 +56,10 @@ Proof using. intros. unfolds. rewrite~ local_local. Qed.
Hint Resolve local_is_local. Hint Resolve local_is_local.
(********************************************************************) (* ********************************************************************** *)
(* ** Characteristic formula generator *) (* ** Characteristic formula generator *)
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Input language for the characteristic formula generator, (* ** Input language for the characteristic formula generator,
where functions are named by a let-binding. *) where functions are named by a let-binding. *)
...@@ -102,7 +102,7 @@ Fixpoint trm_of_Trm (t : Trm) : trm := ...@@ -102,7 +102,7 @@ Fixpoint trm_of_Trm (t : Trm) : trm :=
Coercion trm_of_Trm : Trm >-> trm. Coercion trm_of_Trm : Trm >-> trm.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(** Size function used as measure for the CF generator: (** Size function used as measure for the CF generator:
it computes the size of a term, where all values counting it computes the size of a term, where all values counting
for one unit, including closures viewed as values. *) for one unit, including closures viewed as values. *)
...@@ -123,7 +123,7 @@ Proof using. ...@@ -123,7 +123,7 @@ Proof using.
Qed. Qed.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Definition of the [app] predicate *) (* ** Definition of the [app] predicate *)
(** The proposition [app f v H Q] asserts that the application (** The proposition [app f v H Q] asserts that the application
...@@ -133,7 +133,7 @@ Definition app f v H Q := ...@@ -133,7 +133,7 @@ Definition app f v H Q :=
triple (trm_app f v) H Q. triple (trm_app f v) H Q.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Definition of CF blocks *) (* ** Definition of CF blocks *)
(** These auxiliary definitions give the characteristic formula (** These auxiliary definitions give the characteristic formula
...@@ -160,7 +160,7 @@ Definition cf_fix (F1of : val -> val -> formula) ...@@ -160,7 +160,7 @@ Definition cf_fix (F1of : val -> val -> formula)
(F2of F) H Q. (F2of F) H Q.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Instance of [app] for primitive operations *) (* ** Instance of [app] for primitive operations *)
Lemma app_ref : forall v, Lemma app_ref : forall v,
...@@ -176,7 +176,7 @@ Lemma app_set : forall w l v, ...@@ -176,7 +176,7 @@ Lemma app_set : forall w l v,
Proof using. applys rule_set. Qed. Proof using. applys rule_set. Qed.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Definition of the CF generator *) (* ** Definition of the CF generator *)
(** The CF generator is a recursive function, defined using the (** The CF generator is a recursive function, defined using the
...@@ -218,10 +218,10 @@ Ltac simpl_cf := ...@@ -218,10 +218,10 @@ Ltac simpl_cf :=
rewrite cf_unfold; unfold cf_def. rewrite cf_unfold; unfold cf_def.
(********************************************************************) (* ********************************************************************** *)
(* ** Soundness proof *) (* ** Soundness proof *)
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Two substitution lemmas for the soundness proof *) (* ** Two substitution lemmas for the soundness proof *)
Hint Extern 1 (measure Trm_size _ _) => hnf; simpl; math. Hint Extern 1 (measure Trm_size _ _) => hnf; simpl; math.
...@@ -248,7 +248,7 @@ Proof using. ...@@ -248,7 +248,7 @@ Proof using.
Qed. Qed.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Soundness of the CF generator *) (* ** Soundness of the CF generator *)
Lemma cf_local : forall T, Lemma cf_local : forall T,
......
(********************************************************************) (* ********************************************************************** *)
(* ** Completeness proof *) (* ** Completeness proof *)
(* TO BE COMPLETED *) (* TO BE COMPLETED *)
...@@ -23,7 +23,7 @@ Lemma local_name : forall F (H:hprop) (Q:val->hprop), ...@@ -23,7 +23,7 @@ Lemma local_name : forall F (H:hprop) (Q:val->hprop),
Proof. Proof.
introv L M. rewrite L. intros m Hm. introv L M. rewrite L. intros m Hm.
exists (= m) \[] Q. splits~. exists (= m) \[] Q. splits~.
{ exists~ m state_empty. } { exists~ m fmap_empty. }
{ intros h. applys himpl_cancel_r. intros h' Hh'. applys~ hprop_gc_intro. } { intros h. applys himpl_cancel_r. intros h' Hh'. applys~ hprop_gc_intro. }
Qed. Qed.
...@@ -71,7 +71,7 @@ Theorem cf_complete_wrt_semantics : forall (T:Trm) m m' v', ...@@ -71,7 +71,7 @@ Theorem cf_complete_wrt_semantics : forall (T:Trm) m m' v',
Proof using. Proof using.
introv H. gen_eq t: (trm_of_Trm T); gen T; induction H; intros T E. introv H. gen_eq t: (trm_of_Trm T); gen T; induction H; intros T E.
{ simpl_Trm. simpl_cf. applys local_erase. hnf. { simpl_Trm. simpl_cf. applys local_erase. hnf.
intros m' E. subst. exists~ (state_empty:state) m. } intros m' E. subst. exists~ (fmap_empty:state) m. }
{ simpl_Trm. simpl_cf. applys local_erase. hnf. { simpl_Trm. simpl_cf. applys local_erase. hnf.
case_if; applys~ IHred. } case_if; applys~ IHred. }
{ simpl_Trm. { simpl_Trm.
......
...@@ -15,7 +15,7 @@ Require Export LibFix LambdaSepCredits. (* MODIFIED FOR CREDITS *) ...@@ -15,7 +15,7 @@ Require Export LibFix LambdaSepCredits. (* MODIFIED FOR CREDITS *)
Open Scope heap_scope. Open Scope heap_scope.
(********************************************************************) (* ********************************************************************** *)
(* ** Type of a formula *) (* ** Type of a formula *)
(** A formula is a binary relation relating a pre-condition (** A formula is a binary relation relating a pre-condition
...@@ -27,7 +27,7 @@ Global Instance formula_inhab : Inhab formula. ...@@ -27,7 +27,7 @@ Global Instance formula_inhab : Inhab formula.
Proof using. apply (prove_Inhab (fun _ _ => True)). Qed. Proof using. apply (prove_Inhab (fun _ _ => True)). Qed.
(********************************************************************) (* ********************************************************************** *)
(* ** The [local] predicate *) (* ** The [local] predicate *)
...@@ -58,10 +58,10 @@ Proof using. intros. unfolds. rewrite~ local_local. Qed. ...@@ -58,10 +58,10 @@ Proof using. intros. unfolds. rewrite~ local_local. Qed.
Hint Resolve local_is_local. Hint Resolve local_is_local.
(********************************************************************) (* ********************************************************************** *)
(* ** Characteristic formula generator *) (* ** Characteristic formula generator *)
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Input language for the characteristic formula generator, (* ** Input language for the characteristic formula generator,
where functions are named by a let-binding. *) where functions are named by a let-binding. *)
...@@ -104,7 +104,7 @@ Fixpoint trm_of_Trm (t : Trm) : trm := ...@@ -104,7 +104,7 @@ Fixpoint trm_of_Trm (t : Trm) : trm :=
Coercion trm_of_Trm : Trm >-> trm. Coercion trm_of_Trm : Trm >-> trm.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(** Size function used as measure for the CF generator: (** Size function used as measure for the CF generator:
it computes the size of a term, where all values counting it computes the size of a term, where all values counting
for one unit, including closures viewed as values. *) for one unit, including closures viewed as values. *)
...@@ -125,7 +125,7 @@ Proof using. ...@@ -125,7 +125,7 @@ Proof using.
Qed. Qed.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Definition of the [app] predicate *) (* ** Definition of the [app] predicate *)
(** The proposition [app f v H Q] asserts that the application (** The proposition [app f v H Q] asserts that the application
...@@ -135,7 +135,7 @@ Definition app f v H Q := ...@@ -135,7 +135,7 @@ Definition app f v H Q :=
triple (trm_app f v) H Q. triple (trm_app f v) H Q.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Definition of CF blocks *) (* ** Definition of CF blocks *)
(** These auxiliary definitions give the characteristic formula (** These auxiliary definitions give the characteristic formula
...@@ -167,7 +167,7 @@ Definition cf_fix (F1of : val -> val -> formula) ...@@ -167,7 +167,7 @@ Definition cf_fix (F1of : val -> val -> formula)
(F2of F) H Q. (F2of F) H Q.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Instance of [app] for primitive operations *) (* ** Instance of [app] for primitive operations *)
Lemma app_ref : forall v, Lemma app_ref : forall v,
...@@ -183,7 +183,7 @@ Lemma app_set : forall w l v, ...@@ -183,7 +183,7 @@ Lemma app_set : forall w l v,
Proof using. applys rule_set. Qed. Proof using. applys rule_set. Qed.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Definition of the CF generator *) (* ** Definition of the CF generator *)
(** The CF generator is a recursive function, defined using the (** The CF generator is a recursive function, defined using the
...@@ -225,10 +225,10 @@ Ltac simpl_cf := ...@@ -225,10 +225,10 @@ Ltac simpl_cf :=
rewrite cf_unfold; unfold cf_def. rewrite cf_unfold; unfold cf_def.
(********************************************************************) (* ********************************************************************** *)
(* ** Soundness proof *) (* ** Soundness proof *)
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Two substitution lemmas for the soundness proof *) (* ** Two substitution lemmas for the soundness proof *)
Hint Extern 1 (measure Trm_size _ _) => hnf; simpl; math. Hint Extern 1 (measure Trm_size _ _) => hnf; simpl; math.
...@@ -255,7 +255,7 @@ Proof using. ...@@ -255,7 +255,7 @@ Proof using.
Qed. Qed.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Soundness of the CF generator *) (* ** Soundness of the CF generator *)
Lemma cf_local : forall T, Lemma cf_local : forall T,
......
...@@ -9,10 +9,10 @@ License: MIT. ...@@ -9,10 +9,10 @@ License: MIT.
*) *)
Set Implicit Arguments. Set Implicit Arguments.
Require Export LibCore LibState. Require Export LibCore Fmap.
(************************************************************) (* ********************************************************************** *)
(* * Source language syntax *) (* * Source language syntax *)
(** Representation of variables and locations *) (** Representation of variables and locations *)
...@@ -66,17 +66,17 @@ with subst_trm (y : var) (w : val) (t : trm) : trm := ...@@ -66,17 +66,17 @@ with subst_trm (y : var) (w : val) (t : trm) : trm :=
(************************************************************) (* ********************************************************************** *)
(* * Source language semantics *) (* * Source language semantics *)
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(** Big-step evaluation *) (** Big-step evaluation *)
Section Red. Section Red.
Definition state := state loc val. Definition state := fmap loc val.
Local Open Scope state_scope. Local Open Scope fmap_scope.
Coercion val_prim : prim >-> val. Coercion val_prim : prim >-> val.
Coercion trm_val : val >-> trm. Coercion trm_val : val >-> trm.
...@@ -101,24 +101,24 @@ Inductive red : state -> trm -> state -> val -> Prop := ...@@ -101,24 +101,24 @@ Inductive red : state -> trm -> state -> val -> Prop :=
red m1 (trm_app v1 v2) m2 r red m1 (trm_app v1 v2) m2 r
| red_ref : forall ma mb v l, | red_ref : forall ma mb v l,
l <> null -> l <> null ->
mb = (state_single l v) -> mb = (fmap_single l v) ->
\# ma mb -> \# ma mb ->
red ma (prim_ref v) (mb \+ ma) (val_loc l) red ma (prim_ref v) (mb \+ ma) (val_loc l)
| red_get : forall m l v, | red_get : forall m l v,
state_data m l = Some v -> fmap_data m l = Some v ->
red m (prim_get (val_loc l)) m v red m (prim_get (val_loc l)) m v
| red_set : forall m m' l v, | red_set : forall m m' l v,
m' = state_update m l v -> m' = fmap_update m l v ->
red m (prim_set (val_pair (val_loc l) v)) m' val_unit. red m (prim_set (val_pair (val_loc l) v)) m' val_unit.
End Red. End Red.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Tactic [state_red] for proving [red] goals modulo (* ** Tactic [fmap_red] for proving [red] goals modulo
equalities between states *) equalities between states *)
Ltac state_red_base tt ::= Ltac fmap_red_base tt ::=
match goal with H: red _ ?t _ _ |- red _ ?t _ _ => match goal with H: red _ ?t _ _ |- red _ ?t _ _ =>
applys_eq H 2 4; try state_eq end. applys_eq H 2 4; try fmap_eq end.
...@@ -16,18 +16,18 @@ License: MIT. ...@@ -16,18 +16,18 @@ License: MIT.
Set Implicit Arguments. Set Implicit Arguments.
Require Export LambdaSemantics SepFunctor. Require Export LambdaSemantics SepFunctor.
Open Scope state_scope. Open Scope fmap_scope.
Ltac auto_star ::= jauto. Ltac auto_star ::= jauto.
(********************************************************************) (* ********************************************************************** *)
(* * Construction of core of the logic *) (* * Construction of core of the logic *)
Module SepBasicCore. Module SepBasicCore.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Types *) (* ** Types *)
Definition heap : Type := (state)%type. Definition heap : Type := (state)%type.
...@@ -35,24 +35,24 @@ Definition heap : Type := (state)%type. ...@@ -35,24 +35,24 @@ Definition heap : Type := (state)%type.
Definition hprop := heap -> Prop. Definition hprop := heap -> Prop.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Properties of heaps *) (* ** Properties of heaps *)
(** Definitions used for uniformity with other (** Definitions used for uniformity with other
instantiation of the functor *) instantiation of the functor *)
Notation "'heap_empty'" := (state_empty : heap) : heap_scope. Notation "'heap_empty'" := (fmap_empty : heap) : heap_scope.
Open Scope heap_scope. Open Scope heap_scope.
Notation "h1 \u h2" := (state_union h1 h2) Notation "h1 \u h2" := (fmap_union h1 h2)
(at level 51, right associativity) : heap_scope. (at level 51, right associativity) : heap_scope.
Definition heap_union_empty_l := state_union_empty_l. Definition heap_union_empty_l := fmap_union_empty_l.
Definition heap_union_empty_r := state_union_empty_r. Definition heap_union_empty_r := fmap_union_empty_r.
Definition heap_union_comm := state_union_comm_disjoint. Definition heap_union_comm := fmap_union_comm_disjoint.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Operators *) (* ** Operators *)
(* \[] *) (* \[] *)
...@@ -84,7 +84,7 @@ Definition hprop_gc := ...@@ -84,7 +84,7 @@ Definition hprop_gc :=
hprop_exists (fun (H:hprop) => H). hprop_exists (fun (H:hprop) => H).
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Notation *) (* ** Notation *)
Notation "\[]" := (hprop_empty) Notation "\[]" := (hprop_empty)
...@@ -97,21 +97,21 @@ Notation "\GC" := (hprop_gc) : heap_scope. ...@@ -97,21 +97,21 @@ Notation "\GC" := (hprop_gc) : heap_scope.
Open Scope heap_scope. Open Scope heap_scope.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Tactic for automation *) (* ** Tactic for automation *)
(* TODO: check how much is really useful *) (* TODO: check how much is really useful *)
Hint Extern 1 (_ = _ :> heap) => state_eq. Hint Extern 1 (_ = _ :> heap) => fmap_eq.
Tactic Notation "state_disjoint_pre" := Tactic Notation "fmap_disjoint_pre" :=
subst; rew_disjoint; jauto_set. subst; rew_disjoint; jauto_set.
Hint Extern 1 (\# _ _) => state_disjoint_pre. Hint Extern 1 (\# _ _) => fmap_disjoint_pre.
Hint Extern 1 (\# _ _ _) => state_disjoint_pre. Hint Extern 1 (\# _ _ _) => fmap_disjoint_pre.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Properties of empty *) (* ** Properties of empty *)
Lemma hprop_empty_intro : Lemma hprop_empty_intro :
...@@ -124,7 +124,7 @@ Lemma hprop_empty_inv : forall h, ...@@ -124,7 +124,7 @@ Lemma hprop_empty_inv : forall h,
Proof using. auto. Qed. Proof using. auto. Qed.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Properties of star *) (* ** Properties of star *)
Section Properties. Section Properties.
...@@ -159,7 +159,7 @@ Proof using. ...@@ -159,7 +159,7 @@ Proof using.
Qed. Qed.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Interaction of star with other operators *) (* ** Interaction of star with other operators *)
Lemma hprop_star_exists : forall A (J:A->hprop) H, Lemma hprop_star_exists : forall A (J:A->hprop) H,
...@@ -181,19 +181,19 @@ End Properties. ...@@ -181,19 +181,19 @@ End Properties.
End SepBasicCore. End SepBasicCore.
(********************************************************************) (* ********************************************************************** *)
(* * Properties of the logic *) (* * Properties of the logic *)
Module Export SepBasicSetup := SepLogicSetup SepBasicCore. Module Export SepBasicSetup := SepLogicSetup SepBasicCore.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Singleton heap *) (* ** Singleton heap *)
(** r ~~> v *) (** r ~~> v *)
Definition hprop_single (l:loc) (v:val) : hprop := Definition hprop_single (l:loc) (v:val) : hprop :=
fun h => h = state_single l v /\ l <> null. fun h => h = fmap_single l v /\ l <> null.
Notation "l '~~>' v" := (hprop_single l v) Notation "l '~~>' v" := (hprop_single l v)
(at level 32, no associativity) : heap_scope. (at level 32, no associativity) : heap_scope.
...@@ -202,7 +202,7 @@ Lemma hprop_star_single_same_loc_disjoint : forall (l:loc) (v1 v2:val), ...@@ -202,7 +202,7 @@ Lemma hprop_star_single_same_loc_disjoint : forall (l:loc) (v1 v2:val),
(l ~~> v1) \* (l ~~> v2) ==> \[False]. (l ~~> v1) \* (l ~~> v2) ==> \[False].
Proof using. Proof using.
intros. unfold hprop_single. intros h (h1&h2&E1&E2&D&E). false. intros. unfold hprop_single. intros h (h1&h2&E1&E2&D&E). false.
subst. applys* state_single_same_loc_disjoint. subst. applys* fmap_single_same_loc_disjoint.
Qed. Qed.
Global Opaque hprop_single. Global Opaque hprop_single.
...@@ -215,11 +215,11 @@ Ltac hcancel_hook H ::= ...@@ -215,11 +215,11 @@ Ltac hcancel_hook H ::=
end. end.
(********************************************************************) (* ********************************************************************** *)
(* * Reasoning Rules *) (* * Reasoning Rules *)
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Definition of triples *) (* ** Definition of triples *)
Definition triple t H Q := Definition triple t H Q :=
...@@ -230,7 +230,7 @@ Definition triple t H Q := ...@@ -230,7 +230,7 @@ Definition triple t H Q :=
/\ (Q v \* \GC \* H') h'. /\ (Q v \* \GC \* H') h'.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Structural rules *) (* ** Structural rules *)
Lemma rule_extract_exists : forall t (A:Type) (J:A->hprop) Q, Lemma rule_extract_exists : forall t (A:Type) (J:A->hprop) Q,
...@@ -285,7 +285,7 @@ Proof using. ...@@ -285,7 +285,7 @@ Proof using.
Qed. Qed.
(*------------------------------------------------------------------*) (* ---------------------------------------------------------------------- *)
(* ** Term rules *) (* ** Term rules *)
Lemma rule_val : forall v H Q, Lemma rule_val : forall v H Q,
...@@ -357,8 +357,8 @@ Lemma rule_ref : forall v, ...@@ -357,8 +357,8 @@ Lemma rule_ref : forall v,
triple (prim_ref v) \[] (fun r => Hexists l, \[r = val_loc l] \* l ~~> v). triple (prim_ref v) \[] (fun r => Hexists l, \[r = val_loc l] \* l ~~> v).
Proof using. Proof using.
intros. intros HF h N. intros. intros HF h N.
forwards~ (l&Dl&Nl): (state_disjoint_new null h v). forwards~ (l&Dl&Nl): (fmap_disjoint_new null h v).
sets h1': (state_single l v). sets h1': (fmap_single l v).
exists (h1' \u h) (val_loc l). splits~. exists (h1' \u h) (val_loc l). splits~.
{ applys~ red_ref. } { applys~ red_ref. }
{ exists h1' h. split. { exists h1' h. split.
...@@ -371,7 +371,7 @@ Lemma rule_get : forall v l, ...@@ -371,7 +371,7 @@ Lemma rule_get : forall v l,
Proof using. Proof using.
intros. intros HF h N. exists h v. splits~. intros. intros HF h N. exists h v. splits~.
{ applys red_get. destruct N as (?&?&(?&?)&?&?&?). { applys red_get. destruct N as (?&?&(?&?)&?&?&?).
subst h. applys~ state_union_single_read. } subst h. applys~ fmap_union_single_read. }
{ rew_heap. rewrite hprop_star_pure. split~. hhsimpl~. } { rew_heap. rewrite hprop_star_pure. split~. hhsimpl~. }
Qed. Qed.
...@@ -379,23 +379,23 @@ Lemma rule_set : forall w l v, ...@@ -379,23 +379,23 @@ Lemma rule_set : forall w l v,
triple (prim_set (val_pair (val_loc l) w)) (l ~~> v) (fun r => \[r = val_unit] \* l ~~> w). triple (prim_set (val_pair (val_loc l) w)) (l ~~> v) (fun r => \[r = val_unit] \* l ~~> w).
Proof using. Proof using.
intros. intros HF h N. destruct N as (h1&h2&(N0&N1)&N2&N3&N4). intros. intros HF h N. destruct N as (h1&h2&(N0&N1)&N2&N3&N4).
hnf in N1. sets h1': (state_single l w). hnf in N1. sets h1': (fmap_single l w).
exists (h1' \u h2) val_unit. splits~. exists (h1' \u h2) val_unit. splits~.
{ applys red_set. subst h h1. applys~ state_union_single_write. }