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 f0373636 authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Added ghost transitions and added filter for zero entries

parent 769f3e09
......@@ -224,35 +224,42 @@ transformNet (net, props) TerminationByReachability =
places net ++ map prime (places net)
is = [("'m1", 1)] ++
initials net ++ map (first prime) (initials net)
transformTransition t =
let (preT, postT) = context net t
pre' = [("'m1",1)] ++ preT ++ map (first prime) preT
post' = [("'m1",1)] ++ postT ++ map (first prime) postT
pre'' = ("'m2",1) : map (first prime) preT
post'' = [("'m2",1), ("'sigma",1)] ++ map (first prime) postT
in if t `elem` ghostTransitions net then
[(t, pre', post')]
else
[(t, pre', post'), (prime t, pre'', post'')]
ts = ("'switch", [("'m1",1)], [("'m2",1)]) :
concatMap (\t ->
let (preT, postT) = context net t
pre' = [("'m1",1)] ++ preT ++ map (first prime) preT
post' = [("'m1",1)] ++ postT ++ map (first prime) postT
pre'' = ("'m2",1) : map (first prime) preT
post'' = [("'m2",1), ("'sigma",1)] ++ map (first prime) postT
in [(t, pre', post'), (prime t, pre'', post'')]
)
(transitions net)
concatMap transformTransition (transitions net)
gs = ghostTransitions net
prop = Property "termination by reachability" Safety $
foldl (:&:) (Atom (LinIneq (Var "'sigma") Ge (Const 1)))
(map (\p -> Atom (LinIneq
(Var (prime p) :-: Var p) Ge (Const 0)))
(places net))
-- TODO: map existing liveness properties
in (makePetriNetWithTrans (name net) ps ts is, prop : props)
in (makePetriNetWithTrans (name net) ps ts is gs, prop : props)
transformNet (net, props) ValidateIdentifiers =
let ps = map validateId $ places net
ts = map validateId $ transitions net
is = map (first validateId) $ initials net
as = map (\(a,b,x) -> (validateId a, validateId b, x)) $ arcs net
net' = makePetriNet (name net) ps ts as is
gs = map validateId $ ghostTransitions net
net' = makePetriNet (name net) ps ts as is gs
props' = map (rename validateId) props
in (net', props')
makeImplicitProperty :: PetriNet -> ImplicitProperty -> Property
makeImplicitProperty _ Termination =
Property "termination" Liveness FTrue
makeImplicitProperty net Termination =
Property "termination" Liveness $
foldl (:&:) FTrue
(map (\t -> Atom (LinIneq (Var t) Eq (Const 0)))
(ghostTransitions net))
makeImplicitProperty net ProperTermination =
let (finals, nonfinals) = partition (null . lpost net) (places net)
in Property "proper termination" Safety
......
......@@ -57,7 +57,7 @@ net = do
initial <- option [] markingList
_ <- semi
ts <- many1 transition
return $ makePetriNetWithTrans "" ps ts initial
return $ makePetriNetWithTrans "" ps ts initial []
placeLists :: Parser [String]
placeLists =
......
......@@ -58,6 +58,7 @@ net = do
reserved "init"
(is,initTrans) <- initial
return $ makePetriNetWithTrans "" ps (initTrans ++ ts) is
[t | (t,_,_) <- initTrans]
prop :: Parser Property
prop = do
......@@ -85,8 +86,7 @@ transition = do
lhs <- commaSep ((,) <$> identifier <* reservedOp ">=" <*> integer)
reservedOp "->"
rhs <- commaSep transitionAssignment
let rhs' = filter ((/=0) . snd) $
map (\xs -> (fst (head xs), sum (map snd xs))) $
let rhs' = map (\xs -> (fst (head xs), sum (map snd xs))) $
groupBy ((==) `on` fst) $
sortBy (comparing fst) $
lhs ++ rhs
......@@ -112,7 +112,7 @@ initial = do
let covered = [x | (x,_,True) <- xs]
let initTrans = map (\(i,x) -> ("'init" ++ show i, [], [(x,1)]))
([(1::Integer)..] `zip` covered)
return (filter ((/=0) . snd) inits, initTrans)
return (inits, initTrans)
initState :: Parser (String, Integer, Bool)
initState = do
......
......@@ -116,7 +116,7 @@ petriNet = do
name <- option "" ident
statements <- braces (many statement)
let (p,t,a,i) = foldl splitStatement ([],[],[],[]) statements
return $ makePetriNet name p t a i
return $ makePetriNet name p t a i []
where
splitStatement (ps,ts,as,is) stmnt = case stmnt of
Places p -> (p ++ ps,ts,as,is)
......
......@@ -77,7 +77,7 @@ petriNet = do
ts <- many transition
let places = [ p | (p,_) <- ps ]
initial = [ (p,i) | (p,Just i) <- ps ]
return $ makePetriNetWithTrans "" places ts initial
return $ makePetriNetWithTrans "" places ts initial []
parseContent :: Parser (PetriNet,[Property])
parseContent = do
......
......@@ -2,7 +2,7 @@
module PetriNet
(PetriNet,name,showNetName,places,transitions,initial,
pre,lpre,post,lpost,initials,context,arcs,
pre,lpre,post,lpost,initials,context,arcs,ghostTransitions,
makePetriNet,makePetriNetWithTrans)
where
......@@ -13,7 +13,8 @@ data PetriNet = PetriNet {
places :: [String],
transitions :: [String],
adjacency :: M.Map String ([(String,Integer)], [(String,Integer)]),
initMap :: M.Map String Integer
initMap :: M.Map String Integer,
ghostTransitions :: [String]
}
initial :: PetriNet -> String -> Integer
......@@ -56,15 +57,17 @@ instance Show PetriNet where
"Initial: " ++ unwords
(map (\(n,i) -> n ++
(if i /= 1 then "[" ++ show i ++ "]" else []))
(M.toList (initMap net)))
(M.toList (initMap net))) ++
"\nGhost transitions: " ++ unwords (ghostTransitions net)
makePetriNet :: String -> [String] -> [String] ->
[(String, String, Integer)] -> [(String, Integer)] -> PetriNet
makePetriNet name places transitions arcs initial =
let adjacency = foldl buildMap M.empty arcs
initMap = M.fromList initial
[(String, String, Integer)] -> [(String, Integer)] -> [String] -> PetriNet
makePetriNet name places transitions arcs initial gs =
let adjacency = foldl buildMap M.empty $ filter (\(_,_,w) -> w /= 0) arcs
initMap = M.fromList $ filter ((/=0) . snd) initial
in PetriNet { name=name, places=places, transitions=transitions,
adjacency=adjacency, initMap=initMap }
adjacency=adjacency, initMap=initMap,
ghostTransitions=gs }
where
buildMap m (l,r,w) =
let m' = M.insertWith addArc l ([],[(r,w)]) m
......@@ -74,9 +77,9 @@ makePetriNet name places transitions arcs initial =
makePetriNetWithTrans :: String -> [String] ->
[(String, [(String, Integer)], [(String, Integer)])] ->
[(String, Integer)] -> PetriNet
makePetriNetWithTrans name places ts initial =
[(String, Integer)] -> [String] -> PetriNet
makePetriNetWithTrans name places ts initial gs =
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
in makePetriNet name places transitions arcs initial gs
......@@ -5,6 +5,6 @@ where
import Data.Char
validateId :: String -> String
validateId "" = ""
validateId "" = "_"
validateId (x:xs) = (if isAlpha x then x else '_') :
map (\c -> if isAlphaNum c then c else '_') xs
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