Remove petri net only code and rename terminology for population protocols

src/Parser/LOLA.hs

-module Parser.LOLA
-    (module Parser.LOLAFormula,
-     parseContent)
-where
-
-import Control.Applicative ((*>),(<*))
-import Text.Parsec
-import Text.Parsec.Language (LanguageDef, emptyDef)
-import qualified Text.Parsec.Token as Token
-
-import Parser
-import Parser.LOLAFormula
-import PetriNet (PetriNet,makePetriNetWithTransFromStrings)
-import Property
-
-languageDef :: LanguageDef ()
-languageDef =
-        emptyDef {
-                 Token.commentStart    = "{",
-                 Token.commentEnd      = "}",
-                 Token.commentLine     = "",
-                 Token.identStart      = noneOf ",;:(){}\t \n\r",
-                 Token.identLetter     = noneOf ",;:(){}\t \n\r",
-                 Token.reservedNames   = ["PLACE", "MARKING", "SAFE",
-                                          "TRANSITION", "CONSUME", "PRODUCE",
-                                          "STRONG", "WEAK", "FAIR"],
-                 Token.reservedOpNames = []
-                 }
-
-lexer :: Token.TokenParser ()
-lexer = Token.makeTokenParser languageDef
-
-identifier :: Parser String
-identifier = Token.identifier lexer -- parses an identifier
-reserved :: String -> Parser ()
-reserved   = Token.reserved   lexer -- parses a reserved name
-integer :: Parser Integer
-integer    = Token.integer    lexer -- parses an integer
-colon :: Parser String
-colon      = Token.colon      lexer -- parses a colon
-semi :: Parser String
-semi       = Token.semi       lexer -- parses a semicolon
-commaSep1 :: Parser a -> Parser [a]
-commaSep1  = Token.commaSep1  lexer -- parses a comma separated list
-whiteSpace :: Parser ()
-whiteSpace = Token.whiteSpace lexer -- parses whitespace
-
-
-ident :: Parser String
-ident = (identifier <|> fmap show integer) <?> "identifier"
-
-net :: Parser PetriNet
-net = do
-        reserved "PLACE"
-        ps <- placeLists
-        reserved "MARKING"
-        initial <- option [] markingList
-        _ <- semi
-        ts <- many1 transition
-        return $ makePetriNetWithTransFromStrings "" ps ts initial [] [] [] [] []
-
-placeLists :: Parser [String]
-placeLists =
-        fmap concat (many1 (do
-            _ <- optionMaybe (reserved "SAFE" *> option 1 integer <* colon)
-            ps <- placeList
-            _ <- semi
-            return ps
-        ))
-
-placeList :: Parser [String]
-placeList = commaSep1 ident
-
-markingList :: Parser [(String, Integer)]
-markingList = commaSep1 marking
-
-marking :: Parser (String, Integer)
-marking = do
-        s <- ident
-        i <- option 1 (colon *> integer)
-        return (s, i)
-
-transition :: Parser (String, ([(String, Integer)], [(String, Integer)]))
-transition = do
-        reserved "TRANSITION"
-        t <- ident
-        _ <- optionMaybe ((reserved "STRONG" <|> reserved "WEAK") <*
-                          reserved "FAIR")
-        reserved "CONSUME"
-        input <- option [] arcList
-        _ <- semi
-        reserved "PRODUCE"
-        output <- option [] arcList
-        _ <- semi
-        return (t, (input, output))
-
-arcList :: Parser [(String, Integer)]
-arcList = commaSep1 arc
-
-arc :: Parser (String, Integer)
-arc = do
-        x <- ident
-        w <- option 1 (colon *> integer)
-        return (x, w)
-
-parseContent :: Parser (PetriNet,[Property])
-parseContent = do
-        whiteSpace
-        n <- net
-        eof
-        return (n, [])

src/Parser/LOLAFormula.hs

