From mathcomp.ssreflect Require Import ssreflect ssrbool ssrnat ssrfun eqtype seq fintype finfun.
Set Implicit Arguments.
Inductive ctl {cT:Type} : Type :=
| Krun : cT -> ctl
| Kblocked : cT -> ctl
| Kresume : cT -> val -> ctl (* Carries the return value. Probably a unit.*)
| Kinit : val -> val -> ctl. (* vals correspond to vf and arg respectively. *)
Definition EqDec: Type -> Type :=
fun A : Type => forall a a' : A, {a = a'} + {a <> a'}.
(* Nth_error for lists*)
(** * Definition of threadpool*)
Module ThreadPool.
Section ThreadPool.
Context {resources: Resources}.
Context {Sem: Semantics}.
Local Notation ctl := (@ctl semC).
Notation tid:= nat.
Class ThreadPool :=
{ t : Type;
mkPool : ctl -> res -> t;
containsThread : t -> tid -> Prop;
getThreadC : forall {tid tp}, containsThread tp tid -> ctl;
getThreadR : forall {tid tp}, containsThread tp tid -> res;
resourceList : t -> seq.seq res;
lockGuts : t -> AMap.t lock_info;  (* Gets the set of locks + their info    *)
lockSet : t -> access_map;         (* Gets the permissions for the lock set *)
lockRes : t -> address -> option lock_info;
addThread : t -> val -> val -> res -> t;
updThreadC : forall {tid tp}, containsThread tp tid -> ctl -> t;
updThreadR : forall {tid tp}, containsThread tp tid -> res -> t;
updThread : forall {tid tp}, containsThread tp tid -> ctl -> res -> t;
updLockSet : t -> address -> lock_info -> t;
remLockSet : t -> address -> t;
latestThread : t -> tid;
lr_valid : (address -> option lock_info) -> Prop;
(*Find the first thread i, that satisfiList es (filter i) *)
find_thread_: t -> (ctl -> bool) -> option tid
; resourceList_spec: forall i tp
(cnti: containsThread tp i),
List.nth_error (resourceList tp) i = Some (getThreadR cnti)
;  containsThread_dec_:
forall i tp, {containsThread tp i} + { ~ containsThread tp i}
(*Proof Irrelevance of contains*)
;  cnt_irr: forall t tid
(cnt1 cnt2: containsThread t tid),
cnt1 = cnt2
(* Add Thread properties*)
;  cntAdd:
forall {j tp} vf arg p,
containsThread tp j ->
containsThread (addThread tp vf arg p) j
;  cntAddLatest:
forall {tp} vf arg p,
containsThread (addThread tp vf arg p) (latestThread tp)
;  cntAdd':
forall {j tp} vf arg p,
containsThread (addThread tp vf arg p) j ->
(containsThread tp j /\ j <> latestThread tp) \/ j = latestThread tp
(* Update properties*)
;  cntUpdateC:
forall {tid tid0 tp} c
(cnt: containsThread tp tid),
containsThread tp tid0->
containsThread (updThreadC cnt c) tid0
;  cntUpdateC':
forall {tid tid0 tp} c
(cnt: containsThread tp tid),
containsThread (updThreadC cnt c) tid0 ->
containsThread tp tid0
;  cntUpdateR:
forall {i j tp} r
(cnti: containsThread tp i),
containsThread tp j->
containsThread (updThreadR cnti r) j
;  cntUpdateR':
forall {i j tp} r
(cnti: containsThread tp i),
containsThread (updThreadR cnti r) j ->
containsThread tp j
;  cntUpdate:
forall {i j tp} c p
(cnti: containsThread tp i),
containsThread tp j ->
containsThread (updThread cnti c p) j
;  cntUpdate':
forall {i j tp} c p
(cnti: containsThread tp i),
containsThread (updThread cnti c p) j ->
containsThread tp j
;  cntUpdateL:
forall {j tp} add lf,
containsThread tp j ->
containsThread (updLockSet tp add lf) j
;  cntRemoveL:
forall {j tp} add,
containsThread tp j ->
containsThread (remLockSet tp add) j
;  cntUpdateL':
forall {j tp} add lf,
containsThread (updLockSet tp add lf) j ->
containsThread tp j
;  cntRemoveL':
forall {j tp} add,
containsThread (remLockSet tp add) j ->
containsThread tp j
(*;  gssLockPool: forall tp ls, lockSet (updLockSet tp ls) = ls*) (*Will change*)
;  gsoThreadLock:
forall {i tp} c p (cnti: containsThread tp i),
lockSet (updThread cnti c p) = lockSet tp
;  gsoThreadCLock :
forall {i tp} c (cnti: containsThread tp i),
lockSet (updThreadC cnti c) = lockSet tp
;  gsoThreadRLock :
forall {i tp} p (cnti: containsThread tp i),
lockSet (updThreadR cnti p) = lockSet tp
;  gsoAddLock :
forall tp vf arg p,
lockSet (addThread tp vf arg p) = lockSet tp
;  gssAddRes :
forall {tp} vf arg pmap j
(Heq: j = latestThread tp)
(cnt': containsThread (addThread tp vf arg pmap) j),
getThreadR cnt' = pmap
(*Get thread Properties*)
;  gssThreadCode :
forall {tid tp} (cnt: containsThread tp tid) c' p'
(cnt': containsThread (updThread cnt c' p') tid),
getThreadC cnt' = c'
;  gsoThreadCode :
forall {i j tp} (Hneq: i <> j) (cnti: containsThread tp i)
(cntj: containsThread tp j) c' p'
(cntj': containsThread (updThread cnti c' p') j),
getThreadC cntj' = getThreadC cntj
;  gssThreadRes :
forall {tid tp} (cnt: containsThread tp tid) c' p'
(cnt': containsThread (updThread cnt c' p') tid),
getThreadR cnt' = p'
;  gsoThreadRes :
forall {i j tp} (cnti: containsThread tp i)
(cntj: containsThread tp j) (Hneq: i <> j) c' p'
(cntj': containsThread (updThread cnti c' p') j),
getThreadR cntj' = getThreadR cntj
;  gssThreadCC :
forall {tid tp} (cnt: containsThread tp tid) c'
(cnt': containsThread (updThreadC cnt c') tid),
getThreadC cnt' = c'
;  gsoThreadCC :
forall {i j tp} (Hneq: i <> j) (cnti: containsThread tp i)
(cntj: containsThread tp j) c'
(cntj': containsThread (updThreadC cnti c') j),
getThreadC cntj = getThreadC cntj'
;  getThreadCC :
forall {tp} i j
(cnti : containsThread tp i) (cntj : containsThread tp j)
c' (cntj' : containsThread (updThreadC cnti c') j),
getThreadC cntj' = if Nat.eq_dec i j then c' else getThreadC cntj
;  gssThreadRR :
forall {tid tp} (cnt: containsThread tp tid) p'
(cnt': containsThread (updThreadR cnt p') tid),
getThreadR cnt' = p'
;  gsoThreadRR :
forall {i j tp} (Hneq: i <> j) (cnti: containsThread tp i)
(cntj: containsThread tp j) p'
(cntj': containsThread (updThreadR cnti p') j),
getThreadR cntj = getThreadR cntj'
;  gThreadCR :
forall {i j tp} (cnti: containsThread tp i)
(cntj: containsThread tp j) c'
(cntj': containsThread (updThreadC cnti c') j),
getThreadR cntj' = getThreadR cntj
;  gThreadRC :
forall {i j tp} (cnti: containsThread tp i)
(cntj: containsThread tp j) p
(cntj': containsThread (updThreadR cnti p) j),
getThreadC cntj' = getThreadC cntj
;  gsoThreadCLPool :
forall {i tp} c (cnti: containsThread tp i) addr,
lockRes (updThreadC cnti c) addr = lockRes tp addr
;  gsoThreadLPool :
forall {i tp} c p (cnti: containsThread tp i) addr,
lockRes (updThread cnti c p) addr = lockRes tp addr
;  gsoAddLPool :
forall tp vf arg p (addr : address),
lockRes (addThread tp vf arg p) addr = lockRes tp addr
;  gLockSetRes :
forall {i tp} addr (res : lock_info) (cnti: containsThread tp i)
(cnti': containsThread (updLockSet tp addr res) i),
getThreadR cnti' = getThreadR cnti
;  gLockSetCode :
forall {i tp} addr (res : lock_info) (cnti: containsThread tp i)
(cnti': containsThread (updLockSet tp addr res) i),
getThreadC cnti' = getThreadC cnti
;  gssLockRes :
forall tp addr pmap,
lockRes (updLockSet tp addr pmap) addr = Some pmap
;  gsoLockRes:
forall tp addr addr' pmap
(Hneq: addr <> addr'),
lockRes (updLockSet tp addr pmap) addr' =
lockRes tp addr'
;  gssLockSet :
forall tp b ofs rmap ofs',
(ofs <= ofs' < ofs + Z.of_nat lksize.LKSIZE_nat)%Z ->
(Maps.PMap.get b (lockSet (updLockSet tp (b, ofs) rmap)) ofs') = Some Writable
;  gsoLockSet_1 :
forall tp b ofs ofs'  pmap
(Hofs: (ofs' < ofs)%Z \/ (ofs' >= ofs + (Z.of_nat lksize.LKSIZE_nat))%Z),
(Maps.PMap.get b (lockSet (updLockSet tp (b,ofs) pmap))) ofs' =
(Maps.PMap.get b (lockSet tp)) ofs'
;  gsoLockSet_2 :
forall tp b b' ofs ofs' pmap,
b <> b' ->
(Maps.PMap.get b' (lockSet (updLockSet tp (b,ofs) pmap))) ofs' =
(Maps.PMap.get b' (lockSet tp)) ofs'
;  lockSet__updLockSet:
forall tp i (pf: containsThread tp i) c pmap addr rmap,
lockSet (updLockSet tp addr rmap) =
lockSet (updLockSet (updThread pf c pmap) addr rmap)
;  updThread_updThreadC__comm :
forall tp i j c pmap' c'
(Hneq: i <> j)
(cnti : containsThread tp i)
(cntj : containsThread tp j)
(cnti': containsThread (updThread cntj c' pmap') i)
(cntj': containsThread (updThreadC cnti c) j),
updThreadC cnti' c = updThread cntj' c' pmap'
;  updThread_comm :
forall tp i j c pmap c' pmap'
(Hneq: i <> j)
(cnti : containsThread tp i)
(cntj : containsThread tp j)
(cnti': containsThread (updThread cntj c' pmap') i)
(cntj': containsThread (updThread cnti c pmap) j),
updThread cnti' c pmap = updThread cntj' c' pmap'
;  add_updateC_comm :
forall tp i vf arg pmap c'
(cnti: containsThread tp i)
(cnti': containsThread (addThread tp vf arg pmap) i),
addThread (updThreadC cnti c') vf arg pmap =
updThreadC cnti' c'
;  add_update_comm :
forall tp i vf arg pmap c' pmap'
(cnti: containsThread tp i)
(cnti': containsThread (addThread tp vf arg pmap) i),
addThread (updThread cnti c' pmap') vf arg pmap =
updThread cnti' c' pmap'
;  updThread_lr_valid :
forall tp i (cnti: containsThread tp i) c' m',
lr_valid (lockRes tp) ->
lr_valid (lockRes (updThread cnti c' m'))
(*New Axioms, to avoid breaking the modularity *)
; lockSet_spec_2 :
forall (js : t) (b : block) (ofs ofs' : Z),
Intv.In ofs' (ofs, (ofs + Z.of_nat lksize.LKSIZE_nat)%Z) ->
lockRes js (b, ofs) -> (lockSet js) !! b ofs' = Some Memtype.Writable
;  lockSet_spec_3 :
forall ds b ofs,
(forall z, z <= ofs < z+LKSIZE -> lockRes ds (b,z) = None)%Z ->
(lockSet ds) !! b ofs = None
;  gsslockSet_rem : forall ds b ofs ofs0,
lr_valid (lockRes ds) ->
Intv.In ofs0 (ofs, ofs + lksize.LKSIZE)%Z ->
isSome ((lockRes ds) (b,ofs)) ->  (*New hypothesis needed. Shouldn't be a problem *)
(lockSet (remLockSet ds (b, ofs))) !! b ofs0 =
None
;  gsolockSet_rem1 : forall ds b ofs b' ofs',
b  <> b' ->
(lockSet (remLockSet ds (b, ofs))) !! b' ofs' =
(lockSet ds)  !! b' ofs'
;  gsolockSet_rem2 : forall ds b ofs ofs',
lr_valid (lockRes ds) ->
~ Intv.In ofs' (ofs, ofs + lksize.LKSIZE)%Z ->
(lockSet (remLockSet ds (b, ofs))) !! b ofs' =
(lockSet ds)  !! b ofs'
;  gsslockResUpdLock: forall js a res,
lockRes (updLockSet js a res) a =
Some res
;  gsolockResUpdLock : forall js loc a res,
loc <> a ->
lockRes (updLockSet js loc res) a =
lockRes js a
;  gsslockResRemLock : forall js a,
lockRes (remLockSet js a) a =
None
;  gsolockResRemLock : forall js loc a,
loc <> a ->
lockRes (remLockSet js loc) a =
lockRes js a
;  gRemLockSetCode :
forall {i tp} addr (cnti: containsThread tp i)
(cnti': containsThread (remLockSet tp addr) i),
getThreadC cnti' = getThreadC cnti
;  gRemLockSetRes :
forall {i tp} addr (cnti: containsThread tp i)
(cnti': containsThread (remLockSet tp addr) i),
getThreadR cnti' = getThreadR cnti
;  gsoAddCode :
forall {tp} vf arg pmap j
(cntj: containsThread tp j)
(cntj': containsThread (addThread tp vf arg pmap) j),
getThreadC cntj' = getThreadC cntj
;  gssAddCode :
forall {tp} vf arg pmap j
(Heq: j = latestThread tp)
(cnt': containsThread (addThread tp vf arg pmap) j),
getThreadC cnt' = Kinit vf arg
;  gsoAddRes :
forall {tp} vf arg pmap j
(cntj: containsThread tp j) (cntj': containsThread (addThread tp vf arg pmap) j),
getThreadR cntj' = getThreadR cntj
;  updLock_updThread_comm :
forall ds,
forall i (cnti: containsThread ds i) c map l lmap,
forall (cnti': containsThread (updLockSet ds l lmap) i),
updLockSet
(@updThread _ ds cnti c map) l lmap =
@updThread  _ (updLockSet ds l lmap) cnti' c map
;  remLock_updThread_comm :
forall ds,
forall i (cnti: containsThread ds i) c map l,
forall (cnti': containsThread (remLockSet ds l) i),
remLockSet
(updThread cnti c map)
l =
updThread cnti' c map
;  remLock_updThreadC_comm :
forall ds,
forall i (cnti: containsThread ds i) c l,
forall (cnti': containsThread (remLockSet ds l) i),
remLockSet (updThreadC cnti c) l = updThreadC cnti' c
}.
End ThreadPool.
End ThreadPool.
Module OrdinalPool.
Definition empty_lset {lock_info}:AMap.t lock_info:=
AMap.empty lock_info.

(* Specifications: *)
Lemma find_empty:
forall a l,
@AMap.find a l empty_lset = None.