Commit ee45be29 authored by Philipp Meyer's avatar Philipp Meyer

Added transformation to validate identifiers for lola

parent 4f283fdf
...@@ -8,6 +8,7 @@ import System.IO ...@@ -8,6 +8,7 @@ import System.IO
import System.Console.GetOpt import System.Console.GetOpt
import Control.Monad import Control.Monad
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Arrow (first)
import Data.List (partition) import Data.List (partition)
import Parser import Parser
...@@ -25,7 +26,8 @@ import Solver.SComponent ...@@ -25,7 +26,8 @@ import Solver.SComponent
data InputFormat = PNET | LOLA | TPN deriving (Show,Read) data InputFormat = PNET | LOLA | TPN deriving (Show,Read)
data NetTransformation = TerminationToReachability data NetTransformation = TerminationByReachability
| ValidateIdentifiers
data ImplicitProperty = Termination data ImplicitProperty = Termination
| NoDeadlock | NoDeadlockUnlessFinal | NoDeadlock | NoDeadlockUnlessFinal
...@@ -68,9 +70,15 @@ options = ...@@ -68,9 +70,15 @@ options =
(NoArg (\opt -> Right opt { inputFormat = TPN })) (NoArg (\opt -> Right opt { inputFormat = TPN }))
"Use the tpn input format" "Use the tpn input format"
, Option "" ["validate-identifiers"]
(NoArg (\opt -> Right opt {
optTransformations = ValidateIdentifiers : optTransformations opt
}))
"Make identifiers valid for lola"
, Option "" ["termination-by-reachability"] , Option "" ["termination-by-reachability"]
(NoArg (\opt -> Right opt { (NoArg (\opt -> Right opt {
optTransformations = TerminationToReachability : optTransformations opt optTransformations = TerminationByReachability : optTransformations opt
})) }))
"Prove termination by reducing it to reachability" "Prove termination by reducing it to reachability"
...@@ -191,20 +199,19 @@ placeOp op (p,w) = Atom $ LinIneq (Var p) op (Const w) ...@@ -191,20 +199,19 @@ placeOp op (p,w) = Atom $ LinIneq (Var p) op (Const w)
transformNet :: (PetriNet, [Property]) -> NetTransformation -> transformNet :: (PetriNet, [Property]) -> NetTransformation ->
(PetriNet, [Property]) (PetriNet, [Property])
transformNet (net, props) TerminationToReachability = transformNet (net, props) TerminationByReachability =
let prime = ('\'':) let prime = ('\'':)
primeFst (p,x) = (prime p, x)
ps = ["'sigma", "'m1", "'m2"] ++ ps = ["'sigma", "'m1", "'m2"] ++
places net ++ map prime (places net) places net ++ map prime (places net)
is = [("'m1", 1)] ++ is = [("'m1", 1)] ++
initials net ++ map primeFst (initials net) initials net ++ map (first prime) (initials net)
ts = ("'switch", [("'m1",1)], [("'m2",1)]) : ts = ("'switch", [("'m1",1)], [("'m2",1)]) :
concatMap (\t -> concatMap (\t ->
let (preT, postT) = context net t let (preT, postT) = context net t
pre' = [("'m1",1)] ++ preT ++ map primeFst preT pre' = [("'m1",1)] ++ preT ++ map (first prime) preT
post' = [("'m1",1)] ++ postT ++ map primeFst postT post' = [("'m1",1)] ++ postT ++ map (first prime) postT
pre'' = ("'m2",1) : map primeFst preT pre'' = ("'m2",1) : map (first prime) preT
post'' = [("'m2",1), ("'sigma",1)] ++ map primeFst postT post'' = [("'m2",1), ("'sigma",1)] ++ map (first prime) postT
in [(t, pre', post'), (prime t, pre'', post'')] in [(t, pre', post'), (prime t, pre'', post'')]
) )
(transitions net) (transitions net)
...@@ -212,7 +219,17 @@ transformNet (net, props) TerminationToReachability = ...@@ -212,7 +219,17 @@ transformNet (net, props) TerminationToReachability =
foldl (:&:) (Atom (LinIneq (Var "'sigma") Ge (Const 1))) foldl (:&:) (Atom (LinIneq (Var "'sigma") Ge (Const 1)))
(map (\p -> Atom (LinIneq (Var (prime p)) Ge (Var p))) (map (\p -> Atom (LinIneq (Var (prime p)) Ge (Var p)))
(places net)) (places net))
-- TODO: map existing liveness properties
in (makePetriNetWithTrans (name net) ps ts is, prop : props) in (makePetriNetWithTrans (name net) ps ts is, prop : props)
transformNet (net, props) ValidateIdentifiers =
let validate = map (\c -> if c `elem` ",;:(){}\t \n\r" then '_' else c)
ps = map validate $ places net
ts = map validate $ transitions net
is = map (first validate) $ initials net
as = map (\(a,b,x) -> (validate a, validate b, x)) $ arcs net
net' = makePetriNet (name net) ps ts as is
props' = map (rename validate) props
in (net', props')
makeImplicitProperty :: PetriNet -> ImplicitProperty -> Property makeImplicitProperty :: PetriNet -> ImplicitProperty -> Property
makeImplicitProperty _ Termination = makeImplicitProperty _ Termination =
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
module PetriNet module PetriNet
(PetriNet,name,showNetName,places,transitions,initial, (PetriNet,name,showNetName,places,transitions,initial,
pre,lpre,post,lpost,initials,context, pre,lpre,post,lpost,initials,context,arcs,
makePetriNet,makePetriNetWithTrans) makePetriNet,makePetriNetWithTrans)
where where
...@@ -19,6 +19,10 @@ data PetriNet = PetriNet { ...@@ -19,6 +19,10 @@ data PetriNet = PetriNet {
initial :: PetriNet -> String -> Integer initial :: PetriNet -> String -> Integer
initial net p = M.findWithDefault 0 p (initMap net) initial net p = M.findWithDefault 0 p (initMap net)
arcs :: PetriNet -> [(String, String, Integer)]
arcs net = concatMap (\(a,(_,bs)) -> map (\(b,w) -> (a,b,w)) bs)
(M.toList (adjacency net))
context :: PetriNet -> String -> ([(String, Integer)], [(String, Integer)]) context :: PetriNet -> String -> ([(String, Integer)], [(String, Integer)])
context net x = M.findWithDefault ([],[]) x (adjacency net) context net x = M.findWithDefault ([],[]) x (adjacency net)
......
...@@ -3,6 +3,7 @@ ...@@ -3,6 +3,7 @@
module Property module Property
(Property(..), (Property(..),
showPropertyName, showPropertyName,
rename,
PropertyType(..), PropertyType(..),
Formula(..), Formula(..),
LinearInequation(..), LinearInequation(..),
...@@ -25,6 +26,14 @@ instance Show Term where ...@@ -25,6 +26,14 @@ instance Show Term where
show (t :-: u) = "(" ++ show t ++ " - " ++ show u ++ ")" show (t :-: u) = "(" ++ show t ++ " - " ++ show u ++ ")"
show (t :*: u) = show t ++ " * " ++ show u show (t :*: u) = show t ++ " * " ++ show u
renameTerm :: (String -> String) -> Term -> Term
renameTerm f (Var x) = Var (f x)
renameTerm _ (Const c) = Const c
renameTerm f (Minus t) = Minus (renameTerm f t)
renameTerm f (t :+: u) = renameTerm f t :+: renameTerm f u
renameTerm f (t :-: u) = renameTerm f t :-: renameTerm f u
renameTerm f (t :*: u) = renameTerm f t :*: renameTerm f u
data Op = Gt | Ge | Eq | Ne | Le | Lt data Op = Gt | Ge | Eq | Ne | Le | Lt
instance Show Op where instance Show Op where
...@@ -41,6 +50,10 @@ data LinearInequation = LinIneq Term Op Term ...@@ -41,6 +50,10 @@ data LinearInequation = LinIneq Term Op Term
instance Show LinearInequation where instance Show LinearInequation where
show (LinIneq lhs op rhs) = show lhs ++ " " ++ show op ++ " " ++ show rhs show (LinIneq lhs op rhs) = show lhs ++ " " ++ show op ++ " " ++ show rhs
renameLinIneq :: (String -> String) -> LinearInequation -> LinearInequation
renameLinIneq f (LinIneq lhs op rhs) =
LinIneq (renameTerm f lhs) op (renameTerm f rhs)
data Formula = FTrue | FFalse data Formula = FTrue | FFalse
| Atom LinearInequation | Atom LinearInequation
| Neg Formula | Neg Formula
...@@ -58,6 +71,14 @@ instance Show Formula where ...@@ -58,6 +71,14 @@ instance Show Formula where
show (p :&: q) = "(" ++ show p ++ " ∧ " ++ show q ++ ")" show (p :&: q) = "(" ++ show p ++ " ∧ " ++ show q ++ ")"
show (p :|: q) = "(" ++ show p ++ " ∨ " ++ show q ++ ")" show (p :|: q) = "(" ++ show p ++ " ∨ " ++ show q ++ ")"
renameFormula :: (String -> String) -> Formula -> Formula
renameFormula _ FTrue = FTrue
renameFormula _ FFalse = FFalse
renameFormula f (Atom a) = Atom (renameLinIneq f a)
renameFormula f (Neg p) = Neg (renameFormula f p)
renameFormula f (p :&: q) = renameFormula f p :&: renameFormula f q
renameFormula f (p :|: q) = renameFormula f p :|: renameFormula f q
data PropertyType = Safety | Liveness data PropertyType = Safety | Liveness
instance Show PropertyType where instance Show PropertyType where
...@@ -74,6 +95,9 @@ instance Show Property where ...@@ -74,6 +95,9 @@ instance Show Property where
show p = show p =
showPropertyName p ++ " { " ++ show (pformula p) ++ " }" showPropertyName p ++ " { " ++ show (pformula p) ++ " }"
rename :: (String -> String) -> Property -> Property
rename f (Property pn pt pf) = Property pn pt (renameFormula f pf)
showPropertyName :: Property -> String showPropertyName :: Property -> String
showPropertyName p = show (ptype p) ++ " property" ++ showPropertyName p = show (ptype p) ++ " property" ++
(if null (pname p) then "" else " " ++ show (pname p)) (if null (pname p) then "" else " " ++ show (pname p))
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