Commit 0a3b470d authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Added parser for lola input

parent 1b6b33d4
PLACE
p1, p2, p3, b1, nb1,
q1, q2, q3, q4, q5, b2, nb2;
MARKING
p1, q1, nb1, nb2;
TRANSITION s1
CONSUME p1, nb1;
PRODUCE p2, b1;
TRANSITION s2
CONSUME p2, b2;
PRODUCE p2, b2;
TRANSITION s3
CONSUME p2, nb2;
PRODUCE p3, nb2;
TRANSITION s4
CONSUME p3, b1;
PRODUCE p1, nb1;
TRANSITION t1
CONSUME q1, nb2;
PRODUCE q2, b2;
TRANSITION t2
CONSUME q2, b1;
PRODUCE q3, b1;
TRANSITION t3
CONSUME q3, b2;
PRODUCE q4, nb2;
TRANSITION t4
CONSUME q4, nb1;
PRODUCE q1, nb1;
TRANSITION t5
CONSUME q4, b1;
PRODUCE q4, b1;
TRANSITION t6
CONSUME q2, nb1;
PRODUCE q5, nb1;
TRANSITION t7
CONSUME q5, b2;
PRODUCE q1, nb2;
...@@ -11,6 +11,7 @@ import Control.Applicative ...@@ -11,6 +11,7 @@ import Control.Applicative
import Parser import Parser
import qualified Parser.PNET as PNET import qualified Parser.PNET as PNET
import qualified Parser.LOLA as LOLA
import qualified Parser.TPN as TPN import qualified Parser.TPN as TPN
import PetriNet import PetriNet
import Property import Property
...@@ -83,6 +84,7 @@ checkFile parser verbose addedProperties file = do ...@@ -83,6 +84,7 @@ checkFile parser verbose addedProperties file = do
(net,properties) <- parseFile parser file (net,properties) <- parseFile parser file
putStrLn $ "Analyzing " ++ showNetName net putStrLn $ "Analyzing " ++ showNetName net
when verbose (do when verbose (do
print net
putStrLn $ "Places: " ++ show (length $ places net) putStrLn $ "Places: " ++ show (length $ places net)
putStrLn $ "Transitions: " ++ show (length $ transitions net) putStrLn $ "Transitions: " ++ show (length $ transitions net)
) )
...@@ -154,7 +156,7 @@ main = do ...@@ -154,7 +156,7 @@ main = do
when (null files) (exitErrorWith "No input file given") when (null files) (exitErrorWith "No input file given")
let parser = case inputFormat opts of let parser = case inputFormat opts of
PNET -> PNET.parseContent PNET -> PNET.parseContent
LOLA -> error "lola is not supported yet" LOLA -> LOLA.parseContent
TPN -> TPN.parseContent TPN -> TPN.parseContent
let properties = [ Property "termination" Liveness FTrue let properties = [ Property "termination" Liveness FTrue
| proveTermination opts ] | proveTermination opts ]
......
module Parser.LOLA
(parseContent)
where
import Control.Applicative ((*>),(<*))
import Text.Parsec
import Text.Parsec.Language (LanguageDef, emptyDef)
import qualified Text.Parsec.Token as Token
import Parser
import PetriNet (PetriNet,makePetriNetWithTrans)
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 $ makePetriNetWithTrans "" 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, [])
...@@ -10,7 +10,7 @@ import qualified Text.Parsec.Token as Token ...@@ -10,7 +10,7 @@ import qualified Text.Parsec.Token as Token
import Data.List (group,sort,genericLength) import Data.List (group,sort,genericLength)
import Parser import Parser
import PetriNet (PetriNet,makePetriNet) import PetriNet (PetriNet,makePetriNetWithTrans)
import Property import Property
languageDef :: LanguageDef () languageDef :: LanguageDef ()
...@@ -40,7 +40,7 @@ reservedOp = Token.reservedOp lexer -- parses an operator ...@@ -40,7 +40,7 @@ reservedOp = Token.reservedOp lexer -- parses an operator
natural :: Parser Integer natural :: Parser Integer
natural = Token.natural lexer -- parses a natural number natural = Token.natural lexer -- parses a natural number
semi :: Parser String semi :: Parser String
semi = Token.semi lexer -- parses a semicolonü semi = Token.semi lexer -- parses a semicolon
whiteSpace :: Parser () whiteSpace :: Parser ()
whiteSpace = Token.whiteSpace lexer -- parses whitespace whiteSpace = Token.whiteSpace lexer -- parses whitespace
...@@ -76,11 +76,8 @@ petriNet = do ...@@ -76,11 +76,8 @@ petriNet = do
ps <- many place ps <- many place
ts <- many transition ts <- many transition
let places = [ p | (p,_) <- ps ] let places = [ p | (p,_) <- ps ]
transitions = [ t | (t,_,_) <- ts ]
initial = [ (p,i) | (p,Just i) <- ps ] initial = [ (p,i) | (p,Just i) <- ps ]
arcs = [ (i,t,w) | (t,is,_) <- ts, (i,w) <- is ] ++ return $ makePetriNetWithTrans "" places ts initial
[ (t,o,w) | (t,_,os) <- ts, (o,w) <- os ]
return $ makePetriNet "" places transitions arcs initial
parseContent :: Parser (PetriNet,[Property]) parseContent :: Parser (PetriNet,[Property])
parseContent = do parseContent = do
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
module PetriNet module PetriNet
(PetriNet,showNetName,places,transitions,initial, (PetriNet,showNetName,places,transitions,initial,
pre,lpre,post,lpost,initials, pre,lpre,post,lpost,initials,
makePetriNet) makePetriNet,makePetriNetWithTrans)
where where
import qualified Data.Map as M import qualified Data.Map as M
...@@ -68,3 +68,11 @@ makePetriNet name places transitions arcs initial = ...@@ -68,3 +68,11 @@ makePetriNet name places transitions arcs initial =
in m'' in m''
addArc (lNew,rNew) (lOld,rOld) = (lNew ++ lOld,rNew ++ rOld) addArc (lNew,rNew) (lOld,rOld) = (lNew ++ lOld,rNew ++ rOld)
makePetriNetWithTrans :: String -> [String] ->
[(String, [(String, Integer)], [(String, Integer)])] ->
[(String, Integer)] -> PetriNet
makePetriNetWithTrans name places ts initial =
let transitions = [ t | (t,_,_) <- ts ]
arcs = [ (i,t,w) | (t,is,_) <- ts, (i,w) <- is ] ++
[ (t,o,w) | (t,_,os) <- ts, (o,w) <- os ]
in makePetriNet name places transitions arcs initial
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment