Section OrdinalThreadPool.
Context {resources: Resources}.
Context {Sem: Semantics}.
Local Notation ctl := (@ctl semC).
Notation tid:= nat.
Record t := mk
{ num_threads : pos
; pool :> 'I_num_threads -> ctl
; perm_maps : 'I_num_threads -> res
; lset : AMap.t lock_info
}.
Definition one_pos : pos.pos := pos.mkPos NPeano.Nat.lt_0_1.
Definition mkPool c res :=
mk one_pos
(fun _ =>  c)
(fun _ => res) (*initially there are no locks*)
empty_lset.
Definition lockGuts := lset.
Definition lockSet (tp:t) := A2PMap (lset tp).
Definition lockRes t : address -> option lock_info:=
AMap.find (elt:=lock_info)^~ (lockGuts t).
Definition lr_valid (lr: address -> option lock_info):=
forall b ofs,
match lr (b,ofs) with
| Some r => forall ofs0:Z, (ofs < ofs0 < ofs+LKSIZE)%Z -> lr (b, ofs0) = None
| _ => True
end.
Next Obligation.
intros. subst; reflexivity.
Defined.
Definition pos_pred (n:pos): nat.
Open Scope nat_scope.
(* Definition containsThread_dec (tp : t) (i : NatTID.tid) : bool:= Compare.Pcompare i (num_threads tp). *)
Definition containsThread (tp : t) (i : NatTID.tid) : Prop:=
i < num_threads tp.
Definition containsThread_dec:
forall i tp, {containsThread tp i} + { ~ containsThread tp i}.
Definition getThreadR {i tp} (cnt: containsThread tp i) : res :=
(perm_maps tp) (Ordinal cnt).
Definition latestThread tp := n (num_threads tp).
Definition addThread (tp : t) (vf arg : val) (pmap : res) : t :=
let: new_num_threads := pos_incr (num_threads tp) in
let: new_tid := ordinal_pos_incr (num_threads tp) in
mk new_num_threads
(fun (n : 'I_new_num_threads) =>
match unlift new_tid n with
| None => Kinit vf arg
| Some n' => tp n'
end)
(fun (n : 'I_new_num_threads) =>
match unlift new_tid n with
| None => pmap
| Some n' => (perm_maps tp) n'
end)
(lset tp).
Definition updLockSet tp (add:address) (lf:lock_info) : t :=
mk (num_threads tp)
(pool tp)
(perm_maps tp)
(AMap.add add lf (lockGuts tp)).
Definition remLockSet tp  (add:address) : t :=
mk (num_threads tp)
(pool tp)
(perm_maps tp)
(AMap.remove add (lockGuts tp)).
Definition updThreadC {tid tp} (cnt: containsThread tp tid) (c' : ctl) : t :=
mk (num_threads tp)
(fun n => if n == (Ordinal cnt) then c' else (pool tp)  n)
(perm_maps tp)
(lset tp).
Definition updThreadR {tid tp} (cnt: containsThread tp tid)
(pmap' : res) : t :=
mk (num_threads tp) (pool tp)
(fun n =>
if n == (Ordinal cnt) then pmap' else (perm_maps tp) n)
(lset tp).
Definition updThread {tid tp} (cnt: containsThread tp tid) (c' : ctl)
(pmap : res) : t :=
mk (num_threads tp)
(fun n =>
if n == (Ordinal cnt) then c' else tp n)
(fun n =>
if n == (Ordinal cnt) then pmap else (perm_maps tp) n)
(lset tp).
(*TODO: see if typeclasses can automate these proofs, probably not thanks dep types*)
unfold updLockSet, updThread; simpl; intros.
f_equal.
Qed.
unfold remLockSet, updThread; simpl; intros.
f_equal.
Qed.
(* TODO: most of these proofs are similar, automate them*)
(** Getters and Setters Properties*)
Set Bullet Behavior "None".
Set Bullet Behavior "Strict Subproofs".
Ltac address_ordered_auto :=
auto; repeat match goal with
| H: AddressOrdered.eq ?A ?A |- _ => clear H
| H: AddressOrdered.eq ?A ?B |- _ => hnf in H; subst A
| H: ?A <> ?A |- _ => contradiction H; reflexivity
| H: AddressOrdered.lt ?A ?A |- _ =>
apply AddressOrdered.lt_not_eq in H; contradiction H; reflexivity
| H: AddressOrdered.lt ?A ?B, H': AddressOrdered.lt ?B ?A |- _ =>
contradiction (AddressOrdered.lt_not_eq (AddressOrdered.lt_trans H H')); reflexivity
end.
Arguments InA {A}{eqA} x _.
Arguments AMap.In {elt} x m.
Definition containsList' (n:nat): seq.seq (sigT (fun i => i < n)):=
containsList_upto_n n n (leq_refl n).
Definition contains_from_ineq (tp:t):
{i : tid & i < num_threads tp } -> {i : tid & containsThread tp i}:=
fun (H : {i : tid & i < num_threads tp}) =>
let (x, i) := H in existT (containsThread tp) x i.
Definition containsList (tp:t): seq.seq (sigT (containsThread tp)):=
map (contains_from_ineq tp) (containsList' (num_threads tp)).
Definition indexed_contains tp:= (fun Ncontained: (sigT (containsThread tp)) =>
let (i, cnti) := Ncontained in getThreadR cnti).
Definition resourceList (tp:t): seq.seq res:=
map (@indexed_contains tp)
(containsList tp).

Lemma resourceList_spec: forall i tp
(cnti: containsThread tp i),
List.nth_error (resourceList tp) i = Some (getThreadR cnti).