LogrelCC.coop_logrel.light_weight_threads

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

Definition LTH_Lib :=
  LetIn
    (Alloc (Fold (InjR Unit))) (* The empty queue *)
    (Pair
       (Lam (* Fork *)
          (Callcc (
               Seq
                 (Store
                    (Var 2)
                    (LetIn
                       (Load (Var 2))
                       (App (App EnQueue (Var 0)) (Var 1))
                    )
                 )
                 (Throw (Var 1) (Cont [AppLCtx Unit]))
             )
          )
       )
       (Lam (* Yield *)
          (Callcc (
               LetIn
                 (Load (Var 2))
                 (LetIn
                    (App (App EnQueue (Var 0)) (Var 1))
                    (Case
                       (App DeQueue (Var 0))
                       (Seq
                          (Store (Var 5) (Snd (Var 0)))
                          (Throw Unit (Fst (Var 0)))
                       )
                       (Unit)
                    )
                 )
             )
          )
       )
    ).

Definition sim_fork (l : loc) :=
  (LamV (* Fork *)
     (Callcc (
          Seq
            (Store
               (Loc l)
               (LetIn
                  (Load (Loc l))
                  (App (App EnQueue (Var 0)) (Var 1))
               )
            )
            (Throw (Var 1) (Cont [AppLCtx Unit]))
        )
     )
  ).

Definition sim_yield (l : loc) :=
  LamV (* Yield *)
    (Callcc (
         LetIn
           (Load (Loc l))
           (LetIn
              (App (App EnQueue (Var 0)) (Var 1))
              (Case
                 (App DeQueue (Var 0))
                 (Seq
                    (Store (Loc l) (Snd (Var 0)))
                    (Throw Unit (Fst (Var 0)))
                 )
                 (Unit)
              )
           )
       )
    ).

Section LTH_Lib_lemmas.
  Context `{heapG Σ}.

  Lemma clwp_LTH_Lib_basic :
    CLWP LTH_Lib
         {{v, l,
              l ↦ᵢ (to_list []) v = PairV (sim_fork l) (sim_yield l)
         }}%I.
  Proof.
    iApply (clwp_bind [LetInCtx _]); simpl.
    iApply clwp_alloc; eauto.
    iNext; iIntros (l) "Hl".
    iApply clwp_value; eauto.
    iApply clwp_LetIn; eauto.
    iNext.
    iApply clwp_value; eauto.
  Qed.

End LTH_Lib_lemmas.