|
|
From stdpp Require Import gmap base relations.
|
|
|
From iris Require Import prelude.
|
|
|
From semantics.ts.systemf Require Import lang notation parallel_subst types tactics.
|
|
|
From semantics.ts.systemf Require logrel binary_logrel existential_invariants.
|
|
|
|
|
|
(** * Exercise Sheet 5 *)
|
|
|
|
|
|
Implicit Types
|
|
|
(e : expr)
|
|
|
(v : val)
|
|
|
(A B : type)
|
|
|
.
|
|
|
|
|
|
(** ** Exercise 3 (LN Exercise 23): Existential Fun *)
|
|
|
Section existential.
|
|
|
(** Since extending our language with records would be tedious,
|
|
|
we encode records using nested pairs.
|
|
|
|
|
|
For instance, we would represent the record type
|
|
|
{ add : Int → Int → Int; sub : Int → Int → Int; neg : Int → Int }
|
|
|
as (Int → Int → Int) × (Int → Int → Int) × (Int → Int).
|
|
|
|
|
|
Similarly, we would represent the record value
|
|
|
{ add := λ: "x" "y", "x" + "y";
|
|
|
sub := λ: "x" "y", "x" - "y";
|
|
|
neg := λ: "x", #0 - "x"
|
|
|
}
|
|
|
as the nested pair
|
|
|
((λ: "x" "y", "x" + "y", (* add *)
|
|
|
λ: "x" "y", "x" - "y"), (* sub *)
|
|
|
λ: "x", #0 - "x"). (* neg *)
|
|
|
|
|
|
*)
|
|
|
|
|
|
(** We will also assume a recursion combinator. We have not formally added it to our language, but we could do so. *)
|
|
|
Context (Fix : string → string → expr → val).
|
|
|
Notation "'fix:' f x := e" := (Fix f x e)%E
|
|
|
(at level 200, f, x at level 1, e at level 200,
|
|
|
format "'[' 'fix:' f x := '/ ' e ']'") : val_scope.
|
|
|
Notation "'fix:' f x := e" := (Fix f x e)%E
|
|
|
(at level 200, f, x at level 1, e at level 200,
|
|
|
format "'[' 'fix:' f x := '/ ' e ']'") : expr_scope.
|
|
|
Context (fix_typing : ∀ n Γ (f x: string) (A B: type) (e: expr),
|
|
|
type_wf n A →
|
|
|
type_wf n B →
|
|
|
f ≠ x →
|
|
|
TY n; <[x := A]> (<[f := (A → B)%ty]> Γ) ⊢ e : B →
|
|
|
TY n; Γ ⊢ (fix: f x := e) : (A → B)).
|
|
|
|
|
|
Definition ISET : type :=∃: (#0 (* empty *)
|
|
|
× (Int → #0) (* singleton *)
|
|
|
× (#0 → #0 → #0) (* union *)
|
|
|
× (#0 → #0 → Bool) (* subset *)
|
|
|
).
|
|
|
|
|
|
(* We represent sets as functions of type ((Int → Bool) × Int × Int),
|
|
|
storing the mapping, the minimum value, and the maximum value. *)
|
|
|
Definition mini : val := λ: "x" "y", if: "x" < "y" then "x" else "y".
|
|
|
Definition maxi : val := λ: "x" "y", if: "x" < "y" then "x" else "y".
|
|
|
|
|
|
Definition iterupiv : val :=
|
|
|
λ: "f" "max", fix: "rec" "acc" :=
|
|
|
let: "i" := Fst "acc" in let: "b" := Snd "acc" in
|
|
|
if: "max" < "i" then "b" else "rec" ("i" + #1, "f" "i" "b").
|
|
|
Definition iterupv : val :=
|
|
|
λ: "f" "init" "min" "max", iterupiv "f" "max" ("min", "init").
|
|
|
Lemma iterupv_typed n Γ : TY n; Γ ⊢ iterupv : ((Int → Bool → Bool) → Bool → Int → Int → Bool).
|
|
|
Proof.
|
|
|
repeat solve_typing. apply fix_typing; solve_typing.
|
|
|
done.
|
|
|
Qed.
|
|
|
|
|
|
Definition iset : val :=pack (((λ: "x", #false), #0, #0), (* empty *)
|
|
|
(λ: "n", ((λ: "x", "n" = "x"), "n", "n")), (* singleton *)
|
|
|
(* union *)
|
|
|
(λ: "s1" "s2", ((λ: "x", if: (Fst $ Fst "s1") "x" then #true else (Fst $ Fst "s2") "x"), mini (Snd $ Fst "s1") (Snd $ Fst "s1"), maxi (Snd "s1") (Snd "s1"))),
|
|
|
(* subset *)
|
|
|
(λ: "s1" "s2",
|
|
|
let: "min" := Snd $ Fst "s1" in
|
|
|
let: "max" := Snd $ "s1" in
|
|
|
(* iteration variable is set to #false if we detect a subset violation *)
|
|
|
iterupv (λ: "i" "acc", if: (Fst $ Fst "s2") "i" then "acc" else #false) #true "min" "max"
|
|
|
)).
|
|
|
|
|
|
Lemma iset_typed n Γ : TY n; Γ ⊢ iset : ISET.
|
|
|
Proof.
|
|
|
(* HINT: use repeated solve_typing with an explicit apply fix_typing inbetween *)
|
|
|
unfold iset.
|
|
|
repeat solve_typing.
|
|
|
by apply fix_typing; solve_typing.
|
|
|
Qed.
|
|
|
|
|
|
Definition ISETE : type :=∃: (#0 (* empty *)
|
|
|
× (Int → #0) (* singleton *)
|
|
|
× (#0 → #0 → #0) (* union *)
|
|
|
× (#0 → #0 → Bool) (* subset *)
|
|
|
× (#0 → #0 → Bool) (* equality *)
|
|
|
).
|
|
|
|
|
|
Definition add_equality : val :=λ: "is", unpack "is" as "isi" in
|
|
|
let: "subset" := Snd "isi" in
|
|
|
pack ("isi", λ: "s1" "s2", if: "subset" "s1" "s2" then "subset" "s2" "s1" else #false).
|
|
|
|
|
|
Lemma add_equality_typed n Γ : TY n; Γ ⊢ add_equality : (ISET → ISETE)%ty.
|
|
|
Proof.
|
|
|
repeat solve_typing.
|
|
|
|
|
|
Qed.
|
|
|
|
|
|
End existential.
|
|
|
|
|
|
Section ex4.
|
|
|
Import logrel existential_invariants.
|
|
|
(** ** Exercise 4 (LN Exercise 30): Evenness *)
|
|
|
(* Consider the following existential type: *)
|
|
|
Definition even_type : type :=
|
|
|
∃: (#0 × (* zero *)
|
|
|
(#0 → #0) × (* add2 *)
|
|
|
(#0 → Int) (* toint *)
|
|
|
)%ty.
|
|
|
|
|
|
(* and consider the following implementation of [even_type]: *)
|
|
|
Definition even_impl : val :=
|
|
|
pack (#0,
|
|
|
λ: "z", #2 + "z",
|
|
|
λ: "z", "z"
|
|
|
).
|
|
|
(* We want to prove that [toint] will only every yield even numbers. *)
|
|
|
(* For that purpose, assume that we have a function [even] that decides even parity available: *)
|
|
|
Context (even_dec : val).
|
|
|
Context (even_dec_typed : ∀ n Γ, TY n; Γ ⊢ even_dec : (Int → Bool)).
|
|
|
|
|
|
(* a) Change [even_impl] to [even_impl_instrumented] such that [toint] asserts evenness of the argument before returned.
|
|
|
You may use the [assert] expression defined in existential_invariants.v.
|
|
|
*)
|
|
|
|
|
|
Definition even_impl_instrumented : val :=pack (#0,
|
|
|
λ: "z", #2 + "z",
|
|
|
λ: "z", assert (even_dec "z");; "z"
|
|
|
).
|
|
|
|
|
|
(* b) Prove that [even_impl_instrumented] is safe. You may assume that even works as intended,
|
|
|
but be sure to state this here. *)
|
|
|
Context (even_spec : ∀ z: Z, big_step (even_dec #z) #(Z.even z)).
|
|
|
Context (even_closed : is_closed [] even_dec).
|
|
|
|
|
|
Lemma even_impl_instrumented_safe δ:
|
|
|
𝒱 even_type δ even_impl_instrumented.
|
|
|
Proof.
|
|
|
unfold even_type. simp type_interp.
|
|
|
eexists _. split; first done.
|
|
|
|
|
|
pose_sem_type (λ v, ∃ z : Z, Z.Even z ∧ v = #z) as τ.
|
|
|
{ intros v (z & ? & ->). done. }
|
|
|
exists τ.
|
|
|
|
|
|
simp type_interp.
|
|
|
eexists _, _. split_and!; first done.
|
|
|
- simp type_interp. eexists _, _. split_and!; first done.
|
|
|
+ simp type_interp. simpl. exists 0. split; last done.
|
|
|
apply Z.even_spec. done.
|
|
|
+ simp type_interp. eexists _, _. split_and!; [done | done | ].
|
|
|
intros v. simp type_interp. simpl.
|
|
|
intros (z & Heven & ->). exists #(2 + z)%Z. split; first bs_step_det.
|
|
|
simp type_interp. simpl. exists (2 + z)%Z.
|
|
|
split; last done. destruct Heven as (z' & ->).
|
|
|
exists (z' + 1)%Z. lia.
|
|
|
- simp type_interp.
|
|
|
eexists _, _. split_and!; [done | | ].
|
|
|
{ simpl. rewrite !andb_True. split_and!;[ | done..].
|
|
|
eapply is_closed_weaken; first done. apply list_subseteq_nil.
|
|
|
}
|
|
|
intros v'. simp type_interp. simpl. intros (z & Heven & ->).
|
|
|
exists #z.
|
|
|
split.
|
|
|
+ bs_step_det. eapply bs_if_true; last bs_step_det.
|
|
|
replace true with (Z.even z); first by eapply even_spec.
|
|
|
by apply Z.even_spec.
|
|
|
+ simp type_interp. exists z. done.
|
|
|
Qed.
|
|
|
End ex4.
|
|
|
|
|
|
(** ** Exercise 5 (LN Exercise 31): Abstract sums *)
|
|
|
Section ex5.
|
|
|
Import logrel existential_invariants.
|
|
|
Definition sum_ex_type (A B : type) : type :=
|
|
|
∃: ((A.[ren (+1)] → #0) ×
|
|
|
(B.[ren (+1)] → #0) ×
|
|
|
(∀: #1 → (A.[ren (+2)] → #0) → (B.[ren (+2)] → #0) → #0)
|
|
|
)%ty.
|
|
|
|
|
|
Definition sum_ex_impl : val :=
|
|
|
pack (λ: "x", (#1, "x"),
|
|
|
λ: "x", (#2, "x"),
|
|
|
Λ, λ: "x" "f1" "f2", if: Fst "x" = #1 then "f1" (Snd "x") else "f2" (Snd "x")
|
|
|
).
|
|
|
|
|
|
Lemma sum_ex_safe A B δ:
|
|
|
𝒱 (sum_ex_type A B) δ sum_ex_impl.
|
|
|
Proof.
|
|
|
intros. unfold sum_ex_type. simp type_interp.
|
|
|
eexists _. split; first done.
|
|
|
|
|
|
pose_sem_type (λ v, (∃ v', 𝒱 A δ v' ∧ v = (#1, v')%V) ∨ (∃ v', 𝒱 B δ v' ∧ v = (#2, v')%V)) as τ.
|
|
|
{ intros v [(v' & Hv & ->) | (v' & Hv & ->)]; simpl; by eapply val_rel_closed. }
|
|
|
exists τ.
|
|
|
|
|
|
simp type_interp. eexists _, _. split; first done.
|
|
|
split. 1: simp type_interp; eexists _, _; split; first done; split.
|
|
|
- simp type_interp. eexists _, _. split_and!; [done..|].
|
|
|
intros v' Hv'. simp type_interp. simpl. eexists. split; first bs_step_det.
|
|
|
simp type_interp. simpl. left.
|
|
|
eexists; split; last done. eapply sem_val_rel_cons; done.
|
|
|
- simp type_interp. eexists _, _. split_and!; [done..|].
|
|
|
intros v' Hv'. simp type_interp. simpl. eexists. split; first bs_step_det.
|
|
|
simp type_interp. simpl. right.
|
|
|
eexists; split; last done. eapply sem_val_rel_cons; done.
|
|
|
- simp type_interp. eexists _. split_and!; [done..|].
|
|
|
intros τ'. simp type_interp. eexists. split; first bs_step_det.
|
|
|
simp type_interp. eexists _, _; split_and!; [done..|].
|
|
|
intros v'. simp type_interp. simpl. intros [(v & Hv & ->) | (v & Hv & ->)].
|
|
|
+ eexists. split; first bs_step_det.
|
|
|
specialize (val_rel_closed _ _ _ Hv) as ?.
|
|
|
simp type_interp. eexists _, _; split_and!; [done| simplify_closed | ].
|
|
|
intros v'. simp type_interp.
|
|
|
intros (? & ? & -> & ? & Hv').
|
|
|
specialize (Hv' v). simp type_interp in Hv'. destruct Hv' as (? & ? & Hv').
|
|
|
{ revert Hv. rewrite sem_val_rel_cons. rewrite sem_val_rel_cons. asimpl. done. }
|
|
|
eexists _. split; first bs_step_det.
|
|
|
simp type_interp. eexists _, _. split_and!; [done| simplify_closed | ].
|
|
|
intros v'. simp type_interp. intros (? & ? & -> & ? & _).
|
|
|
eexists _. split.
|
|
|
{ bs_step_det. eapply bs_if_true; bs_step_det.
|
|
|
case_decide; bs_step_det.
|
|
|
erewrite lang.subst_is_closed; bs_step_det.
|
|
|
destruct x; simpl; simplify_closed.
|
|
|
}
|
|
|
simp type_interp. simpl. simp type_interp in Hv'.
|
|
|
+ eexists. split; first bs_step_det.
|
|
|
specialize (val_rel_closed _ _ _ Hv) as ?.
|
|
|
simp type_interp. eexists _, _; split_and!; [done| simplify_closed | ].
|
|
|
intros v'. simp type_interp.
|
|
|
intros (? & ? & -> & ? & _).
|
|
|
eexists _. split; first bs_step_det.
|
|
|
simp type_interp. eexists _, _. split_and!; [done| simplify_closed | ].
|
|
|
intros v'. simp type_interp. intros (? & ? & -> & ? & Hv').
|
|
|
specialize (Hv' v). simp type_interp in Hv'. destruct Hv' as (? & ? & Hv').
|
|
|
{ revert Hv. rewrite sem_val_rel_cons. rewrite sem_val_rel_cons. asimpl. done. }
|
|
|
|
|
|
eexists _. split.
|
|
|
{ bs_step_det. eapply bs_if_false; bs_step_det. }
|
|
|
simp type_interp. simpl. simp type_interp in Hv'.
|
|
|
Qed.
|
|
|
End ex5.
|
|
|
|
|
|
(** For Exercise 6 and 7, see binary_logrel.v *)
|
|
|
|
|
|
(** ** Exercise 8 (LN Exercise 35): Contextual equivalence *)
|
|
|
Section ex8.
|
|
|
Import binary_logrel.
|
|
|
Definition sum_ex_impl' : val :=
|
|
|
pack ((λ: "x", InjL "x"),
|
|
|
(λ: "x", InjR "x"),
|
|
|
(Λ, λ: "x" "f1" "f2", Case "x" "f1" "f2")
|
|
|
).
|
|
|
|
|
|
Lemma sum_ex_impl'_typed n Γ A B :
|
|
|
type_wf n A →
|
|
|
type_wf n B →
|
|
|
TY n; Γ ⊢ sum_ex_impl' : sum_ex_type A B.
|
|
|
Proof.
|
|
|
intros.
|
|
|
eapply (typed_pack _ _ _ (A + B)%ty).
|
|
|
all: asimpl; solve_typing.
|
|
|
Qed.
|
|
|
|
|
|
Lemma sum_ex_impl_equiv n Γ A B :
|
|
|
ctx_equiv n Γ sum_ex_impl' sum_ex_impl (sum_ex_type A B).
|
|
|
Proof.
|
|
|
intros.
|
|
|
eapply sem_typing_ctx_equiv; [done | done | ].
|
|
|
do 2 (split; first done).
|
|
|
intros θ1 θ2 δ Hctx.
|
|
|
rewrite (subst_map_is_closed []); [ | done | intros; simplify_list_elem ].
|
|
|
rewrite (subst_map_is_closed []); [ | done | intros; simplify_list_elem ].
|
|
|
simp type_interp.
|
|
|
eexists _, _. split_and!; [bs_step_det.. | ].
|
|
|
unfold sum_ex_type. simp type_interp.
|
|
|
|
|
|
eexists _, _; split_and!; [ done | done | ].
|
|
|
pose_sem_type (λ v1 v2, (∃ v w : val, 𝒱 A δ v w ∧ v1 = InjLV v ∧ v2 = (#1, w)%V) ∨ (∃ v w: val, 𝒱 B δ v w ∧ v1 = InjRV v ∧ v2 = (#2, w)%V)) as R.
|
|
|
{ intros ?? [(? & ? & []%val_rel_is_closed & -> & ->) | (? & ? & []%val_rel_is_closed & -> & ->)]; done. }
|
|
|
exists R.
|
|
|
simp type_interp.
|
|
|
eexists _, _, _, _. split; first done. split; first done. split.
|
|
|
- simp type_interp. eexists _, _, _, _. split_and!; [done | done | | ].
|
|
|
+ simp type_interp. eexists _, _, _, _. split_and!; [done | done | done | done | ].
|
|
|
intros v' w' ?%sem_val_rel_cons. simp type_interp.
|
|
|
simpl. eexists _, _. split_and!; [bs_steps_det | bs_steps_det | ].
|
|
|
simp type_interp. simpl. left; eauto.
|
|
|
+ simp type_interp. eexists _, _, _, _. split_and!; [done | done | done | done | ].
|
|
|
intros v' w' ?%sem_val_rel_cons. simp type_interp.
|
|
|
simpl. eexists _, _. split_and!; [bs_steps_det | bs_steps_det | ].
|
|
|
simp type_interp. simpl. right; eauto.
|
|
|
- simp type_interp. eexists _, _. split_and!; [done | done | done | done | ].
|
|
|
intros R'. simp type_interp. eexists _, _. split_and!; [bs_steps_det | bs_steps_det | ].
|
|
|
simp type_interp. eexists _, _, _, _. split_and!; [ done | done | done | done | ].
|
|
|
intros v' w'. simp type_interp. simpl. intros Hsum.
|
|
|
assert (is_closed [] v' ∧ is_closed [] w') as [Hclv' Hclw'].
|
|
|
{ destruct Hsum as [(? & ? & []%val_rel_is_closed & -> & ->) | (? & ? & []%val_rel_is_closed & -> & ->)]; done. }
|
|
|
eexists _, _. split_and!; [bs_steps_det | bs_steps_det | ].
|
|
|
simp type_interp. eexists _, _, _, _.
|
|
|
split_and!; [ done | done | simplify_closed | simplify_closed | ].
|
|
|
intros f f' Hf.
|
|
|
simpl. repeat (rewrite subst_is_closed_nil; [ | done]).
|
|
|
simp type_interp. eexists _, _.
|
|
|
split_and!; [ bs_steps_det | bs_steps_det | ].
|
|
|
simp type_interp. eexists _, _, _, _.
|
|
|
specialize (val_rel_is_closed _ _ _ _ Hf) as [].
|
|
|
split_and!; [done | done | simplify_closed | simplify_closed | ].
|
|
|
intros g g' Hg.
|
|
|
simpl. repeat (rewrite subst_is_closed_nil; [ | done]).
|
|
|
(* CA *)
|
|
|
destruct Hsum as [(v & w & Hvw & -> & ->) | (v & w & Hvw & -> & ->)].
|
|
|
+ simpl; simp type_interp.
|
|
|
simp type_interp in Hf. destruct Hf as (? & ? & ? & ? & -> & -> & ? & ? & Hf).
|
|
|
opose proof* (Hf v w) as Hf.
|
|
|
{ revert Hvw. rewrite sem_val_rel_cons. rewrite sem_val_rel_cons. asimpl. done. }
|
|
|
simp type_interp in Hf. destruct Hf as (v1 & v2 & ? & ? & Hf).
|
|
|
simp type_interp in Hf. simpl in Hf.
|
|
|
eexists _, _.
|
|
|
split_and!.
|
|
|
{ eapply bs_casel; bs_step_det. }
|
|
|
{ eapply bs_if_true; bs_step_det. }
|
|
|
done.
|
|
|
+ simpl; simp type_interp.
|
|
|
simp type_interp in Hg. destruct Hg as (? & ? & ? & ? & -> & -> & ? & ? & Hg).
|
|
|
opose proof* (Hg v w) as Hg.
|
|
|
{ revert Hvw. rewrite sem_val_rel_cons. rewrite sem_val_rel_cons. asimpl. done. }
|
|
|
simp type_interp in Hg. destruct Hg as (v1 & v2 & ? & ? & Hg).
|
|
|
simp type_interp in Hg. simpl in Hg.
|
|
|
eexists _, _.
|
|
|
split_and!.
|
|
|
{ eapply bs_caser; bs_step_det. }
|
|
|
{ eapply bs_if_false; bs_step_det. }
|
|
|
done.
|
|
|
Qed.
|
|
|
|
|
|
End ex8.
|