** ===============================================================
** ===== System and Proprerty Specification of QLOCK =============
** ===============================================================

** ===============================================================
** ============= QLOCK System Specification ======================
** ===============================================================

-- three labels for indicating status of each agent
mod! LABEL {
-- label literals and labels
[LabelLt < Label]
-- rs: remainder section
-- ws: waiting section
-- cs: critical section
ops rs ws cs : -> LabelLt {constr} .
-- vars L1 L2 : LabelLt .
eq (L1:LabelLt = L2:LabelLt) = (L1 == L2) .
}

-- agent identifiers
mod* AID {[Aid]}

-- ===============================================================
-- queue (first in first out storage)
mod! QUEUE (X :: TRIV) {
-- elements and their queues, Elt comes from (X :: TRIV)
[Elt.X < Qu]
-- empty queue
op empQ : -> Qu {constr} . 
-- assoicative queue constructors with id: empQ
op (_&_) : Qu Qu -> Qu {constr assoc id: empQ} .
-- equality _=_ over the sort Qu
-- _=_ is defined for each sort in the built-in module EQL
eq (empQ = (E:Elt & Q:Qu)) = false .
ceq ((E1:Elt & Q1:Qu) = (E2:Elt & Q2:Qu)) 
    = ((E1 = E2) and (Q1 = Q2))
    if not((Q1 = empQ) and (Q2 = empQ)) .
}

-- ===============================================================
-- agent observer
mod! AOB {pr(LABEL) pr(AID)
[Aob]
-- (lb[A:Aid]: L:Label) is a term of the sort Aobs 
-- (an observer) that indicates an agent A is in a label L
-- i.e. (lb[A:Aid]: L:Label)
op (lb[_]:_) : Aid Label -> Aob {constr} .
}
-- generic set 
mod! SET(X :: TRIV) {
[Elt.X < Set]
-- empty set
op empty : -> Set {constr} .
-- assicative and commutative set constructor with identity empty
op (_ _) : Set Set -> Set {constr assoc comm id: empty} .
-- (_ _) is idempotent with respect to the sort Elt
eq E:Elt E = E .
}
-- queue of Aid
mod! AID-QUEUE {pr(QUEUE(AID{sort Elt -> Aid}))}
-- a state is defined as a pair of queue of Aid and a set of Aob
mod! STATE{
pr(AID-QUEUE)
pr(SET(AOB{sort Elt -> Aob})*{sort Set -> Aobs})
-- a state is a pair of Qu and Aobs
[State]
op _$_ : Qu Aobs -> State {constr} .
}

-- ===============================================================
-- wt: want transition
mod! WT {pr(STATE)
trans[wt]: 
           (Q:Qu   $ ((lb[A:Aid]: rs) AS:Aobs)) 
       => ((Q & A) $ ((lb[A    ]: ws) AS)) . 
}
-- ty: try transition
mod! TY {pr(STATE)
trans[ty]: 
          ((A:Aid & Q:Qu) $ ((lb[A]: ws) AS:Aobs)) 
       => ((A     & Q)    $ ((lb[A]: cs) AS)) .
}
-- ex: exit transition
mod! EX {pr(STATE)
trans[ex]: 
          ((A1:Aid & Q:Qu) $ ((lb[A2:Aid]: cs) AS:Aobs)) 
       =>           (Q     $ ((lb[A2    ]: rs) AS)) .
}

-- ===============================================================
-- system specification of QLOCK
mod! QLOCKsys{pr(WT + TY + EX)}

** ===============================================================
** ================ Property Specification =======================
** ===============================================================

-- ===============================================================
-- for defining state functions and predicates we need
-- Peano Style Natural Numbers with _+_ and _>_
mod! PNAT {
  [Nat]
  op 0 : -> Nat {constr} .
  op s_ : Nat -> Nat {constr} .
 -- equality over the natural numbers
  eq (0 = s(Y:Nat)) = false .
  eq (s(X:Nat) = s(Y:Nat)) = (X = Y) .
  eq (s(X:Nat) = X) = false .
  -- associative and commutative _+_
  [Nat]
  op _+_ : Nat Nat -> Nat {assoc comm} .
  eq 0 + Y:Nat = Y .
  eq (s X:Nat) + Y:Nat = s(X + Y) .
  -- strict greater than
  op _>_ : Nat Nat -> Bool .
  eq (s X:Nat) > 0 = true .
  eq 0 > (s Y:Nat) = false .
  eq (s X:Nat) > (s Y:Nat) = X > Y .
  eq (s X:Nat) > X = true .
  eq X:Nat > (s X) = false .
  eq X:Nat > X = false .
}

-- for defining tl(empQ)/hd(empQ) and #aq(tl Q:Qu)
mod* PNATerr {pr(PNAT) [Nat < Nat&Err]}
mod* AID-QUEUEerr {pr(AID-QUEUE)
-- error elements 
[Aid < Aid&Err]
-- head
op hd_ : Qu -> Aid&Err .
eq hd(E:Aid & Q:Qu) = E .
-- hd(empQ):Aid&Err indicates an error element
-- and no equations for it; an error handling method
-- error queues
[Qu < Qu&Err]
-- tail
op tl_ : Qu -> Qu&Err .
eq tl(E:Aid & Q:Qu) = Q .
-- tl(empQ):Qu&Err indicates an error queue
-- and no equations for it; an error handling method
}

