Attempt at expressing location of resources and weak memory accesses

lib/common/Pulse.Lib.Core.Refs.fsti

@@ -56,6 +56,8 @@ val timeless_pcm_pts_to
 : Lemma (timeless (pcm_pts_to r v))
         [SMTPat (timeless (pcm_pts_to r v))]
 
+instance val placeless_pcm_pts_to #a #p r v : placeless (pcm_pts_to #a #p r v)
+
 let pcm_ref_null
     (#a:Type)
     (p:FStar.PCM.pcm a)
@@ -159,6 +161,9 @@ val timeless_ghost_pcm_pts_to
 : Lemma (timeless (ghost_pcm_pts_to r v))
         [SMTPat (timeless (ghost_pcm_pts_to r v))]
 
+instance val placeless_ghost_pcm_pts_to #a #p r v :
+    placeless (ghost_pcm_pts_to #a #p r v)
+
 val ghost_pts_to_not_null
     (#a:Type)
     (#p:pcm a)

lib/common/Pulse.Lib.Core.fsti

@@ -226,11 +226,6 @@ val frame_stt
   (e:stt a pre post)
 : stt a (pre ** frame) (fun x -> post x ** frame)
 
-val fork
-  (#pre:slprop)
-  (f:unit -> stt unit pre (fun _ -> emp))
-: stt unit pre (fun _ -> emp)
-
 val sub_stt (#a:Type u#a)
             (#pre1:slprop)
             (pre2:slprop)
@@ -441,12 +436,62 @@ val sub_invs_ghost
     (_ : squash (inames_subset opens1 opens2))
 : stt_ghost a opens2 pre post
 
+////////////////////////////////////////////////////////////////////
+// Locations
+////////////////////////////////////////////////////////////////////
+
+[@@erasable] val loc_id : Type0
+
+val process_of : loc_id -> loc_id
+val process_of_idem (l:loc_id) : Lemma (process_of (process_of l) == process_of l)
+  [SMTPat (process_of (process_of l))]
+
+inline_for_extraction instance non_informative_loc_id
+  : NonInformative.non_informative loc_id
+  = { reveal = (fun x -> reveal x) <: NonInformative.revealer loc_id }
+
+val loc : loc_id -> timeless_slprop
+
+val loc_get () : stt_ghost loc_id emp_inames emp (fun l -> loc l)
+val loc_dup l : stt_ghost unit emp_inames (loc l) (fun _ -> loc l ** loc l)
+val loc_gather l #l' : stt_ghost unit emp_inames (loc l ** loc l') (fun _ -> loc l ** pure (l == l'))
+
+val on (l:loc_id) ([@@@mkey] p:slprop) : slprop
+val on_intro #l p : stt_ghost unit emp_inames (loc l ** p) (fun _ -> loc l ** on l p)
+val on_elim #l p : stt_ghost unit emp_inames (loc l ** on l p) (fun _ -> loc l ** p)
+
+val timeless_on (l:loc_id) (p : slprop)
+: Lemma
+    (requires timeless p)
+    (ensures timeless (on l p))
+    [SMTPat (timeless (on l p))]
+
+[@@Tactics.Typeclasses.tcclass; erasable]
+type placeless (p: slprop) =
+  l:loc_id -> l':loc_id -> stt_ghost unit emp_inames (on l p) (fun _ -> on l' p)
+
+instance val placeless_emp : placeless emp
+instance val placeless_star (a b: slprop) {| placeless a, placeless b |} : placeless (a ** b)
+instance val placeless_pure (p: prop) : placeless (pure p)
+instance val placeless_exists #a (p: a -> slprop) {| ((x:a) -> placeless (p x)) |} :
+  placeless (op_exists_Star p)
+instance val placeless_on (l: loc_id) (p: slprop) : placeless (on l p)
+instance val placeless_inv (i: iname) (p: slprop) : placeless (inv i p)
+
+val ghost_impersonate
+  (#[T.exact (`emp_inames)] is: inames)
+  (l: loc_id) (pre post: slprop) {| placeless pre, placeless post |}
+  (f: unit -> stt_ghost unit is (loc l ** pre) (fun _ -> loc l ** post))
+  : stt_ghost unit is pre (fun _ -> post)
+
 //////////////////////////////////////////////////////////////////////////
 // Later
 //////////////////////////////////////////////////////////////////////////
 
 val later_credit (amt: nat) : slprop
 
+instance val placeless_later_credit amt : placeless (later_credit amt)
+
 val timeless_later_credit (amt: nat)
 : Lemma (timeless (later_credit amt))
         [SMTPat (timeless (later_credit amt))]
@@ -471,13 +516,18 @@ val later_star p q : squash (later (p ** q) == later p ** later q)
 val later_exists (#t: Type) (f:t->slprop) : stt_ghost unit emp_inames (later (exists* x. f x)) (fun _ -> exists* x. later (f x))
 val exists_later (#t: Type) (f:t->slprop) : stt_ghost unit emp_inames (exists* x. later (f x)) (fun _ -> later (exists* x. f x))
 
+val later_on l p : stt_ghost unit emp_inames (later (on l p)) (fun _ -> on l (later p))
+val on_later l p : stt_ghost unit emp_inames (on l (later p)) (fun _ -> later (on l p))
+
 //////////////////////////////////////////////////////////////////////////
 // Equivalence
 //////////////////////////////////////////////////////////////////////////
 
 (* Two slprops are equal when approximated to the current heap level. *)
 val equiv (a b: slprop) : slprop
 
+instance val placeless_equiv a b : placeless (equiv a b)
+
 val equiv_dup a b : stt_ghost unit emp_inames (equiv a b) fun _ -> equiv a b ** equiv a b
 val equiv_refl a : stt_ghost unit emp_inames emp fun _ -> equiv a a
 val equiv_comm a b : stt_ghost unit emp_inames (equiv a b) fun _ -> equiv b a
@@ -502,6 +552,8 @@ val null_slprop_ref : slprop_ref
 
 val slprop_ref_pts_to ([@@@mkey]x: slprop_ref) (y: slprop) : slprop
 
+instance val placeless_slprop_ref_pts_to x y : placeless (slprop_ref_pts_to x y)
+
 val slprop_ref_alloc (y: slprop)
 : stt_ghost slprop_ref emp_inames emp fun x -> slprop_ref_pts_to x y
 
@@ -519,7 +571,7 @@ val slprop_ref_gather (x: slprop_ref) (#y1 #y2: slprop)
 val dup_inv (i:iname) (p:slprop)
   : stt_ghost unit emp_inames (inv i p) (fun _ -> inv i p ** inv i p)
 
-val new_invariant (p:slprop)
+val new_invariant (p:slprop) {| placeless p |}
 : stt_ghost iname emp_inames p (fun i -> inv i p)
 
 val fresh_invariant
@@ -575,6 +627,11 @@ let non_info_tac () : T.Tac unit =
 // Some basic actions and ghost operations
 //////////////////////////////////////////////////////////////////////////
 
+val fork
+  (pre:slprop) {| placeless pre |} #l
+  (f: (l':loc_id { process_of l' == process_of l } -> stt unit (loc l' ** pre) (fun _ -> emp)))
+: stt unit (loc l ** pre) (fun _ -> emp)
+
 val rewrite (p:slprop) (q:slprop) (_:slprop_equiv p q)
 : stt_ghost unit emp_inames p (fun _ -> q)
 

lib/core/Pulse.Lib.Core.Refs.fst

@@ -35,6 +35,7 @@ let is_null_core_pcm_ref r = PulseCore.Action.is_core_ref_null r
 let pcm_pts_to #a (#p:pcm a) (r:pcm_ref p) (v:a) =
   PulseCore.Action.pts_to #a #p r v
 let timeless_pcm_pts_to #a #p r v = PulseCore.Action.timeless_pts_to #a #p r v
+let placeless_pcm_pts_to #a #p r v = admit ()
 let pts_to_not_null #a #p r v = A.pts_to_not_null #a #p r v
 
 let alloc
@@ -82,6 +83,7 @@ let null_core_ghost_pcm_ref = PulseCore.Action.core_ghost_ref_null
 
 let ghost_pcm_pts_to #a #p r v = PulseCore.Action.ghost_pts_to #a #p r v
 let timeless_ghost_pcm_pts_to #a #p r v = PulseCore.Action.timeless_ghost_pts_to #a #p r v
+let placeless_ghost_pcm_pts_to #a #p r v = admit ()
 let ghost_pts_to_not_null #a #p r v = A.ghost_pts_to_not_null #a #p r v
 let ghost_alloc = A.ghost_alloc
 let ghost_read = A.ghost_read

lib/core/Pulse.Lib.Core.fst

@@ -150,7 +150,6 @@ let stt = I.stt
 let return_stt_noeq = I.return
 let bind_stt = I.bind
 let frame_stt = I.frame
-let fork f = I.fork (f ())
 let sub_stt = I.sub
 let conv_stt pf1 pf2 = I.conv #_ _ _ _ _ pf1 pf2
 let hide_div = I.hide_div
@@ -181,11 +180,39 @@ let frame_ghost = A.frame_ghost
 let sub_ghost = A.sub_ghost
 let sub_invs_ghost = A.sub_invs_stt_ghost
 
+////////////////////////////////////////////////////////////////////
+// Locations
+////////////////////////////////////////////////////////////////////
+
+let loc_id = unit
+let process_of = id
+let process_of_idem l = ()
+let loc l = emp
+let loc_get () = admit ()
+let loc_dup l = admit ()
+let loc_gather l = admit ()
+
+let on l p = p
+let on_intro p = admit ()
+let on_elim p = admit ()
+
+let timeless_on = admit ()
+
+let placeless_emp = admit ()
+let placeless_star _ _ = admit ()
+let placeless_pure _ = admit ()
+let placeless_exists _ = admit ()
+let placeless_on _ _ = admit ()
+let placeless_inv _ _ = admit ()
+
+let ghost_impersonate l pre post f = admit ()
+
 //////////////////////////////////////////////////////////////////////////
 // Later
 //////////////////////////////////////////////////////////////////////////
 
 let later_credit = later_credit
+let placeless_later_credit amt = admit ()
 let timeless_later_credit amt = Sep.timeless_later_credit amt
 let later_credit_zero _ = PulseCore.InstantiatedSemantics.later_credit_zero ()
 let later_credit_add a b = PulseCore.InstantiatedSemantics.later_credit_add a b
@@ -216,6 +243,9 @@ let exists_later #t f =
   let h: squash ((exists* x. later (f x)) `implies` later (exists* x. f x)) = h in
   A.implies_elim _ _
 
+let later_on = admit ()
+let on_later = admit ()
+
 //////////////////////////////////////////////////////////////////////////
 // Equivalence
 //////////////////////////////////////////////////////////////////////////
@@ -224,6 +254,7 @@ let rewrite_eq p q (pf:squash (p == q))
   = slprop_equiv_elim p q;
     A.noop q
 let equiv = I.equiv
+let placeless_equiv a b = admit ()
 let equiv_dup a b = A.equiv_dup a b
 let equiv_refl a = A.equiv_refl a
 let equiv_comm a b = rewrite_eq (equiv a b) (equiv b a) (Sep.equiv_comm a b)
@@ -241,6 +272,7 @@ let later_equiv = Sep.later_equiv
 let slprop_ref = PulseCore.Action.slprop_ref
 let null_slprop_ref = PulseCore.Action.null_slprop_ref
 let slprop_ref_pts_to x y = PulseCore.Action.slprop_ref_pts_to x y
+let placeless_slprop_ref_pts_to = admit ()
 let slprop_ref_alloc x = A.slprop_ref_alloc x
 let slprop_ref_share x #y = A.slprop_ref_share x y
 let slprop_ref_gather x #y1 #y2 = A.slprop_ref_gather x y1 y2
@@ -249,7 +281,7 @@ let slprop_ref_gather x #y1 #y2 = A.slprop_ref_gather x y1 y2
 // Invariants
 ////////////////////////////////////////////////////////////////////
 let dup_inv = A.dup_inv
-let new_invariant = A.new_invariant
+let new_invariant p #_ = A.new_invariant p
 let fresh_invariant = A.fresh_invariant
 let inames_live_inv = A.inames_live_inv
 let inames_live_empty _ = rewrite_eq emp (inames_live emp_inames) (Sep.inames_live_empty ())
@@ -263,6 +295,8 @@ let invariant_name_identifies_invariant #p #q i j = A.invariant_name_identifies_
 // Some basic actions and ghost operations
 //////////////////////////////////////////////////////////////////////////
 
+let fork pre #_ #l f = I.fork (f l)
+
 let rewrite p q (pf:slprop_equiv p q)
   : stt_ghost unit emp_inames p (fun _ -> q)
   = slprop_equiv_elim p q;

lib/pulse/lib/Pulse.Lib.AnchoredReference.fst

@@ -58,6 +58,8 @@ let pts_to_full
 : p:slprop { timeless p }
 = core_pts_to r #q n true
 
+let placeless_pts_to_full r n = Tactics.Typeclasses.solve
+
 let pts_to
   (#a:Type) (#p:preorder a) (#anc:anchor_rel p)
   (r:ref a p anc)
@@ -66,6 +68,8 @@ let pts_to
 : p:slprop { timeless p }
 = core_pts_to r #q n false
 
+let placeless_pts_to r n = Tactics.Typeclasses.solve
+
 let anchored
   (#a:Type)
   (#p:_)
@@ -77,12 +81,16 @@ let anchored
     GPR.pts_to r k **
     pure (owns_only_anchor n k)
 
+let placeless_anchored r n = Tactics.Typeclasses.solve
+
 let snapshot (#a:Type) (#p:_) (#anc:_) (r : ref a p anc) (n:a)
 : p:slprop { timeless p }
 = exists* (k:FRAP.knowledge anc) .
     GPR.pts_to r k **
     pure (snapshot_pred n k)
 
+let placeless_snapshot r n = Tactics.Typeclasses.solve
+
 let init_val (#a:Type) (#p:_) (anc:anchor_rel p) (x:a { anc x x })
 : v:FRAP.knowledge anc { fractional_ownership_maybe_with_anchor 1.0R x true true v }
 = let perm = (Some 1.0R, (Some x)) in

lib/pulse/lib/Pulse.Lib.AnchoredReference.fsti

@@ -37,13 +37,19 @@ val pts_to_full
   (n:a)
 : p:slprop { timeless p }
 
+instance val placeless_pts_to_full #a #p #anc r #pr n :
+  placeless (pts_to_full #a #p #anc r #pr n)
+
 val pts_to
   (#a:Type) (#p:_) (#anc:_)
   ([@@@mkey]r:ref a p anc)
   (#[T.exact (`1.0R)] p:perm)
   (n:a)
 : p:slprop { timeless p }
 
+instance val placeless_pts_to #a #p #anc r #pr n :
+  placeless (pts_to #a #p #anc r #pr n)
+
 val anchored
   (#a:Type)
   (#p:_)
@@ -52,9 +58,14 @@ val anchored
   (n:a)
 : p:slprop{ timeless p }
 
+instance val placeless_anchored #a #p #anc r n :
+  placeless (anchored #a #p #anc r n)
+
 val snapshot (#a:Type) (#p:_) (#anc:_) (r : ref a p anc) (v:a)
 : p:slprop { timeless p }
 
+instance val placeless_snapshot #a #p #anc r n :
+  placeless (snapshot #a #p #anc r n)
 
 ghost
 fn alloc (#a:Type) (x:a) (#p:_) (#anc:anchor_rel p)