Commit 55f1dc10 authored by Dan Frumin's avatar Dan Frumin

Assorted modifications to the stack example

- Still does not compile
parent 9dc07689
......@@ -8,456 +8,311 @@ Import uPred.
Definition CG_StackType τ :=
TRec (TSum TUnit (TProd τ.[ren (+1)] (TVar 0))).
Notation Conse h t := (Fold (InjR (Pair h t))).
Notation Nile := (Fold (InjL Unit)).
(* Coarse-grained push *)
(* push s = λ x. s <- fold (injr (x, load st)) *)
(* push s = λ x. s <- cons (x, load st) *)
Definition CG_push (st : expr) : expr :=
Rec (Store
(st.[ren (+2)]) (Fold (InjR (Pair (Var 1) (Load st.[ren (+ 2)]))))).
Program Definition CG_push : val := λ: "st" "x",
"st" <- Conse "x" (!"st").
Definition CG_locked_push (st l : expr) := with_lock (CG_push st) l.
Definition CG_locked_pushV (st l : expr) : val := with_lockV (CG_push st) l.
Definition CG_locked_push : val := λ: "st" "l" "x",
acquire "l";; CG_push "st" "x";; release "l".
(* pop s = λ x. match (load s) with
| nil => InjL ()
| cons y ys => s <- ys ;; InjR y
end *)
Definition CG_pop (st : expr) : expr :=
Rec (Case (Unfold (Load st.[ren (+ 2)]))
(InjL Unit)
(
App (Rec (InjR (Fst (Var 2))))
(Store st.[ren (+ 3)] (Snd (Var 0)))
)
).
Definition CG_locked_pop (st l : expr) := with_lock (CG_pop st) l.
Definition CG_locked_popV (st l : expr) : val := with_lockV (CG_pop st) l.
Definition CG_pop : val := λ: "st" <>,
case: Unfold !"st" of
InjL => λ: <>, InjL Unit
| InjR => λ: "y", "st" <- (Snd "y");; InjR (Fst "y")
end.
Definition CG_locked_pop : val := λ: "st" "l" <>,
acquire "l";; (let: "v" := CG_pop "st" #() in (release "l";; "v")).
(* snap st l = with_lock (λ _, load st) l *)
Definition CG_snap (st l : expr) := with_lock (Rec (Load st.[ren (+2)])) l.
Definition CG_snapV (st l : expr) : val := with_lockV (Rec (Load st.[ren (+2)])) l.
Definition CG_snap : val := λ: "st" "l" <>,
acquire "l";; let: "v" := !"st" in (release "l";; "v").
(* iter f = λ s. match s with
| nil => Unit
| cons x xs => (f x) ;; iter f xs
end *)
Definition CG_iter (f : expr) : expr :=
Rec (Case (Unfold (Var 1))
Unit
(
App (Rec (App (Var 3) (Snd (Var 2))))
(App f.[ren (+3)] (Fst (Var 0)))
)
).
Definition CG_iterV (f : expr) : val :=
RecV (Case (Unfold (Var 1))
Unit
(
App (Rec (App (Var 3) (Snd (Var 2))))
(App f.[ren (+3)] (Fst (Var 0)))
)
).
Definition CG_iter : val := rec: "iter" "f" := λ: "s",
case: (Unfold "s") of
InjL => λ: <>, Unit
| InjR => λ: "x", "f" (Fst "x");; "iter" "f" (Snd "x")
end.
(* snap_iter st l := λ f. iter f (snap st l #()) *)
Definition CG_snap_iter (st l : expr) : expr :=
Rec (App (CG_iter (Var 1)) (App (CG_snap st.[ren (+2)] l.[ren (+2)]) Unit)).
Definition CG_snap_iter : val := λ: "st" "l" "f",
CG_iter "f" (CG_snap "st" "l" Unit).
(* stack_body st l :=
locked_push st l, locked_pop st l, snap_iter st l *)
Definition CG_stack_body (st l : expr) : expr :=
Pair (Pair (CG_locked_push st l) (CG_locked_pop st l))
(CG_snap_iter st l).
Definition CG_stack_body : val := λ: "st" "l",
(CG_locked_push "st" "l", CG_locked_pop "st" "l", CG_snap_iter "st" "l").
(* stack :=
Λα. (λ(l : lock) (s : stack α). stack_body s l) (ref nil) newlock *)
Definition CG_stack : expr :=
TLam (App (Rec (App (Rec (CG_stack_body (Var 1) (Var 3)))
(Alloc (Fold (InjL Unit))))) newlock).
(* TODO: I want `solve_closed` to solve this so that I can use newlock in the program *)
(* Instance: Closed ((λ: "l", #()) newlock). *)
(* Proof. solve_closed. Qed *)
Definition CG_stack : val :=
Λ: let: "l" := ref # false in
let: "st" := ref Nile in
CG_stack_body "st" "l".
Section CG_Stack.
Context `{heapIG Σ, cfgSG Σ}.
Lemma CG_push_type st Γ τ :
typed Γ st (Tref (CG_StackType τ))
typed Γ (CG_push st) (TArrow τ TUnit).
Proof.
intros H1. repeat econstructor.
eapply (context_weakening [_; _]); eauto.
repeat constructor; asimpl; trivial.
eapply (context_weakening [_; _]); eauto.
Qed.
Lemma CG_push_closed (st : expr) :
( f, st.[f] = st) f, (CG_push st).[f] = CG_push st.
Proof. intros Hst f. unfold CG_push. asimpl. rewrite ?Hst; trivial. Qed.
Lemma CG_push_subst (st : expr) f : (CG_push st).[f] = CG_push st.[f].
Proof. unfold CG_push; asimpl; trivial. Qed.
Lemma steps_CG_push E ρ j K st v w :
nclose specN E
spec_ctx ρ - st ↦ₛ v - j fill K (App (CG_push (Loc st)) (of_val w))
={E}= j fill K Unit st ↦ₛ FoldV (InjRV (PairV w v)).
Lemma CG_push_type Γ τ :
typed Γ CG_push (TArrow (Tref (CG_StackType τ)) (TArrow τ TUnit)).
Proof.
intros HNE. iIntros "#Hspec Hx Hj". unfold CG_push.
tp_rec j; eauto using to_of_val.
tp_normalise j.
tp_load j. tp_normalise j.
tp_store j. simpl. by rewrite ?to_of_val /=.
tp_normalise j. by iFrame.
unfold CG_push. unlock.
repeat econstructor. eauto 10 with typeable.
(* TODO: make eauto call asimpl? *)
asimpl. eauto 10 with typeable.
Qed.
Global Opaque CG_push.
Hint Resolve CG_push_type : typeable.
Lemma CG_locked_push_to_val st l :
to_val (CG_locked_push st l) = Some (CG_locked_pushV st l).
Proof. trivial. Qed.
Lemma CG_locked_push_of_val st l :
of_val (CG_locked_pushV st l) = CG_locked_push st l.
Proof. trivial. Qed.
(* Lemma steps_CG_push E ρ j K st v w : *)
(* nclose specN E *)
(* spec_ctx ρ - st ↦ₛ v - j fill K (App (CG_push (Loc st)) (of_val w)) *)
(* ={E}= j fill K Unit st ↦ₛ FoldV (InjRV (PairV w v)). *)
(* Proof. *)
(* intros HNE. iIntros "#Hspec Hx Hj". unfold CG_push. *)
(* tp_rec j; eauto using to_of_val. *)
(* tp_normalise j. *)
(* tp_load j. tp_normalise j. *)
(* tp_store j. simpl. by rewrite ?to_of_val /=. *)
(* tp_normalise j. by iFrame. *)
(* Qed. *)
Global Opaque CG_locked_pushV.
(* Global Opaque CG_push. *)
Lemma CG_locked_push_type st l Γ τ :
typed Γ st (Tref (CG_StackType τ))
typed Γ l LockType
typed Γ (CG_locked_push st l) (TArrow τ TUnit).
Lemma CG_locked_push_type Γ τ :
typed Γ CG_locked_push (TArrow (Tref (CG_StackType τ)) (TArrow LockType (TArrow τ TUnit))).
Proof.
intros H1 H2. repeat econstructor.
eapply with_lock_type; auto using CG_push_type.
unfold CG_locked_push. unlock.
eauto 20 with typeable.
Qed.
Lemma CG_locked_push_closed (st l : expr) :
( f, st.[f] = st) ( f, l.[f] = l)
f, (CG_locked_push st l).[f] = CG_locked_push st l.
Proof.
intros H1 H2 f. asimpl. unfold CG_locked_push.
rewrite with_lock_closed; trivial. apply CG_push_closed; trivial.
Qed.
Lemma CG_locked_push_subst (st l : expr) f :
(CG_locked_push st l).[f] = CG_locked_push st.[f] l.[f].
Proof. by rewrite with_lock_subst CG_push_subst. Qed.
Lemma steps_CG_locked_push E ρ j K st w v l :
nclose specN E
spec_ctx ρ - st ↦ₛ v - l ↦ₛ (#v false)
- j fill K (App (CG_locked_push (Loc st) (Loc l)) (of_val w))
={E}= j fill K Unit st ↦ₛ FoldV (InjRV (PairV w v)) l ↦ₛ (#v false).
Proof.
iIntros (?) "#Hspec Hst Hl Hj".
unfold CG_locked_push.
tp_apply j (steps_with_lock _ _ _ _ _ _ _ _ UnitV) with "Hst Hl" as "[Hst $]"; [auto | | ].
- iIntros (K') "#Hspec Hst Hj".
iApply (steps_CG_push with "Hspec Hst"); auto.
- by iFrame.
Qed.
Global Opaque CG_locked_push.
Hint Resolve CG_locked_push_type : typeable.
(* Lemma steps_CG_locked_push E ρ j K st w v l : *)
(* nclose specN E *)
(* spec_ctx ρ - st ↦ₛ v - l ↦ₛ (#v false) *)
(* - j fill K (App (CG_locked_push (Loc st) (Loc l)) (of_val w)) *)
(* ={E}= j fill K Unit st ↦ₛ FoldV (InjRV (PairV w v)) l ↦ₛ (#v false). *)
(* Proof. *)
(* iIntros (?) "#Hspec Hst Hl Hj". *)
(* unfold CG_locked_push. *)
(* tp_apply j (steps_with_lock _ _ _ _ _ _ _ _ UnitV) with "Hst Hl" as "[Hst $]"; [auto | | ]. *)
(* - iIntros (K') "#Hspec Hst Hj". *)
(* iApply (steps_CG_push with "Hspec Hst"); auto. *)
(* - by iFrame. *)
(* Qed. *)
(* Global Opaque CG_locked_push. *)
(* Coarse-grained pop *)
Lemma CG_pop_type st Γ τ :
typed Γ st (Tref (CG_StackType τ))
typed Γ (CG_pop st) (TArrow TUnit (TSum TUnit τ)).
Lemma CG_pop_type Γ τ :
typed Γ CG_pop (TArrow (Tref (CG_StackType τ)) (TArrow TUnit (TSum TUnit τ))).
Proof.
intros H1.
econstructor.
eapply (Case_typed _ _ _ _ TUnit);
[| repeat constructor
| repeat econstructor; eapply (context_weakening [_; _; _]); eauto].
replace (TSum TUnit (TProd τ (CG_StackType τ))) with
((TSum TUnit (TProd τ.[ren (+1)] (TVar 0))).[(CG_StackType τ)/])
by (by asimpl).
repeat econstructor.
eapply (context_weakening [_; _]); eauto.
unfold CG_pop. unlock.
repeat econstructor; eauto 20 with typeable.
asimpl. eauto 20 with typeable.
Qed.
Lemma CG_pop_closed (st : expr) :
( f, st.[f] = st) f, (CG_pop st).[f] = CG_pop st.
Proof. intros Hst f. unfold CG_pop. asimpl. rewrite ?Hst; trivial. Qed.
Lemma CG_pop_subst (st : expr) f : (CG_pop st).[f] = CG_pop st.[f].
Proof. unfold CG_pop; asimpl; trivial. Qed.
Lemma steps_CG_pop_suc E ρ j K st v w :
nclose specN E
spec_ctx ρ - st ↦ₛ FoldV (InjRV (PairV w v))
- j fill K (App (CG_pop (Loc st)) Unit)
={E}= j fill K (InjR (of_val w)) st ↦ₛ v.
Proof.
intros HNE. iIntros "#Hspec Hx Hj". unfold CG_pop.
tp_rec j. asimpl.
tp_load j. tp_normalise j.
tp_fold j; simpl; first by rewrite ?to_of_val /=.
tp_normalise j.
tp_case_inr j; simpl; first by rewrite ?to_of_val.
tp_snd j; eauto using to_of_val.
tp_store j; eauto using to_of_val. tp_normalise j.
tp_rec j. asimpl.
tp_fst j; eauto using to_of_val. tp_normalise j.
by iFrame.
Qed.
Lemma steps_CG_pop_fail E ρ j K st :
nclose specN E
spec_ctx ρ - st ↦ₛ FoldV (InjLV UnitV)
- j fill K (App (CG_pop (Loc st)) Unit)
={E}= j fill K (InjL Unit) st ↦ₛ FoldV (InjLV UnitV).
Proof.
iIntros (HNE) "#Hspec Hx Hj". unfold CG_pop.
tp_rec j.
tp_load j. asimpl. tp_normalise j.
tp_fold j.
tp_case_inl j. asimpl. tp_normalise j.
by iFrame.
Qed.
Hint Resolve CG_pop_type : typeable.
(* Lemma steps_CG_pop_suc E ρ j K st v w : *)
(* nclose specN E *)
(* spec_ctx ρ - st ↦ₛ FoldV (InjRV (PairV w v)) *)
(* - j fill K (App (CG_pop (Loc st)) Unit) *)
(* ={E}= j fill K (InjR (of_val w)) st ↦ₛ v. *)
(* Proof. *)
(* intros HNE. iIntros "#Hspec Hx Hj". unfold CG_pop. *)
(* tp_rec j. asimpl. *)
(* tp_load j. tp_normalise j. *)
(* tp_fold j; simpl; first by rewrite ?to_of_val /=. *)
(* tp_normalise j. *)
(* tp_case_inr j; simpl; first by rewrite ?to_of_val. *)
(* tp_snd j; eauto using to_of_val. *)
(* tp_store j; eauto using to_of_val. tp_normalise j. *)
(* tp_rec j. asimpl. *)
(* tp_fst j; eauto using to_of_val. tp_normalise j. *)
(* by iFrame. *)
(* Qed. *)
(* Lemma steps_CG_pop_fail E ρ j K st : *)
(* nclose specN E *)
(* spec_ctx ρ - st ↦ₛ FoldV (InjLV UnitV) *)
(* - j fill K (App (CG_pop (Loc st)) Unit) *)
(* ={E}= j fill K (InjL Unit) st ↦ₛ FoldV (InjLV UnitV). *)
(* Proof. *)
(* iIntros (HNE) "#Hspec Hx Hj". unfold CG_pop. *)
(* tp_rec j. *)
(* tp_load j. asimpl. tp_normalise j. *)
(* tp_fold j. *)
(* tp_case_inl j. asimpl. tp_normalise j. *)
(* by iFrame. *)
(* Qed. *)
Global Opaque CG_pop.
Lemma CG_locked_pop_to_val st l :
to_val (CG_locked_pop st l) = Some (CG_locked_popV st l).
Proof. trivial. Qed.
Lemma CG_locked_pop_of_val st l :
of_val (CG_locked_popV st l) = CG_locked_pop st l.
Proof. trivial. Qed.
Global Opaque CG_locked_popV.
Lemma CG_locked_pop_type st l Γ τ :
typed Γ st (Tref (CG_StackType τ))
typed Γ l LockType
typed Γ (CG_locked_pop st l) (TArrow TUnit (TSum TUnit τ)).
Proof.
intros H1 H2. repeat econstructor.
eapply with_lock_type; auto using CG_pop_type.
Qed.
Lemma CG_locked_pop_closed (st l : expr) :
( f, st.[f] = st) ( f, l.[f] = l)
f, (CG_locked_pop st l).[f] = CG_locked_pop st l.
Proof.
intros H1 H2 f. asimpl. unfold CG_locked_pop.
rewrite with_lock_closed; trivial. apply CG_pop_closed; trivial.
Qed.
Lemma CG_locked_pop_subst (st l : expr) f :
(CG_locked_pop st l).[f] = CG_locked_pop st.[f] l.[f].
Proof. by rewrite with_lock_subst CG_pop_subst. Qed.
Lemma steps_CG_locked_pop_suc E ρ j K st v w l :
nclose specN E
spec_ctx ρ - st ↦ₛ FoldV (InjRV (PairV w v)) - l ↦ₛ (#v false)
- j fill K (App (CG_locked_pop (Loc st) (Loc l)) Unit)
={E}= j fill K (InjR (of_val w)) st ↦ₛ v l ↦ₛ (#v false).
Lemma CG_locked_pop_type Γ τ :
typed Γ CG_locked_pop (TArrow (Tref (CG_StackType τ)) (TArrow LockType (TArrow TUnit (TSum TUnit τ)))).
Proof.
iIntros (HNE) "#Hspec Hx Hl Hj". unfold CG_locked_pop.
tp_apply j (steps_with_lock _ _ _ _ _ _ _ _ (InjRV w) UnitV)
with "Hx Hl" as "[Hx $]"; first auto.
- iIntros (K') "#Hspec Hx Hj".
iApply (steps_CG_pop_suc with "Hspec Hx Hj"). trivial.
- by iFrame.
unfold CG_locked_pop. unlock.
eauto 20 with typeable.
Qed.
Lemma steps_CG_locked_pop_fail E ρ j K st l :
nclose specN E
spec_ctx ρ - st ↦ₛ FoldV (InjLV UnitV) - l ↦ₛ (#v false)
- j fill K (App (CG_locked_pop (Loc st) (Loc l)) Unit)
={E}= j fill K (InjL Unit) st ↦ₛ FoldV (InjLV UnitV) l ↦ₛ (#v false).
Proof.
iIntros (HNE) "#Hspec Hx Hl Hj". unfold CG_locked_pop.
tp_apply j (steps_with_lock _ _ _ _ _ _ _ _ (InjLV UnitV) UnitV)
with "Hx Hl" as "[Hx Hl]"; first auto.
- iIntros (K') "#Hspec Hx Hj /=".
iApply (steps_CG_pop_fail with "Hspec Hx Hj"). trivial.
- by iFrame.
Qed.
Hint Resolve CG_locked_pop_type : typeable.
(* Lemma steps_CG_locked_pop_suc E ρ j K st v w l : *)
(* nclose specN E *)
(* spec_ctx ρ - st ↦ₛ FoldV (InjRV (PairV w v)) - l ↦ₛ (#v false) *)
(* - j fill K (App (CG_locked_pop (Loc st) (Loc l)) Unit) *)
(* ={E}= j fill K (InjR (of_val w)) st ↦ₛ v l ↦ₛ (#v false). *)
(* Proof. *)
(* iIntros (HNE) "#Hspec Hx Hl Hj". unfold CG_locked_pop. *)
(* tp_apply j (steps_with_lock _ _ _ _ _ _ _ _ (InjRV w) UnitV) *)
(* with "Hx Hl" as "[Hx $]"; first auto. *)
(* - iIntros (K') "#Hspec Hx Hj". *)
(* iApply (steps_CG_pop_suc with "Hspec Hx Hj"). trivial. *)
(* - by iFrame. *)
(* Qed. *)
(* Lemma steps_CG_locked_pop_fail E ρ j K st l : *)
(* nclose specN E *)
(* spec_ctx ρ - st ↦ₛ FoldV (InjLV UnitV) - l ↦ₛ (#v false) *)
(* - j fill K (App (CG_locked_pop (Loc st) (Loc l)) Unit) *)
(* ={E}= j fill K (InjL Unit) st ↦ₛ FoldV (InjLV UnitV) l ↦ₛ (#v false). *)
(* Proof. *)
(* iIntros (HNE) "#Hspec Hx Hl Hj". unfold CG_locked_pop. *)
(* tp_apply j (steps_with_lock _ _ _ _ _ _ _ _ (InjLV UnitV) UnitV) *)
(* with "Hx Hl" as "[Hx Hl]"; first auto. *)
(* - iIntros (K') "#Hspec Hx Hj /=". *)
(* iApply (steps_CG_pop_fail with "Hspec Hx Hj"). trivial. *)
(* - by iFrame. *)
(* Qed. *)
Global Opaque CG_locked_pop.
Lemma CG_snap_to_val st l : to_val (CG_snap st l) = Some (CG_snapV st l).
Proof. trivial. Qed.
Lemma CG_snap_of_val st l : of_val (CG_snapV st l) = CG_snap st l.
Proof. trivial. Qed.
Global Opaque CG_snapV.
Lemma CG_snap_type st l Γ τ :
typed Γ st (Tref (CG_StackType τ))
typed Γ l LockType
typed Γ (CG_snap st l) (TArrow TUnit (CG_StackType τ)).
Proof.
intros H1 H2. repeat econstructor.
eapply with_lock_type; trivial. do 2 constructor.
eapply (context_weakening [_; _]); eauto.
Qed.
Lemma CG_snap_closed (st l : expr) :
( f, st.[f] = st) ( f, l.[f] = l)
f, (CG_snap st l).[f] = CG_snap st l.
Lemma CG_snap_type Γ τ :
typed Γ CG_snap (TArrow (Tref (CG_StackType τ)) (TArrow LockType (TArrow TUnit (CG_StackType τ)))).
Proof.
intros H1 H2 f. asimpl. unfold CG_snap.
rewrite with_lock_closed; trivial.
intros f'. by asimpl; rewrite ?H1.
unfold CG_snap. unlock.
eauto 20 with typeable.
Qed.
Lemma CG_snap_subst (st l : expr) f :
(CG_snap st l).[f] = CG_snap st.[f] l.[f].
Proof. unfold CG_snap; rewrite ?with_lock_subst. by asimpl. Qed.
Lemma steps_CG_snap E ρ j K st v l :
nclose specN E
spec_ctx ρ - st ↦ₛ v - l ↦ₛ (#v false)
- j fill K (App (CG_snap (Loc st) (Loc l)) Unit)
={E}= j (fill K (of_val v)) st ↦ₛ v l ↦ₛ (#v false).
Proof.
iIntros (HNE) "#Hspec Hx Hl Hj". unfold CG_snap.
tp_apply j (steps_with_lock _ _ _ _ _ _ _ _ v UnitV)
with "Hx Hl" as "[Hx $]"; first auto.
- iIntros (K') "#Hspec Hx Hj".
tp_rec j.
tp_load j. tp_normalise j.
by iFrame.
- by iFrame.
Qed.
Hint Resolve CG_snap_type : typeable.
(* Lemma steps_CG_snap E ρ j K st v l : *)
(* nclose specN E *)
(* spec_ctx ρ - st ↦ₛ v - l ↦ₛ (#v false) *)
(* - j fill K (App (CG_snap (Loc st) (Loc l)) Unit) *)
(* ={E}= j (fill K (of_val v)) st ↦ₛ v l ↦ₛ (#v false). *)
(* Proof. *)
(* iIntros (HNE) "#Hspec Hx Hl Hj". unfold CG_snap. *)
(* tp_apply j (steps_with_lock _ _ _ _ _ _ _ _ v UnitV) *)
(* with "Hx Hl" as "[Hx $]"; first auto. *)
(* - iIntros (K') "#Hspec Hx Hj". *)
(* tp_rec j. *)
(* tp_load j. tp_normalise j. *)
(* by iFrame. *)
(* - by iFrame. *)
(* Qed. *)
Global Opaque CG_snap.
(* Coarse-grained iter *)
Lemma CG_iter_folding (f : expr) :
CG_iter f =
Rec (Case (Unfold (Var 1))
Unit
(
App (Rec (App (Var 3) (Snd (Var 2))))
(App f.[ren (+3)] (Fst (Var 0)))
)
).
Proof. trivial. Qed.
Lemma CG_iter_type f Γ τ :
typed Γ f (TArrow τ TUnit)
typed Γ (CG_iter f) (TArrow (CG_StackType τ) TUnit).
(* (* Coarse-grained iter *) *)
(* Lemma CG_iter_folding (f : expr) : *)
(* CG_iter f = *)
(* Rec (Case (Unfold (Var 1)) *)
(* Unit *)
(* ( *)
(* App (Rec (App (Var 3) (Snd (Var 2)))) *)
(* (App f.[ren (+3)] (Fst (Var 0))) *)
(* ) *)
(* ). *)
(* Proof. trivial. Qed. *)
Lemma CG_iter_type Γ τ :
typed Γ CG_iter (TArrow (TArrow τ TUnit) (TArrow (CG_StackType τ) TUnit)).
Proof.
intros H1.
econstructor.
eapply (Case_typed _ _ _ _ TUnit);
[| repeat constructor
| repeat econstructor; eapply (context_weakening [_; _; _]); eauto].
replace (TSum TUnit (TProd τ (CG_StackType τ))) with
((TSum TUnit (TProd τ.[ren (+1)] (TVar 0))).[(CG_StackType τ)/])
by (by asimpl).
repeat econstructor.
unfold CG_iter. unlock.
repeat econstructor; eauto 50 with typeable.
asimpl. eauto with typeable.
Qed.
Lemma CG_iter_to_val f : to_val (CG_iter f) = Some (CG_iterV f).
Proof. trivial. Qed.
Lemma CG_iter_of_val f : of_val (CG_iterV f) = CG_iter f.
Proof. trivial. Qed.
Global Opaque CG_iterV.
Lemma CG_iter_closed (f : expr) :
( g, f.[g] = f) g, (CG_iter f).[g] = CG_iter f.
Proof. intros Hf g. unfold CG_iter. asimpl. rewrite ?Hf; trivial. Qed.
Lemma CG_iter_subst (f : expr) g : (CG_iter f).[g] = CG_iter f.[g].
Proof. unfold CG_iter; asimpl; trivial. Qed.
Lemma steps_CG_iter E ρ j K f v w :
nclose specN E
spec_ctx ρ
- j fill K (App (CG_iter (of_val f))
(Fold (InjR (Pair (of_val w) (of_val v)))))
={E}= j fill K
(App
(Rec
(App ((CG_iter (of_val f)).[ren (+2)])
(Snd (Pair ((of_val w).[ren (+2)]) (of_val v).[ren (+2)]))))
(App (of_val f) (of_val w))).
Proof.
iIntros (HNE) "#Hspec Hj". unfold CG_iter.
tp_rec j; first by (rewrite /= ?to_of_val /=).
rewrite -CG_iter_folding. Opaque CG_iter.
tp_fold j; first by (rewrite /= ?to_of_val /=).
tp_case_inr j; first by (rewrite /= ?to_of_val /=).
asimpl.
tp_fst j; auto using to_of_val.
tp_normalise j.
done.
Qed.
Transparent CG_iter.
Lemma steps_CG_iter_end E ρ j K f :
nclose specN E
spec_ctx ρ - j fill K (App (CG_iter (of_val f)) (Fold (InjL Unit)))
={E}= j fill K Unit.
Proof.
iIntros (HNE) "#Hspec Hj". unfold CG_iter.
tp_rec j.
tp_fold j.
tp_case_inl j. tp_normalise j.
by iFrame.
Qed.
Hint Resolve CG_iter_type : typeable.
(* Lemma steps_CG_iter E ρ j K f v w : *)
(* nclose specN E *)
(* spec_ctx ρ *)
(* - j fill K (App (CG_iter (of_val f)) *)
(* (Fold (InjR (Pair (of_val w) (of_val v))))) *)
(* ={E}= j fill K *)
(* (App *)
(* (Rec *)
(* (App ((CG_iter (of_val f)).[ren (+2)]) *)
(* (Snd (Pair ((of_val w).[ren (+2)]) (of_val v).[ren (+2)])))) *)
(* (App (of_val f) (of_val w))). *)
(* Proof. *)
(* iIntros (HNE) "#Hspec Hj". unfold CG_iter. *)
(* tp_rec j; first by (rewrite /= ?to_of_val /=). *)
(* rewrite -CG_iter_folding. Opaque CG_iter. *)
(* tp_fold j; first by (rewrite /= ?to_of_val /=). *)
(* tp_case_inr j; first by (rewrite /= ?to_of_val /=). *)
(* asimpl. *)
(* tp_fst j; auto using to_of_val. *)
(* tp_normalise j. *)
(* done. *)
(* Qed. *)
(* Transparent CG_iter. *)
(* Lemma steps_CG_iter_end E ρ j K f : *)
(* nclose specN E *)
(* spec_ctx ρ - j fill K (App (CG_iter (of_val f)) (Fold (InjL Unit))) *)