-module Parser.LOLAFormula
-    (parseFormula)
-where
-
-import Control.Applicative ((*>),(<$>))
-import Data.Functor.Identity
-import Text.Parsec
-import Text.Parsec.Expr
-import Text.Parsec.Language (LanguageDef, emptyDef)
-import qualified Text.Parsec.Token as Token
-
-import Parser
-import Property
-
-languageDef :: LanguageDef ()
-languageDef =
-        emptyDef {
-                 Token.commentStart    = "{",
-                 Token.commentEnd      = "}",
-                 Token.commentLine     = "",
-                 Token.identStart      = noneOf ",;:(){}\t \n\r0123456789-",
-                 Token.identLetter     = noneOf ",;:(){}\t \n\r",
-                 Token.reservedNames   = ["FORMULA", "TRUE", "FALSE",
-                                          "NOT", "AND", "OR"],
-                 Token.reservedOpNames = ["<", "<=", "=", "!=", ">=", ">",
-                                          "+", "-", "*"]
-                 }
-
-lexer :: Token.TokenParser ()
-lexer = Token.makeTokenParser languageDef
-
-identifier :: Parser String
-identifier = Token.identifier lexer -- parses an identifier
-reserved :: String -> Parser ()
-reserved   = Token.reserved   lexer -- parses a reserved name
-reservedOp :: String -> Parser ()
-reservedOp = Token.reservedOp lexer -- parses an operator
-parens :: Parser a -> Parser a
-parens     = Token.parens     lexer -- parses p surrounded by parenthesis
-integer :: Parser Integer
-integer    = Token.integer    lexer -- parses an integer
-whiteSpace :: Parser ()
-whiteSpace = Token.whiteSpace lexer -- parses whitespace
-
-
-binary :: String -> (a -> a -> a) -> Assoc -> Operator String () Identity a
-binary name fun = Infix  ( reservedOp name *> return fun )
-prefix :: String -> (a -> a) -> Operator String () Identity a
-prefix name fun = Prefix ( reservedOp name *> return fun )
-
-termOperatorTable :: [[Operator String () Identity (Term String)]]
-termOperatorTable =
-        [ [ prefix "-" Minus ]
-        , [ binary "*" (:*:) AssocLeft ]
-        , [ binary "+" (:+:) AssocLeft, binary "-" (:-:) AssocLeft ]
-        ]
-
-termAtom :: Parser (Term String)
-termAtom =  (Var <$> identifier)
-        <|> (Const <$> integer)
-        <|> parens term
-        <?> "basic term"
-
-term :: Parser (Term String)
-term = buildExpressionParser termOperatorTable termAtom <?> "term"
-
-parseOp :: Parser Op
-parseOp = (reservedOp "<" *> return Lt) <|>
-          (reservedOp "<=" *> return Le) <|>
-          (reservedOp "=" *> return Eq) <|>
-          (reservedOp "!=" *> return Ne) <|>
-          (reservedOp ">" *> return Gt) <|>
-          (reservedOp ">=" *> return Ge)
-
-linIneq :: Parser (Formula String)
-linIneq = do
-        lhs <- term
-        op <- parseOp
-        rhs <- term
-        return (LinearInequation lhs op rhs)
-
-binaryName :: String -> (a -> a -> a) -> Assoc -> Operator String () Identity a
-binaryName name fun = Infix  ( reserved name *> return fun )
-prefixName :: String -> (a -> a) -> Operator String () Identity a
-prefixName name fun = Prefix ( reserved name *> return fun )
-
-formOperatorTable :: [[Operator String () Identity (Formula String)]]
-formOperatorTable =
-        [ [ prefixName "NOT" Neg ]
-        , [ binaryName "AND" (:&:) AssocRight ]
-        , [ binaryName "OR"  (:|:) AssocRight ]
-        ]
-
-formAtom :: Parser (Formula String)
-formAtom =  try linIneq
-        <|> (reserved "TRUE" *> return FTrue)
-        <|> (reserved "FALSE" *> return FFalse)
-        <|> parens formula
-        <?> "basic formula"
-
-formula :: Parser (Formula String)
-formula = buildExpressionParser formOperatorTable formAtom <?> "formula"
-
-parseFormula :: Parser (Formula String)
-parseFormula = do
-        whiteSpace
-        reserved "FORMULA"
-        f <- formula
-        eof
-        return f

