Currently job artifacts in CI/CD pipelines on LRZ GitLab never expire. Starting from Wed 26.1.2022 the default expiration time will be 30 days (GitLab default). Currently existing artifacts in already completed jobs will not be affected by the change. The latest artifacts for all jobs in the latest successful pipelines will be kept. More information: https://gitlab.lrz.de/help/user/admin_area/settings/continuous_integration.html#default-artifacts-expiration

Commit a17f6534 authored by Philipp J. Meyer's avatar Philipp J. Meyer
Browse files

Added possibility to specify fixed traps and siphons

parent 9cd19661
...@@ -158,14 +158,14 @@ transformNet (net, props) TerminationByReachability = ...@@ -158,14 +158,14 @@ transformNet (net, props) TerminationByReachability =
[(t, (pre', post')), (primeTransition t, (pre'', post''))] [(t, (pre', post')), (primeTransition t, (pre'', post''))]
ts = (switch, ([(m1,1)], [(m2,1)])) : ts = (switch, ([(m1,1)], [(m2,1)])) :
concatMap transformTransition (transitions net) concatMap transformTransition (transitions net)
gs = ghostTransitions net
prop = Property "termination by reachability" $ Safety $ prop = Property "termination by reachability" $ Safety $
foldl (:&:) (LinearInequation (Var sigma) Ge (Const 1)) foldl (:&:) (LinearInequation (Var sigma) Ge (Const 1))
(map (\p -> LinearInequation (map (\p -> LinearInequation
(Var (primePlace p) :-: Var p) Ge (Const 0)) (Var (primePlace p) :-: Var p) Ge (Const 0))
(places net)) (places net))
-- TODO: map existing liveness properties -- TODO: map existing liveness properties
in (makePetriNetWithTrans (name net) ps ts is gs, prop : props) in (makePetriNetWithTrans (name net) ps ts is
(ghostTransitions net) (fixedTraps net) (fixedSiphons net), prop : props)
transformNet (net, props) ValidateIdentifiers = transformNet (net, props) ValidateIdentifiers =
(renamePetriNetPlacesAndTransitions validateId net, (renamePetriNetPlacesAndTransitions validateId net,
map (renameProperty validateId) props) map (renameProperty validateId) props)
...@@ -237,7 +237,7 @@ checkProperty net p = do ...@@ -237,7 +237,7 @@ checkProperty net p = do
checkSafetyProperty :: PetriNet -> checkSafetyProperty :: PetriNet ->
Formula Place -> OptIO PropResult Formula Place -> OptIO PropResult
checkSafetyProperty net f = do checkSafetyProperty net f = do
r <- checkSafetyProperty' net f [] r <- checkSafetyProperty' net f (fixedTraps net)
case r of case r of
(Nothing, traps) -> do (Nothing, traps) -> do
invariant <- opt optInvariant invariant <- opt optInvariant
...@@ -447,7 +447,7 @@ checkConstraintProperty net cp = ...@@ -447,7 +447,7 @@ checkConstraintProperty net cp =
checkUniqueTerminalMarkingProperty :: PetriNet -> OptIO PropResult checkUniqueTerminalMarkingProperty :: PetriNet -> OptIO PropResult
checkUniqueTerminalMarkingProperty net = do checkUniqueTerminalMarkingProperty net = do
r <- checkUniqueTerminalMarkingProperty' net [] [] r <- checkUniqueTerminalMarkingProperty' net (fixedTraps net) (fixedSiphons net)
case r of case r of
(Nothing, _, _) -> return Satisfied (Nothing, _, _) -> return Satisfied
(Just _, _, _) -> return Unknown (Just _, _, _) -> return Unknown
......
...@@ -57,7 +57,7 @@ net = do ...@@ -57,7 +57,7 @@ net = do
initial <- option [] markingList initial <- option [] markingList
_ <- semi _ <- semi
ts <- many1 transition ts <- many1 transition
return $ makePetriNetWithTransFromStrings "" ps ts initial [] return $ makePetriNetWithTransFromStrings "" ps ts initial [] [] []
placeLists :: Parser [String] placeLists :: Parser [String]
placeLists = placeLists =
......
...@@ -58,7 +58,7 @@ net = do ...@@ -58,7 +58,7 @@ net = do
reserved "init" reserved "init"
(is,initTrans) <- initial (is,initTrans) <- initial
return $ makePetriNetWithTransFromStrings "" ps (initTrans ++ ts) is return $ makePetriNetWithTransFromStrings "" ps (initTrans ++ ts) is
(map fst initTrans) (map fst initTrans) [] []
prop :: Parser Property prop :: Parser Property
prop = do prop = do
......
...@@ -81,6 +81,12 @@ initial = reserved "initial" *> singleOrList (do ...@@ -81,6 +81,12 @@ initial = reserved "initial" *> singleOrList (do
return (n,i) return (n,i)
) )
trap :: Parser [String]
trap = reserved "trap" *> identList
siphon :: Parser [String]
siphon = reserved "siphon" *> identList
arc :: Parser [(String,String,Integer)] arc :: Parser [(String,String,Integer)]
arc = do arc = do
lhs <- identList lhs <- identList
...@@ -101,13 +107,16 @@ arcs = do ...@@ -101,13 +107,16 @@ arcs = do
return $ concat as return $ concat as
data Statement = Places [String] | Transitions [String] | data Statement = Places [String] | Transitions [String] |
Arcs [(String,String,Integer)] | Initial [(String,Integer)] Arcs [(String,String,Integer)] | Initial [(String,Integer)] |
TrapStatement [String] | SiphonStatement [String]
statement :: Parser Statement statement :: Parser Statement
statement = Places <$> places <|> statement = Places <$> places <|>
Transitions <$> transitions <|> Transitions <$> transitions <|>
Arcs <$> arcs <|> Arcs <$> arcs <|>
Initial <$> initial Initial <$> initial <|>
TrapStatement <$> trap <|>
SiphonStatement <$> siphon
petriNet :: Parser PetriNet petriNet :: Parser PetriNet
petriNet = do petriNet = do
...@@ -115,14 +124,16 @@ petriNet = do ...@@ -115,14 +124,16 @@ petriNet = do
reserved "net" reserved "net"
name <- option "" ident name <- option "" ident
statements <- braces (many statement) statements <- braces (many statement)
let (p,t,a,i) = foldl splitStatement ([],[],[],[]) statements let (p,t,a,i,traps,siphons) = foldl splitStatement ([],[],[],[],[],[]) statements
return $ makePetriNetFromStrings name p t a i [] return $ makePetriNetFromStrings name p t a i [] traps siphons
where where
splitStatement (ps,ts,as,is) stmnt = case stmnt of splitStatement (ps,ts,as,is,traps,siphons) stmnt = case stmnt of
Places p -> (p ++ ps,ts,as,is) Places p -> (p ++ ps,ts,as,is,traps,siphons)
Transitions t -> (ps,t ++ ts,as,is) Transitions t -> (ps,t ++ ts,as,is,traps,siphons)
Arcs a -> (ps,ts,a ++ as,is) Arcs a -> (ps,ts,a ++ as,is,traps,siphons)
Initial i -> (ps,ts,as,i ++ is) Initial i -> (ps,ts,as,i ++ is,traps,siphons)
TrapStatement trap -> (ps,ts,as,is,trap:traps,siphons)
SiphonStatement siphon -> (ps,ts,as,is,traps,siphon:siphons)
binary :: String -> (a -> a -> a) -> Assoc -> Operator String () Identity a binary :: String -> (a -> a -> a) -> Assoc -> Operator String () Identity a
binary name fun = Infix ( reservedOp name *> return fun ) binary name fun = Infix ( reservedOp name *> return fun )
......
...@@ -77,7 +77,7 @@ petriNet = do ...@@ -77,7 +77,7 @@ petriNet = do
ts <- many transition ts <- many transition
let places = [ p | (p,_) <- ps ] let places = [ p | (p,_) <- ps ]
initial = [ (p,i) | (p,Just i) <- ps ] initial = [ (p,i) | (p,Just i) <- ps ]
return $ makePetriNetWithTransFromStrings "" places ts initial [] return $ makePetriNetWithTransFromStrings "" places ts initial [] [] []
parseContent :: Parser (PetriNet,[Property]) parseContent :: Parser (PetriNet,[Property])
parseContent = do parseContent = do
......
...@@ -7,7 +7,7 @@ module PetriNet ...@@ -7,7 +7,7 @@ module PetriNet
renamePlace,renameTransition,renamePetriNetPlacesAndTransitions, renamePlace,renameTransition,renamePetriNetPlacesAndTransitions,
name,showNetName,places,transitions, name,showNetName,places,transitions,
initialMarking,initial,initials,linitials, initialMarking,initial,initials,linitials,
pre,lpre,post,lpost,mpre,mpost,context,ghostTransitions, pre,lpre,post,lpost,mpre,mpost,context,ghostTransitions,fixedTraps,fixedSiphons,
makePetriNet,makePetriNetWithTrans, makePetriNet,makePetriNetWithTrans,
makePetriNetFromStrings,makePetriNetWithTransFromStrings,Trap,Siphon,Cut, makePetriNetFromStrings,makePetriNetWithTransFromStrings,Trap,Siphon,Cut,
constructCut,SimpleCut,Invariant(..)) constructCut,SimpleCut,Invariant(..))
...@@ -79,7 +79,9 @@ data PetriNet = PetriNet { ...@@ -79,7 +79,9 @@ data PetriNet = PetriNet {
adjacencyP :: M.Map Place ([(Transition,Integer)], [(Transition,Integer)]), adjacencyP :: M.Map Place ([(Transition,Integer)], [(Transition,Integer)]),
adjacencyT :: M.Map Transition ([(Place,Integer)], [(Place,Integer)]), adjacencyT :: M.Map Transition ([(Place,Integer)], [(Place,Integer)]),
initialMarking :: Marking, initialMarking :: Marking,
ghostTransitions :: [Transition] ghostTransitions :: [Transition],
fixedTraps :: [Trap],
fixedSiphons :: [Siphon]
} }
initial :: PetriNet -> Place -> Integer initial :: PetriNet -> Place -> Integer
...@@ -104,7 +106,9 @@ instance Show PetriNet where ...@@ -104,7 +106,9 @@ instance Show PetriNet where
"\nTransition arcs:\n" ++ unlines "\nTransition arcs:\n" ++ unlines
(map showContext (M.toList (adjacencyT net))) ++ (map showContext (M.toList (adjacencyT net))) ++
"\nInitial: " ++ show (initialMarking net) ++ "\nInitial: " ++ show (initialMarking net) ++
"\nGhost transitions: " ++ show (ghostTransitions net) "\nGhost transitions: " ++ show (ghostTransitions net) ++
"\nFixed traps: " ++ show (fixedTraps net) ++
"\nFixed siphons: " ++ show (fixedSiphons net)
where showContext (s,(l,r)) = where showContext (s,(l,r)) =
show l ++ " -> " ++ show s ++ " -> " ++ show r show l ++ " -> " ++ show s ++ " -> " ++ show r
...@@ -143,7 +147,9 @@ renamePetriNetPlacesAndTransitions f net = ...@@ -143,7 +147,9 @@ renamePetriNetPlacesAndTransitions f net =
adjacencyT net, adjacencyT net,
initialMarking = emap (renamePlace f) $ initialMarking net, initialMarking = emap (renamePlace f) $ initialMarking net,
ghostTransitions = ghostTransitions =
listSet $ map (renameTransition f) $ ghostTransitions net listSet $ map (renameTransition f) $ ghostTransitions net,
fixedTraps = map (map $ renamePlace f) $ fixedTraps net,
fixedSiphons = map (map $ renamePlace f) $ fixedSiphons net
} }
where mapAdjacency f g m = M.mapKeys f (M.map (mapContext g) m) where mapAdjacency f g m = M.mapKeys f (M.map (mapContext g) m)
mapContext f (pre, post) = mapContext f (pre, post) =
...@@ -151,8 +157,8 @@ renamePetriNetPlacesAndTransitions f net = ...@@ -151,8 +157,8 @@ renamePetriNetPlacesAndTransitions f net =
makePetriNet :: String -> [Place] -> [Transition] -> makePetriNet :: String -> [Place] -> [Transition] ->
[Either (Transition, Place, Integer) (Place, Transition, Integer)] -> [Either (Transition, Place, Integer) (Place, Transition, Integer)] ->
[(Place, Integer)] -> [Transition] -> PetriNet [(Place, Integer)] -> [Transition] -> [Trap] -> [Siphon] -> PetriNet
makePetriNet name places transitions arcs initial gs = makePetriNet name places transitions arcs initial gs fixedTraps fixedSiphons =
PetriNet { PetriNet {
name = name, name = name,
places = listSet places, places = listSet places,
...@@ -160,7 +166,9 @@ makePetriNet name places transitions arcs initial gs = ...@@ -160,7 +166,9 @@ makePetriNet name places transitions arcs initial gs =
adjacencyP = M.map (listMap *** listMap) adP, adjacencyP = M.map (listMap *** listMap) adP,
adjacencyT = M.map (listMap *** listMap)adT, adjacencyT = M.map (listMap *** listMap)adT,
initialMarking = buildVector initial, initialMarking = buildVector initial,
ghostTransitions = listSet gs ghostTransitions = listSet gs,
fixedTraps = map listSet fixedTraps,
fixedSiphons = map listSet fixedSiphons
} }
where where
(adP, adT) = foldl buildMaps (M.empty, M.empty) arcs (adP, adT) = foldl buildMaps (M.empty, M.empty) arcs
...@@ -182,8 +190,8 @@ makePetriNet name places transitions arcs initial gs = ...@@ -182,8 +190,8 @@ makePetriNet name places transitions arcs initial gs =
makePetriNetFromStrings :: String -> [String] -> [String] -> makePetriNetFromStrings :: String -> [String] -> [String] ->
[(String, String, Integer)] -> [(String, String, Integer)] ->
[(String, Integer)] -> [String] -> PetriNet [(String, Integer)] -> [String] -> [[String]] -> [[String]] -> PetriNet
makePetriNetFromStrings name places transitions arcs initial gs = makePetriNetFromStrings name places transitions arcs initial gs fixedTraps fixedSiphons =
makePetriNet makePetriNet
name name
(map Place (S.toAscList placeSet)) (map Place (S.toAscList placeSet))
...@@ -191,6 +199,8 @@ makePetriNetFromStrings name places transitions arcs initial gs = ...@@ -191,6 +199,8 @@ makePetriNetFromStrings name places transitions arcs initial gs =
(map toEitherArc arcs) (map toEitherArc arcs)
(map (first Place) initial) (map (first Place) initial)
(map Transition gs) (map Transition gs)
(map (map Place) fixedTraps)
(map (map Place) fixedSiphons)
where where
placeSet = S.fromList places placeSet = S.fromList places
transitionSet = S.fromList transitions transitionSet = S.fromList transitions
...@@ -215,23 +225,25 @@ makePetriNetFromStrings name places transitions arcs initial gs = ...@@ -215,23 +225,25 @@ makePetriNetFromStrings name places transitions arcs initial gs =
makePetriNetWithTrans :: String -> [Place] -> makePetriNetWithTrans :: String -> [Place] ->
[(Transition, ([(Place, Integer)], [(Place, Integer)]))] -> [(Transition, ([(Place, Integer)], [(Place, Integer)]))] ->
[(Place, Integer)] -> [Transition] -> PetriNet [(Place, Integer)] -> [Transition] -> [Trap] -> [Siphon] ->PetriNet
makePetriNetWithTrans name places ts = makePetriNetWithTrans name places ts fixedTraps fixedSiphons =
makePetriNet name places (map fst ts) arcs makePetriNet name places (map fst ts) arcs fixedTraps fixedSiphons
where where
arcs = [ Right (p,t,w) | (t,(is,_)) <- ts, (p,w) <- is ] ++ arcs = [ Right (p,t,w) | (t,(is,_)) <- ts, (p,w) <- is ] ++
[ Left (t,p,w) | (t,(_,os)) <- ts, (p,w) <- os ] [ Left (t,p,w) | (t,(_,os)) <- ts, (p,w) <- os ]
makePetriNetWithTransFromStrings :: String -> [String] -> makePetriNetWithTransFromStrings :: String -> [String] ->
[(String, ([(String, Integer)], [(String, Integer)]))] -> [(String, ([(String, Integer)], [(String, Integer)]))] ->
[(String, Integer)] -> [String] -> PetriNet [(String, Integer)] -> [String] -> [[String]] -> [[String]] -> PetriNet
makePetriNetWithTransFromStrings name places arcs initial gs = makePetriNetWithTransFromStrings name places arcs initial gs fixedTraps fixedSiphons =
makePetriNetWithTrans makePetriNetWithTrans
name name
(map Place places) (map Place places)
(map toTArc arcs) (map toTArc arcs)
(map (first Place) initial) (map (first Place) initial)
(map Transition gs) (map Transition gs)
(map (map Place) fixedTraps)
(map (map Place) fixedSiphons)
where where
toTArc (t, (is, os)) = toTArc (t, (is, os)) =
(Transition t, (map (first Place) is, map (first Place) os)) (Transition t, (map (first Place) is, map (first Place) os))
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