clutch.gen_diffpriv.examples.laplace_tapes
Tape-based Laplace example, ported from diffpriv.examples.laplace_tapes
onto gen_prob_lang / gen_diffpriv. Demonstrates the presampling
interface: allocate Laplace tapes on both sides, couple them (shifting the
spec draw by k), then read the presampled values deterministically.
A client only declares the signature Slap and a SampleIn instance; the
Laplace tape API (AllocTapeLaplace, ↪L/↪Lₛ, wp_couple_tapes_laplace)
comes from lib.laplace_tapes.
Note the #[global] Opaque sample_idx: in a *concrete* signature the index
projection sample_idx is convertible to a numeral, and wp_pures/tp_pures
would reduce it — after which the tape predicates (↪L, written with the
sample_idx projection) no longer *syntactically* iFrame against the
reduced hypotheses. Sealing sample_idx keeps the projection folded so the
generic sample-tape tactics' output frames against the Laplace tape views.
From clutch.prob Require Import differential_privacy.
From clutch.gen_diffpriv Require Import all.
From clutch.gen_diffpriv.lib Require Import laplace laplace_tapes.
#[global] Opaque sample_idx.
Section wp_example.
Context {Sg : Sig} `{!SampleIn laplace_family Sg} `{!diffprivGS Sg Σ}.
#[local] Open Scope R.
Local Notation fill := (@ectx_language.fill (gen_ectx_lang Sg)).
From clutch.gen_diffpriv Require Import all.
From clutch.gen_diffpriv.lib Require Import laplace laplace_tapes.
#[global] Opaque sample_idx.
Section wp_example.
Context {Sg : Sig} `{!SampleIn laplace_family Sg} `{!diffprivGS Sg Σ}.
#[local] Open Scope R.
Local Notation fill := (@ectx_language.fill (gen_ectx_lang Sg)).
The differentially-private use of tapes: presample-couple the two tapes so
the spec draw equals the impl draw (shift k = 0) at error
|loc − loc'|·ε, then read both off deterministically.
Fact wp_laplace_diffpriv (loc loc' : Z) (num den : Z) K :
0 < IZR num / IZR den →
let e := (λ: "loc", let: "α" := AllocTapeLaplace #num #den "loc" in
Laplace #num #den "loc" "α")%E in
{{{ ⤇ fill K (e #loc') ∗ ↯m (IZR (Z.abs (loc - loc')) * (IZR num / IZR den)) }}}
(e #loc)%E
{{{ (z : Z), RET #z; ⤇ fill K (Val #z) }}}.
Proof.
iIntros (Hpos ? ?) "(rhs & ε) post". subst e.
tp_pures. wp_pures.
tp_alloc_sample_tape as α' "α'".
wp_alloc_sample_tape α as "α".
tp_pures; wp_pures.
iApply (wp_couple_tapes_laplace loc loc' 0%Z (Z.abs (loc - loc')) α α' [] []
_ _ ltac:(rewrite Z.add_0_l; apply Z.le_refl) num den (IZR num / IZR den)
(IZR (Z.abs (loc - loc')) * (IZR num / IZR den)) ⊤
eq_refl Hpos eq_refl with "[$α $α' $ε]").
iIntros "%z [α α']". rewrite Z.add_0_r.
tp_sample_tape.
wp_apply (wp_sample_tape with "α").
iIntros "α". iApply "post". done.
Qed.
End wp_example.
0 < IZR num / IZR den →
let e := (λ: "loc", let: "α" := AllocTapeLaplace #num #den "loc" in
Laplace #num #den "loc" "α")%E in
{{{ ⤇ fill K (e #loc') ∗ ↯m (IZR (Z.abs (loc - loc')) * (IZR num / IZR den)) }}}
(e #loc)%E
{{{ (z : Z), RET #z; ⤇ fill K (Val #z) }}}.
Proof.
iIntros (Hpos ? ?) "(rhs & ε) post". subst e.
tp_pures. wp_pures.
tp_alloc_sample_tape as α' "α'".
wp_alloc_sample_tape α as "α".
tp_pures; wp_pures.
iApply (wp_couple_tapes_laplace loc loc' 0%Z (Z.abs (loc - loc')) α α' [] []
_ _ ltac:(rewrite Z.add_0_l; apply Z.le_refl) num den (IZR num / IZR den)
(IZR (Z.abs (loc - loc')) * (IZR num / IZR den)) ⊤
eq_refl Hpos eq_refl with "[$α $α' $ε]").
iIntros "%z [α α']". rewrite Z.add_0_r.
tp_sample_tape.
wp_apply (wp_sample_tape with "α").
iIntros "α". iApply "post". done.
Qed.
End wp_example.