LogrelCC.F_mu_ref_cc.queue

From LogrelCC.F_mu_ref_cc Require Import lang cl_rules.
From iris.proofmode Require Import tactics.

(* list τ = μ X. (τ × X) + 1 *)

(* option τ = τ + 1 *)

Definition EnQueue :=
  Rec (Lam
         (Case
            (Unfold (Var 2))
            (Fold (InjL (Pair
                           (Fst (Var 0))
                           (App (App (Var 2) (Snd (Var 0))) (Var 1)))
                  )
            )
            (Fold (InjL (Pair (Var 1) (Fold (InjR Unit)))))
         )
      ).

Lemma EnQueue_eq :
  EnQueue =
  Rec (Lam
         (Case
            (Unfold (Var 2))
            (Fold (InjL (Pair
                           (Fst (Var 0))
                           (App (App (Var 2) (Snd (Var 0))) (Var 1)))
                  )
            )
            (Fold (InjL (Pair (Var 1) (Fold (InjR Unit)))))
         )
      ).
Proof. trivial. Qed.

Lemma EnQueue_closed f :
  EnQueue.[f] = EnQueue.
 Proof. by asimpl. Qed.

Hint Rewrite EnQueue_closed : autosubst.

Typeclasses Opaque EnQueue.
Global Opaque EnQueue.

Hint Extern 1 (EnQueue = _) => by rewrite EnQueue_eq.

Definition DeQueue :=
  Lam (Unfold (Var 0)).

Lemma DeQueue_eq :
  DeQueue = Lam (Unfold (Var 0)).
Proof. trivial. Qed.

Lemma DeQueue_closed f :
  DeQueue.[f] = DeQueue.
 Proof. by asimpl. Qed.

Hint Rewrite DeQueue_closed : autosubst.

Typeclasses Opaque DeQueue.
Global Opaque DeQueue.

Hint Extern 1 (DeQueue = _) => by rewrite DeQueue_eq.

Fixpoint to_list (l : list val) : val :=
  match l with
  | [] => FoldV (InjRV UnitV)
  | a :: l' => FoldV (InjLV (PairV a (to_list l')))
  end.

Definition to_option (ov : option val) :=
  match ov with
  | None => InjRV UnitV
  | Some v => InjLV v
  end.

Section queue_lemmas.
  Context `{heapG Σ}.

  Lemma wp_EnQueue l v :
    CLWP App (App EnQueue (of_val (to_list l))) (of_val v)
         {{w, w = to_list (l ++ [v])}}%I.
  Proof.
    iLöb as "IH" forall (l).
    iApply (clwp_bind [AppLCtx _]).
    iApply clwp_rec; eauto.
    iNext; asimpl.
    iApply clwp_value; eauto.
    iApply clwp_Lam; eauto.
    iNext; asimpl.
    destruct l; simpl.
    - iApply (clwp_bind [CaseCtx _ _]).
      iApply clwp_unfold; eauto.
      iNext; iApply clwp_value; eauto; simpl.
      iApply clwp_case_injr; eauto.
      iNext; asimpl.
      iApply clwp_value; eauto.
    - iApply (clwp_bind [CaseCtx _ _]).
      iApply clwp_unfold; eauto.
      iNext; iApply clwp_value; eauto; simpl.
      iApply clwp_case_injl; eauto.
      iNext; asimpl.
      iApply (clwp_bind [PairLCtx _; InjLCtx; FoldCtx]).
      iApply clwp_fst; eauto.
      iNext; simpl; iApply clwp_value; eauto.
      iApply (clwp_bind [PairRCtx _; InjLCtx; FoldCtx]); simpl.
      rewrite {2}EnQueue_eq.
      iApply (clwp_bind [AppRCtx (RecV _); AppLCtx _]); simpl.
      rewrite -EnQueue_eq.
      iApply clwp_snd; eauto. iNext; iApply clwp_value; eauto.
      iApply clwp_wand_l; iSplitL; last by iApply "IH".
      iIntros (w) "%"; subst.
      iApply clwp_value; eauto.
  Qed.

  Lemma wp_DeQueue l :
    CLWP App DeQueue (of_val (to_list l))
         {{w, match l with
              | [] => w = InjRV UnitV
              | a :: l' =>
                w = InjLV (PairV a (to_list l'))
              end}}%I.
  Proof.
    iApply clwp_Lam; eauto.
    iNext; asimpl.
    destruct l; simpl.
    - iApply clwp_unfold; eauto.
      iNext; iApply clwp_value; eauto; simpl.
    - iApply clwp_unfold; eauto.
      iNext; iApply clwp_value; eauto; simpl.
  Qed.

End queue_lemmas.