src/Parser/MIST.hs

-module Parser.MIST
-    (parseContent)
-where
-
-import Control.Applicative ((<$>),(*>),(<*),(<*>))
-import Control.Monad (when)
-import Data.List (sortBy, groupBy)
-import Data.Function (on)
-import Data.Ord (comparing)
-import Text.Parsec
-import Text.Parsec.Language (LanguageDef, emptyDef)
-import qualified Text.Parsec.Token as Token
-
-import Parser
-import PetriNet (PetriNet,makePetriNetWithTransFromStrings,Place(..))
-import Property
-
-languageDef :: LanguageDef ()
-languageDef =
-        emptyDef {
-                 Token.commentStart    = "",
-                 Token.commentEnd      = "",
-                 Token.commentLine     = "#",
-                 Token.identStart      = letter <|> char '_',
-                 Token.identLetter     = alphaNum <|> oneOf "'_",
-                 Token.reservedNames   = ["vars", "rules", "init",
-                                          "target", "invariants"],
-                 Token.reservedOpNames = ["->", "+", "-", "=", ">="]
-                 }
-
-lexer :: Token.TokenParser ()
-lexer = Token.makeTokenParser languageDef
-
-identifier :: Parser String
-identifier = Token.identifier lexer -- parses an identifier
-reserved :: String -> Parser ()
-reserved   = Token.reserved   lexer -- parses a reserved name
-reservedOp :: String -> Parser ()
-reservedOp = Token.reservedOp lexer -- parses an operator
-integer :: Parser Integer
-integer    = Token.integer    lexer -- parses an integer
-semi :: Parser String
-semi       = Token.semi       lexer -- parses a semicolon
-commaSep :: Parser a -> Parser [a]
-commaSep   = Token.commaSep   lexer -- parses a comma separated list
-commaSep1 :: Parser a -> Parser [a]
-commaSep1  = Token.commaSep1  lexer -- parses a comma separated list
-whiteSpace :: Parser ()
-whiteSpace = Token.whiteSpace lexer -- parses whitespace
-
-
-net :: Parser PetriNet
-net = do
-        reserved "vars"
-        ps <- many1 identifier
-        reserved "rules"
-        ts <- transitions
-        reserved "init"
-        (is,initTrans) <- initial
-        return $ makePetriNetWithTransFromStrings "" ps (initTrans ++ ts) is
-                 (map fst initTrans) [] [] [] []
-
-prop :: Parser Property
-prop = do
-        reserved "target"
-        ineqs <- many1 (commaSep1 ineq)
-        _ <- optionMaybe (reserved "invariants" *> invariants)
-        return $ Property "" $ Safety $
-                    foldl1 (:|:) $ map (foldl1 (:&:)) ineqs
-
-ineq :: Parser (Formula Place)
-ineq = do
-        x <- identifier
-        reservedOp ">="
-        c <- integer
-        return $ LinearInequation (Var (Place x)) Ge (Const c)
-
-transitions :: Parser [(String, ([(String, Integer)], [(String, Integer)]))]
-transitions = do
-        ts <- many1 transition
-        return $ map (\(i,(l,r)) -> ("'t" ++ show i,(l,r)))
-                        ([(1::Integer)..] `zip` ts)
-
-transition :: Parser ([(String, Integer)], [(String, Integer)])
-transition = do
-        lhs <- commaSep ((,) <$> identifier <* reservedOp ">=" <*> integer)
-        reservedOp "->"
-        rhs <- commaSep transitionAssignment
-        let rhs' = map (\xs -> (fst (head xs), sum (map snd xs))) $
-                   groupBy ((==) `on` fst) $
-                   sortBy (comparing fst) $
-                   lhs ++ rhs
-        _ <- semi
-        return (lhs, rhs')
-
-transitionAssignment :: Parser (String, Integer)
-transitionAssignment = do
-        i1 <- identifier
-        reservedOp "="
-        i2 <- identifier
-        when (i1 /= i2 ++ "'")
-            (error ("identifiers not equal: " ++ i1 ++ " /= " ++ i2))
-        fac <- (reservedOp "-" *> return (-1)) <|> (reservedOp "+" *> return 1)
-        n <- integer
-        return (i2,fac*n)
-
-initial :: Parser ([(String, Integer)],
-                  [(String, ([(String, Integer)], [(String, Integer)]))])
-initial = do
-        xs <- commaSep1 initState
-        let inits = [(x,i) | (x,i,_) <- xs]
-        let covered = [x | (x,_,True) <- xs]
-        let initTrans = map (\(i,x) -> ("'init" ++ show i, ([], [(x,1)])))
-                            ([(1::Integer)..] `zip` covered)
-        return (inits, initTrans)
-
-initState :: Parser (String, Integer, Bool)
-initState = do
-        s <- identifier
-        cover <- reservedOp "=" *> return False <|>
-                reservedOp ">=" *> return True
-        i <- integer
-        return (s,i,cover)
-
-invariants :: Parser [[(String, Integer)]]
-invariants = many1 (commaSep1 ((,) <$> identifier <* reservedOp "=" <*> integer))
-
-parseContent :: Parser (PetriNet,[Property])
-parseContent = do
-        whiteSpace
-        n <- net
-        p <- prop
-        eof
-        return (n, [p])

src/Parser/PNET.hs → src/Parser/PP.hs

-module Parser.PNET
+module Parser.PP
     (parseContent)
 where
 
@@ -10,7 +10,7 @@ import Text.Parsec.Language (LanguageDef, emptyDef)
 import qualified Text.Parsec.Token as Token
 
 import Parser
-import PetriNet (PetriNet,makePetriNetFromStrings,Place(..),Transition(..))
+import PopulationProtocol (PopulationProtocol,makePopulationProtocolFromStrings,State(..),Transition(..))
 import Property
 
 languageDef :: LanguageDef ()
@@ -68,24 +68,14 @@ ident = (identifier <|> stringLiteral) <?> "identifier"
 identList :: Parser [String]
 identList = singleOrList ident
 
-places :: Parser [String]
-places = reserved "places" *> identList
+states :: Parser [String]
+states = reserved "states" *> identList
 
 transitions :: Parser [String]
 transitions = reserved "transitions" *> identList
 
-initial :: Parser [(String,Integer)]
-initial = reserved "initial" *> singleOrList (do
-            n <- ident
-            i <- numberOption
-            return (n,i)
-          )
-
-trap :: Parser [String]
-trap = reserved "trap" *> identList
-
-siphon :: Parser [String]
-siphon = reserved "siphon" *> identList
+initial :: Parser [String]
+initial = reserved "initial" *> identList
 
 yesStates :: Parser [String]
 yesStates = reserved "yes" *> identList
@@ -112,39 +102,37 @@ arcs = do
         as <- singleOrList arc
         return $ concat as
 
-data Statement = Places [String] | Transitions [String] |
-                 Arcs [(String,String,Integer)] | Initial [(String,Integer)] |
-                 TrapStatement [String] | SiphonStatement [String] |
-                 YesStatement [String] | NoStatement [String]
+data Statement = States [String]
+               | Transitions [String]
+               | Initial [String]
+               | YesStatement [String]
+               | NoStatement [String]
+               | Arcs [(String,String,Integer)]
 
 statement :: Parser Statement
-statement = Places <$> places <|>
+statement = States <$> states <|>
             Transitions <$> transitions <|>
             Arcs <$> arcs <|>
             Initial <$> initial <|>
-            TrapStatement <$> trap <|>
-            SiphonStatement <$> siphon <|>
             YesStatement <$> yesStates <|>
             NoStatement <$> noStates
 
-petriNet :: Parser PetriNet
-petriNet = do
-            reserved "petri"
-            reserved "net"
+populationProtocol :: Parser PopulationProtocol
+populationProtocol = do
+            reserved "population"
+            reserved "protocol"
             name <- option "" ident
             statements <- braces (many statement)
-            let (p,t,a,i,traps,siphons,yesStates,noStates) = foldl splitStatement ([],[],[],[],[],[],[],[]) statements
-            return $ makePetriNetFromStrings name p t a i [] traps siphons yesStates noStates
+            let (qs,ts,is,ys,ns,as) = foldl splitStatement ([],[],[],[],[],[]) statements
+            return $ makePopulationProtocolFromStrings name qs ts is ys ns as
         where
-            splitStatement (ps,ts,as,is,traps,siphons,ys,ns) stmnt = case stmnt of
-                  Places p -> (p ++ ps,ts,as,is,traps,siphons,ys,ns)
-                  Transitions t -> (ps,t ++ ts,as,is,traps,siphons,ys,ns)
-                  Arcs a -> (ps,ts,a ++ as,is,traps,siphons,ys,ns)
-                  Initial i -> (ps,ts,as,i ++ is,traps,siphons,ys,ns)
-                  TrapStatement trap -> (ps,ts,as,is,trap:traps,siphons,ys,ns)
-                  SiphonStatement siphon -> (ps,ts,as,is,traps,siphon:siphons,ys,ns)
-                  YesStatement y -> (ps,ts,as,is,traps,siphons,y ++ ys,ns)
-                  NoStatement n -> (ps,ts,as,is,traps,siphons,ys,n ++ ns)
+            splitStatement (qs,ts,is,ys,ns,as) stmnt = case stmnt of
+                  States q -> (q ++ qs,ts,is,ys,ns,as)
+                  Transitions t -> (qs,t ++ ts,is,ys,ns,as)
+                  Initial i -> (qs,ts,i ++ is,ys,ns,as)
+                  YesStatement y -> (qs,ts,is,y ++ ys,ns,as)
+                  NoStatement n -> (qs,ts,is,ys,n ++ ns,as)
+                  Arcs a -> (qs,ts,is,ys,ns,a ++ as)
 
 binary :: String -> (a -> a -> a) -> Assoc -> Operator String () Identity a
 binary name fun = Infix  ( reservedOp name *> return fun )
@@ -202,9 +190,7 @@ formula = buildExpressionParser formOperatorTable formAtom <?> "formula"
 propertyType :: Parser PropertyType
 propertyType =
         (reserved "safety" *> return SafetyType) <|>
-        (reserved "liveness" *> return LivenessType) <|>
-        (reserved "structural" *> return StructuralType)
-
+        (reserved "liveness" *> return LivenessType)
 
 property :: Parser Property
 property = do
@@ -215,16 +201,15 @@ property = do
             SafetyType -> do
                 form <- braces formula
                 return Property
-                    { pname=name, pcont=Safety (fmap Place form) }
+                    { pname=name, pcont=Safety (fmap PopulationProtocol.State form) }
             LivenessType -> do
                 form <- braces formula
                 return Property { pname=name, pcont=Liveness (fmap Transition form) }
-            StructuralType -> error "structural property not supported for pnet"
 
-parseContent :: Parser (PetriNet,[Property])
+parseContent :: Parser (PopulationProtocol,[Property])
 parseContent = do
         whiteSpace
-        net <- petriNet
+        pp <- populationProtocol
         properties <- many property
         eof
-        return (net, properties)
+        return (pp, properties)

src/Parser/TPN.hs

-module Parser.TPN
-    (parseContent)
-where
-
-import Control.Applicative ((*>))
-import Control.Arrow ((&&&))
-import Text.Parsec
-import Text.Parsec.Language (LanguageDef, emptyDef)
-import qualified Text.Parsec.Token as Token
-import Data.List (group,sort,genericLength)
-
-import Parser
-import PetriNet (PetriNet,makePetriNetWithTransFromStrings)
-import Property
-
-languageDef :: LanguageDef ()
-languageDef =
-        emptyDef {
-                 Token.commentStart    = "",
-                 Token.commentEnd      = "",
-                 Token.commentLine     = "--",
-                 Token.identStart      = letter <|> char '_',
-                 Token.identLetter     = alphaNum <|> char '_',
-                 Token.reservedNames   = ["place", "trans", "init",
-                                          "in", "out"],
-                 Token.reservedOpNames = ["~"]
-                 }
-
-lexer :: Token.TokenParser ()
-lexer = Token.makeTokenParser languageDef
-
-identifier :: Parser String
-identifier = Token.identifier lexer -- parses an identifier
-stringLiteral :: Parser String
-stringLiteral = Token.stringLiteral lexer -- parses a string literal
-reserved :: String -> Parser ()
-reserved   = Token.reserved   lexer -- parses a reserved name
-reservedOp :: String -> Parser ()
-reservedOp = Token.reservedOp lexer -- parses an operator
-natural :: Parser Integer
-natural    = Token.natural    lexer -- parses a natural number
-semi :: Parser String
-semi       = Token.semi       lexer -- parses a semicolon
-whiteSpace :: Parser ()
-whiteSpace = Token.whiteSpace lexer -- parses whitespace
-
-
-ident :: Parser String
-ident = (identifier <|> stringLiteral) <?> "identifier"
-
-place :: Parser (String, Maybe Integer)
-place = do
-        reserved "place"
-        p <- ident
-        initial <- optionMaybe (reserved "init" *> natural)
-        _ <- semi
-        return (p, initial)
-
-adjacencyList :: Parser [(String, Integer)]
-adjacencyList = do
-        xs <- many1 ident
-        return $ map (head &&& genericLength) $ group $ sort xs
-
-transition :: Parser (String, ([(String, Integer)], [(String, Integer)]))
-transition = do
-        reserved "trans"
-        t <- ident
-        _ <- optionMaybe (reservedOp "~" *> ident)
-        input <- option [] (reserved "in" *> adjacencyList)
-        output <- option [] (reserved "out" *> adjacencyList)
-        _ <- semi
-        return (t, (input, output))
-
-petriNet :: Parser PetriNet
-petriNet = do
-        ps <- many place
-        ts <- many transition
-        let places = [ p | (p,_) <- ps ]
-            initial = [ (p,i) | (p,Just i) <- ps ]
-        return $ makePetriNetWithTransFromStrings "" places ts initial [] [] [] [] []
-
-parseContent :: Parser (PetriNet,[Property])
-parseContent = do
-        whiteSpace
-        net <- petriNet
-        eof
-        return (net, [])

src/PopulationProtocol.hs

+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+module PopulationProtocol
+    (PopulationProtocol,State(..),Transition(..),Marking,FiringVector,
+     RMarking,RFiringVector,
+     renameState,renameTransition,renameStatesAndTransitions,
+     name,showNetName,states,transitions,
+     initialStates,
+     pre,lpre,post,lpost,mpre,mpost,context,
+     yesStates,noStates,
+     makePopulationProtocol,makePopulationProtocolWithTrans,
+     makePopulationProtocolFromStrings,makePopulationProtocolWithTransFromStrings,Trap,Siphon,
+     Invariant(..))
+where
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Control.Arrow (first,(***))
+import Data.List (sort,(\\))
+
+import Util
+
+newtype State = State String deriving (Ord,Eq)
+newtype Transition = Transition String deriving (Ord,Eq)
+
+instance Show State where
+        show (State q) = q
+instance Show Transition where
+        show (Transition t) = t
+
+type SimpleCut = (S.Set Transition, [S.Set Transition])
+
+type ContextMap a b = M.Map a ([(b, Integer)],[(b, Integer)])
+
+class (Ord a, Ord b) => Nodes a b | a -> b where
+        lpre :: PopulationProtocol -> a -> [(b, Integer)]