Starting from 2021-07-01, all LRZ GitLab users will be required to explicitly accept the GitLab Terms of Service. Please see the detailed information at https://doku.lrz.de/display/PUBLIC/GitLab and make sure that your projects conform to the requirements.

Commit c4a94af6 authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Combined Petri net and property parser

parent a786fec0
...@@ -113,7 +113,6 @@ petriNet = do ...@@ -113,7 +113,6 @@ petriNet = do
reserved "net" reserved "net"
name <- option "" ident name <- option "" ident
statements <- braces (many statement) statements <- braces (many statement)
eof
let (p,t,a,i) = foldl splitStatement ([],[],[],[]) statements let (p,t,a,i) = foldl splitStatement ([],[],[],[]) statements
return $ makePetriNet name p t a i return $ makePetriNet name p t a i
where where
...@@ -128,14 +127,13 @@ preFactor = (reservedOp "-" *> return (-1)) <|> ...@@ -128,14 +127,13 @@ preFactor = (reservedOp "-" *> return (-1)) <|>
(reservedOp "+" *> return 1) (reservedOp "+" *> return 1)
linAtom :: Integer -> Parser u LinAtom linAtom :: Integer -> Parser u LinAtom
linAtom fac = ( natural >>= \lhs -> linAtom fac = ( integer >>= \lhs ->
option (Const (fac*lhs)) option (Const (fac*lhs)) $ Var (fac*lhs) <$> (reservedOp "*" *> ident)
((Var (fac*lhs)) <$> (reservedOp "*" *> ident)) ) <|> Var fac <$> ident
) <|> ((Var fac) <$> ident)
term :: Parser u Term term :: Parser u Term
term = Term <$> ((:) <$> (option 1 preFactor >>= linAtom) <*> term = Term <$> ((:) <$> (option 1 preFactor >>= linAtom) <*>
(many (preFactor >>= linAtom))) many (preFactor >>= linAtom))
parseOp :: Parser u Op parseOp :: Parser u Op
parseOp = (reservedOp "<" *> return Lt) <|> parseOp = (reservedOp "<" *> return Lt) <|>
...@@ -183,16 +181,21 @@ property = do ...@@ -183,16 +181,21 @@ property = do
pformulas <- braces formula pformulas <- braces formula
return $ Property name ptype pformulas return $ Property name ptype pformulas
parseContent :: Parser u Property parseContent :: Parser u (PetriNet,[Property])
parseContent = whiteSpace *> property parseContent = do
whiteSpace
net <- petriNet
properties <- many property
eof
return (net, properties)
parseString :: String -> Property parseString :: String -> (PetriNet,[Property])
parseString str = parseString str =
case parse parseContent "" str of case parse parseContent "" str of
Left e -> error $ show e Left e -> error $ show e
Right r -> r Right r -> r
parseFile :: String -> IO Property parseFile :: String -> IO (PetriNet,[Property])
parseFile file = do parseFile file = do
contents <- readFile file contents <- readFile file
case parse parseContent file contents of case parse parseContent file contents of
......
Markdown is supported
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