LogrelCC.examples.refinement.list_assoc

From iris.proofmode Require Import tactics.
From LogrelCC Require Import rules_unary rules_binary typing lang.
From LogrelCC.examples Require Import list_rev.
From LogrelCC.examples.refinement Require Import
     lock lock_unary_spec list_basics.
From iris.base_logic Require Import invariants.

Definition associate lock list :=
  Lam (Seq
         (App acquire lock.[ren (+1)])
         (LetIn
            (Load list.[ren (+1)])
            (LetIn
               (App (TApp list_length) (Var 0))
               (LetIn
                  (Store list.[ren (+3)]
                                (App (App (TApp list_snoc) (Var 2)) (Var 1)))
                  (Seq (App release lock.[ren (+4)]) (Var 1))
               )
            )
         )
      ).

Lemma associate_type Γ lock list :
  Γ ⊢ₜ lock : LockType
  Γ ⊢ₜ list : Tref (ListType (TVar 0))
  Γ ⊢ₜ associate lock list : TArrow (TVar 0) TNat.
Proof.
  intros Hlc Hls.
  repeat econstructor; simpl; eauto using release_type, acquire_type,
                              list_length_type;
    try (by apply (context_weakening [_]));
    try (by apply (context_weakening [_;_]));
    try (by apply (context_weakening [_;_;_]));
    try (by apply (context_weakening [_;_;_;_])).
  - replace (TArrow (ListType (TVar 0)) TNat) with
        (TArrow (ListType (TVar 0)) TNat).[TVar 0/]; last by asimpl.
    econstructor; apply list_length_type.
  - replace (TArrow (TVar 0) (TArrow (ListType (TVar 0)) (ListType (TVar 0))))
      with (TArrow (TVar 0) (TArrow (ListType (TVar 0)) (ListType (TVar 0)))).[TVar 0/];
      last by asimpl.
    econstructor; apply list_snoc_type.
Qed.

Lemma associate_subst f lock list :
  (associate lock list).[f] = associate lock.[f] list.[f].
Proof. rewrite /associate; by asimpl. Qed.

Hint Rewrite associate_subst : autosubst.

Lemma associate_eq lock list :
  associate lock list =
  Lam (Seq (App acquire lock.[ren (+1)])
           (LetIn
              (Load list.[ren (+1)])
              (LetIn
                 (App (TApp list_length) (Var 0))
                 (LetIn
                    (Store list.[ren (+3)]
                                  (App (App (TApp list_snoc) (Var 2)) (Var 1)))
                    (Seq (App release lock.[ren (+4)]) (Var 1))
                 )
              )
           )
      ).
Proof. trivial. Qed.

Definition associateV lock list :=
  LamV (Seq
          (App acquire lock.[ren (+1)])
          (LetIn
             (Load list.[ren (+1)])
             (LetIn
                (App (TApp list_length) (Var 0))
                (LetIn
                   (Store list.[ren (+3)]
                                 (App (App (TApp list_snoc) (Var 2)) (Var 1)))
                   (Seq (App release lock.[ren (+4)]) (Var 1))
                )
             )
          )
       ).

Lemma associate_to_val lock list :
  to_val (associate lock list) = Some (associateV lock list).
Proof. trivial. Qed.

Lemma associate_of_val lock list :
  of_val (associateV lock list) = associate lock list.
Proof. trivial. Qed.

Typeclasses Opaque associate.
Global Opaque associate.
Typeclasses Opaque associateV.
Global Opaque associateV.

Definition get lock list :=
  Lam (Seq
         (App acquire lock.[ren (+1)])
         (LetIn
            (Load list.[ren (+1)])
            (LetIn
               (App (App (TApp list_get) (Var 1)) (Var 0))
               (Seq (App release lock.[ren (+3)]) (Var 0))
            )
         )
      ).

Lemma get_type Γ lock list :
  Γ ⊢ₜ lock : LockType
  Γ ⊢ₜ list : Tref (ListType (TVar 0))
  Γ ⊢ₜ get lock list : TArrow TNat (TSum TUnit (TVar 0)).
Proof.
  intros Hlc Hls.
  repeat econstructor; eauto using release_type, acquire_type;
    try (by apply (context_weakening [_]));
    try (by apply (context_weakening [_;_;_])).
  replace (TArrow TNat (TArrow (ListType (TVar 0)) (TSum TUnit (TVar 0))))
    with (TArrow TNat (TArrow (ListType (TVar 0)) (TSum TUnit (TVar 0)))).[TVar 0/];
    last by asimpl.
  econstructor; apply list_get_type.
Qed.

Lemma get_subst f lock list :
  (get lock list).[f] = get lock.[f] list.[f].
Proof. rewrite /get; by asimpl. Qed.

Hint Rewrite get_subst : autosubst.

Lemma get_eq lock list :
  get lock list =
  Lam (Seq
         (App acquire lock.[ren (+1)])
         (LetIn
            (Load list.[ren (+1)])
            (LetIn
               (App (App (TApp list_get) (Var 1)) (Var 0))
               (Seq (App release lock.[ren (+3)]) (Var 0))
            )
         )
      ).
Proof. trivial. Qed.

Definition getV lock list :=
  LamV (Seq
         (App acquire lock.[ren (+1)])
         (LetIn
            (Load list.[ren (+1)])
            (LetIn
               (App (App (TApp list_get) (Var 1)) (Var 0))
               (Seq (App release lock.[ren (+3)]) (Var 0))
            )
         )
      ).

Lemma get_to_val lock list :
  to_val (get lock list) = Some (getV lock list).
Proof. trivial. Qed.

Lemma get_of_val lock list :
  of_val (getV lock list) = get lock list.
Proof. trivial. Qed.

Typeclasses Opaque get.
Global Opaque get.
Typeclasses Opaque getV.
Global Opaque getV.

Definition make_association :=
  TLam
    (LetIn
       (Alloc (Fold (InjR Unit)))
       (LetIn newlock
              (Pair
                 (associate (Var 0) (Var 1))
                 (get (Var 0) (Var 1)))
       )
    ).

Lemma make_association_closed f : make_association.[f] = make_association.
Proof. trivial. Qed.

Lemma make_association_type Γ :
  Γ ⊢ₜ make_association :
    TForall (TProd (TArrow (TVar 0) TNat)
                   (TArrow TNat (TSum TUnit (TVar 0)))).
Proof.
  econstructor.
  eapply (LetIn_typed _ _ _ (Tref (ListType (TVar 0))) _);
    first by repeat econstructor.
  repeat econstructor; eauto using newlock_type, associate_type, get_type, typed.
Qed.