** ===============================================================
-- elementary functions on states 
mod! STATEfuns {pr(STATE + PNATerr + AID-QUEUEerr) 
-- the queue in a state
op qu : State -> Qu .
eq qu(Q:Qu $ AS:Aobs) = Q .
-- the agent observations in a state
op aos : State -> Aobs .
eq aos(Q:Qu $ AS:Aobs) = AS .
-- length of Aobs
op #laos : Aobs -> Nat .
eq #laos(empty) = 0 .
eq #laos(A:Aob AS:Aobs) = (s 0) + #laos(AS) .
-- the number of a label in a state
op #ls : State Label -> Nat .
-- #ls's subordinate operator
op #lss : Aobs Label -> Nat .
eq #lss(empty,L:Label) = 0 .
eq #lss(((lb[A:Aid]: L1:Label) AS:Aobs),L2:Label) = 
   if (L1 = L2) then (s 0) + #lss(AS,L2) else #lss(AS,L2) fi .
eq #ls(S:State,L:Label) = #lss(aos(S),L) .
-- the number of an aid in a state
op #as : State Aid -> Nat .
-- #as's sub operator
op #ass : Aobs Aid -> Nat .
eq #ass(empty,A:Aid) = 0 .
eq #ass(((lb[A1:Aid]: L:Label) AS:Aobs),A2:Aid) =
   if (A1 = A2) then (s 0) + #ass(AS,A2) else #ass(AS,A2) fi .
eq #as(S:State,A:Aid) = #ass(aos(S),A) .
-- the number of an aid in a queue
-- Qu&Err and Nat&Err are used for handing #aq(tl Q:Qu)
op #aq : Qu&Err Aid -> Nat&Err .  
op #aq : Qu Aid -> Nat .
eq #aq(empQ,A:Aid) = 0 .
eq #aq(A1:Aid & Q:Qu,A2:Aid) =
   if (A1 = A2) then (s 0) + #aq(Q,A2) else #aq(Q,A2) fi .
}

-- ===============================================================
-- names of predicates on states and conjunction of the predicates
mod! PNAMEcj {pr(STATE)
-- names of predicates on States and sequences of them
[Pname < PnameSeq]
op (_ _) : PnameSeq PnameSeq -> PnameSeq {assoc} .
-- conjunction of predicates indicated in PnameSeq
op cj : PnameSeq State -> Bool .
eq cj(PN:Pname PNS:PnameSeq,S:State)
   = cj(PN,S) and cj(PNS,S) .
}

-- ===============================================================
-- predicates on states for well formed states and intitial states
mod! STATEpred-init {pr(STATEfuns + PNAMEcj)
-- at least one agent in a state
op aoa : -> Pname .
eq[aoa]: cj(aoa,S:State) = (#laos(aos(S)) > 0) .
-- no duplication of an Aid in a state 
op 1a : -> Pname .
-- sub for 1a
op 1as : Aobs -> Bool .
eq 1as(empty) = true .
eq 1as((lb[A:Aid]: L:Label) AS:Aobs) = 
   (#ass(AS,A) = 0) and 1as(AS) .
eq[1a]: cj(1a,S:State) = 1as(aos(S)) .
-- well formed states
op wfs : -> Pname .
eq[wfs]: wfs = aoa 1a .
-- the queue is empty
op qe : -> Pname .
eq[qe]: cj(qe,S:State) = (qu(S) = empQ) .
-- any Aid is in rs status, i.e. no ws, no cs
op allRs : -> Pname .
eq[allRs]: cj(allRs,S:State) = (#ls(S,ws)= 0) and (#ls(S,cs)= 0) .
}

-- ===============================================================
-- an initial state predicate
mod! INIT {pr(STATEpred-init)
op init : -> PnameSeq .
eq init = wfs qe allRs .
-- initial state predicate
pred init : State .
eq init(S:State) = cj(init,S) .
}

-- ===============================================================
-- predicates on states for an inductive invariant predicate
mod! STATEpred-inv {pr(STATEpred-init + AID-QUEUEerr)
-- mutual exclusion property: at most one agent is with cs
-- this is the goal predicate
op mx : -> Pname .
eq[mx]: cj(mx,S:State) = ((#ls(S,cs) = 0) or (#ls(S,cs) = (s 0))) .
-- several fragment predicates for an inductive invariant
ops qep rs ws cs : -> Pname .
-- if queue is empty
eq[qep]: cj(qep,(Q:Qu $ ((lb[A:Aid]: L:Label) AS:Aobs))) 
         = ((Q = empQ) implies 
            (#lss(((lb[A]: L) AS),cs) = 0)) .
-- if agent is in rs
eq[:m-and rs]: cj(rs,(Q:Qu $ ((lb[A:Aid]: L:Label) AS:Aobs))) 
        = ((L = rs) implies (#aq(Q,A) = 0)) .
-- if agent is in ws
eq[:m-and ws]: cj(ws,(Q:Qu $ ((lb[A:Aid]: L:Label) AS:Aobs))) 
        = ((L = ws) implies 
           ((#aq(Q,A) = (s 0)) and
            ((A = hd(Q)) implies (#lss(AS,cs) = 0)))) .
-- if agent is in cs
eq[:m-and cs]: cj(cs,(Q:Qu $ ((lb[A:Aid]: L:Label) AS:Aobs))) 
        = ((L = cs) implies ((A = hd(Q)) and 
                             (#aq(tl(Q),A) = 0)and 
                             (#lss(AS,cs) = 0))) .
}

-- ===============================================================
-- an inductive invariant predicate
mod! INV {pr(STATEpred-inv)
op inv : -> PnameSeq .
eq inv = wfs mx qep rs ws cs .
pred inv : State .
eq inv(S:State) = cj(inv,S) .
}

-- ===============================================================
-- property specification of QLOCK
mod! QLOCKprop{pr(INIT + INV)}

-- ===============================================================
-- ===============================================================