Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
peregrine
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Environments
Analytics
Analytics
CI / CD
Insights
Issue
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Jobs
Commits
Open sidebar
i7
peregrine
Commits
a17f6534
Commit
a17f6534
authored
Dec 22, 2016
by
Philipp J. Meyer
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Added possibility to specify fixed traps and siphons
parent
9cd19661
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
53 additions
and
30 deletions
+53
-30
src/Main.hs
src/Main.hs
+4
-4
src/Parser/LOLA.hs
src/Parser/LOLA.hs
+1
-1
src/Parser/MIST.hs
src/Parser/MIST.hs
+1
-1
src/Parser/PNET.hs
src/Parser/PNET.hs
+20
-9
src/Parser/TPN.hs
src/Parser/TPN.hs
+1
-1
src/PetriNet.hs
src/PetriNet.hs
+26
-14
No files found.
src/Main.hs
View file @
a17f6534
...
...
@@ -158,14 +158,14 @@ transformNet (net, props) TerminationByReachability =
[(
t
,
(
pre'
,
post'
)),
(
primeTransition
t
,
(
pre''
,
post''
))]
ts
=
(
switch
,
([(
m1
,
1
)],
[(
m2
,
1
)]))
:
concatMap
transformTransition
(
transitions
net
)
gs
=
ghostTransitions
net
prop
=
Property
"termination by reachability"
$
Safety
$
foldl
(
:&:
)
(
LinearInequation
(
Var
sigma
)
Ge
(
Const
1
))
(
map
(
\
p
->
LinearInequation
(
Var
(
primePlace
p
)
:-:
Var
p
)
Ge
(
Const
0
))
(
places
net
))
-- 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
=
(
renamePetriNetPlacesAndTransitions
validateId
net
,
map
(
renameProperty
validateId
)
props
)
...
...
@@ -237,7 +237,7 @@ checkProperty net p = do
checkSafetyProperty
::
PetriNet
->
Formula
Place
->
OptIO
PropResult
checkSafetyProperty
net
f
=
do
r
<-
checkSafetyProperty'
net
f
[]
r
<-
checkSafetyProperty'
net
f
(
fixedTraps
net
)
case
r
of
(
Nothing
,
traps
)
->
do
invariant
<-
opt
optInvariant
...
...
@@ -447,7 +447,7 @@ checkConstraintProperty net cp =
checkUniqueTerminalMarkingProperty
::
PetriNet
->
OptIO
PropResult
checkUniqueTerminalMarkingProperty
net
=
do
r
<-
checkUniqueTerminalMarkingProperty'
net
[]
[]
r
<-
checkUniqueTerminalMarkingProperty'
net
(
fixedTraps
net
)
(
fixedSiphons
net
)
case
r
of
(
Nothing
,
_
,
_
)
->
return
Satisfied
(
Just
_
,
_
,
_
)
->
return
Unknown
...
...
src/Parser/LOLA.hs
View file @
a17f6534
...
...
@@ -57,7 +57,7 @@ net = do
initial
<-
option
[]
markingList
_
<-
semi
ts
<-
many1
transition
return
$
makePetriNetWithTransFromStrings
""
ps
ts
initial
[]
return
$
makePetriNetWithTransFromStrings
""
ps
ts
initial
[]
[]
[]
placeLists
::
Parser
[
String
]
placeLists
=
...
...
src/Parser/MIST.hs
View file @
a17f6534
...
...
@@ -58,7 +58,7 @@ net = do
reserved
"init"
(
is
,
initTrans
)
<-
initial
return
$
makePetriNetWithTransFromStrings
""
ps
(
initTrans
++
ts
)
is
(
map
fst
initTrans
)
(
map
fst
initTrans
)
[]
[]
prop
::
Parser
Property
prop
=
do
...
...
src/Parser/PNET.hs
View file @
a17f6534
...
...
@@ -81,6 +81,12 @@ initial = reserved "initial" *> singleOrList (do
return
(
n
,
i
)
)
trap
::
Parser
[
String
]
trap
=
reserved
"trap"
*>
identList
siphon
::
Parser
[
String
]
siphon
=
reserved
"siphon"
*>
identList
arc
::
Parser
[(
String
,
String
,
Integer
)]
arc
=
do
lhs
<-
identList
...
...
@@ -101,13 +107,16 @@ arcs = do
return
$
concat
as
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
=
Places
<$>
places
<|>
Transitions
<$>
transitions
<|>
Arcs
<$>
arcs
<|>
Initial
<$>
initial
Initial
<$>
initial
<|>
TrapStatement
<$>
trap
<|>
SiphonStatement
<$>
siphon
petriNet
::
Parser
PetriNet
petriNet
=
do
...
...
@@ -115,14 +124,16 @@ petriNet = do
reserved
"net"
name
<-
option
""
ident
statements
<-
braces
(
many
statement
)
let
(
p
,
t
,
a
,
i
)
=
foldl
splitStatement
(
[]
,
[]
,
[]
,
[]
)
statements
return
$
makePetriNetFromStrings
name
p
t
a
i
[]
let
(
p
,
t
,
a
,
i
,
traps
,
siphons
)
=
foldl
splitStatement
(
[]
,
[]
,
[]
,
[]
,
[]
,
[]
)
statements
return
$
makePetriNetFromStrings
name
p
t
a
i
[]
traps
siphons
where
splitStatement
(
ps
,
ts
,
as
,
is
)
stmnt
=
case
stmnt
of
Places
p
->
(
p
++
ps
,
ts
,
as
,
is
)
Transitions
t
->
(
ps
,
t
++
ts
,
as
,
is
)
Arcs
a
->
(
ps
,
ts
,
a
++
as
,
is
)
Initial
i
->
(
ps
,
ts
,
as
,
i
++
is
)
splitStatement
(
ps
,
ts
,
as
,
is
,
traps
,
siphons
)
stmnt
=
case
stmnt
of
Places
p
->
(
p
++
ps
,
ts
,
as
,
is
,
traps
,
siphons
)
Transitions
t
->
(
ps
,
t
++
ts
,
as
,
is
,
traps
,
siphons
)
Arcs
a
->
(
ps
,
ts
,
a
++
as
,
is
,
traps
,
siphons
)
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
name
fun
=
Infix
(
reservedOp
name
*>
return
fun
)
...
...
src/Parser/TPN.hs
View file @
a17f6534
...
...
@@ -77,7 +77,7 @@ petriNet = do
ts
<-
many
transition
let
places
=
[
p
|
(
p
,
_
)
<-
ps
]
initial
=
[
(
p
,
i
)
|
(
p
,
Just
i
)
<-
ps
]
return
$
makePetriNetWithTransFromStrings
""
places
ts
initial
[]
return
$
makePetriNetWithTransFromStrings
""
places
ts
initial
[]
[]
[]
parseContent
::
Parser
(
PetriNet
,[
Property
])
parseContent
=
do
...
...
src/PetriNet.hs
View file @
a17f6534
...
...
@@ -7,7 +7,7 @@ module PetriNet
renamePlace
,
renameTransition
,
renamePetriNetPlacesAndTransitions
,
name
,
showNetName
,
places
,
transitions
,
initialMarking
,
initial
,
initials
,
linitials
,
pre
,
lpre
,
post
,
lpost
,
mpre
,
mpost
,
context
,
ghostTransitions
,
pre
,
lpre
,
post
,
lpost
,
mpre
,
mpost
,
context
,
ghostTransitions
,
fixedTraps
,
fixedSiphons
,
makePetriNet
,
makePetriNetWithTrans
,
makePetriNetFromStrings
,
makePetriNetWithTransFromStrings
,
Trap
,
Siphon
,
Cut
,
constructCut
,
SimpleCut
,
Invariant
(
..
))
...
...
@@ -79,7 +79,9 @@ data PetriNet = PetriNet {
adjacencyP
::
M
.
Map
Place
([(
Transition
,
Integer
)],
[(
Transition
,
Integer
)]),
adjacencyT
::
M
.
Map
Transition
([(
Place
,
Integer
)],
[(
Place
,
Integer
)]),
initialMarking
::
Marking
,
ghostTransitions
::
[
Transition
]
ghostTransitions
::
[
Transition
],
fixedTraps
::
[
Trap
],
fixedSiphons
::
[
Siphon
]
}
initial
::
PetriNet
->
Place
->
Integer
...
...
@@ -104,7 +106,9 @@ instance Show PetriNet where
"
\n
Transition arcs:
\n
"
++
unlines
(
map
showContext
(
M
.
toList
(
adjacencyT
net
)))
++
"
\n
Initial: "
++
show
(
initialMarking
net
)
++
"
\n
Ghost transitions: "
++
show
(
ghostTransitions
net
)
"
\n
Ghost transitions: "
++
show
(
ghostTransitions
net
)
++
"
\n
Fixed traps: "
++
show
(
fixedTraps
net
)
++
"
\n
Fixed siphons: "
++
show
(
fixedSiphons
net
)
where
showContext
(
s
,(
l
,
r
))
=
show
l
++
" -> "
++
show
s
++
" -> "
++
show
r
...
...
@@ -143,7 +147,9 @@ renamePetriNetPlacesAndTransitions f net =
adjacencyT
net
,
initialMarking
=
emap
(
renamePlace
f
)
$
initialMarking
net
,
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
)
mapContext
f
(
pre
,
post
)
=
...
...
@@ -151,8 +157,8 @@ renamePetriNetPlacesAndTransitions f net =
makePetriNet
::
String
->
[
Place
]
->
[
Transition
]
->
[
Either
(
Transition
,
Place
,
Integer
)
(
Place
,
Transition
,
Integer
)]
->
[(
Place
,
Integer
)]
->
[
Transition
]
->
PetriNet
makePetriNet
name
places
transitions
arcs
initial
gs
=
[(
Place
,
Integer
)]
->
[
Transition
]
->
[
Trap
]
->
[
Siphon
]
->
PetriNet
makePetriNet
name
places
transitions
arcs
initial
gs
fixedTraps
fixedSiphons
=
PetriNet
{
name
=
name
,
places
=
listSet
places
,
...
...
@@ -160,7 +166,9 @@ makePetriNet name places transitions arcs initial gs =
adjacencyP
=
M
.
map
(
listMap
***
listMap
)
adP
,
adjacencyT
=
M
.
map
(
listMap
***
listMap
)
adT
,
initialMarking
=
buildVector
initial
,
ghostTransitions
=
listSet
gs
ghostTransitions
=
listSet
gs
,
fixedTraps
=
map
listSet
fixedTraps
,
fixedSiphons
=
map
listSet
fixedSiphons
}
where
(
adP
,
adT
)
=
foldl
buildMaps
(
M
.
empty
,
M
.
empty
)
arcs
...
...
@@ -182,8 +190,8 @@ makePetriNet name places transitions arcs initial gs =
makePetriNetFromStrings
::
String
->
[
String
]
->
[
String
]
->
[(
String
,
String
,
Integer
)]
->
[(
String
,
Integer
)]
->
[
String
]
->
PetriNet
makePetriNetFromStrings
name
places
transitions
arcs
initial
gs
=
[(
String
,
Integer
)]
->
[
String
]
->
[[
String
]]
->
[[
String
]]
->
PetriNet
makePetriNetFromStrings
name
places
transitions
arcs
initial
gs
fixedTraps
fixedSiphons
=
makePetriNet
name
(
map
Place
(
S
.
toAscList
placeSet
))
...
...
@@ -191,6 +199,8 @@ makePetriNetFromStrings name places transitions arcs initial gs =
(
map
toEitherArc
arcs
)
(
map
(
first
Place
)
initial
)
(
map
Transition
gs
)
(
map
(
map
Place
)
fixedTraps
)
(
map
(
map
Place
)
fixedSiphons
)
where
placeSet
=
S
.
fromList
places
transitionSet
=
S
.
fromList
transitions
...
...
@@ -215,23 +225,25 @@ makePetriNetFromStrings name places transitions arcs initial gs =
makePetriNetWithTrans
::
String
->
[
Place
]
->
[(
Transition
,
([(
Place
,
Integer
)],
[(
Place
,
Integer
)]))]
->
[(
Place
,
Integer
)]
->
[
Transition
]
->
PetriNet
makePetriNetWithTrans
name
places
ts
=
makePetriNet
name
places
(
map
fst
ts
)
arcs
[(
Place
,
Integer
)]
->
[
Transition
]
->
[
Trap
]
->
[
Siphon
]
->
PetriNet
makePetriNetWithTrans
name
places
ts
fixedTraps
fixedSiphons
=
makePetriNet
name
places
(
map
fst
ts
)
arcs
fixedTraps
fixedSiphons
where
arcs
=
[
Right
(
p
,
t
,
w
)
|
(
t
,(
is
,
_
))
<-
ts
,
(
p
,
w
)
<-
is
]
++
[
Left
(
t
,
p
,
w
)
|
(
t
,(
_
,
os
))
<-
ts
,
(
p
,
w
)
<-
os
]
makePetriNetWithTransFromStrings
::
String
->
[
String
]
->
[(
String
,
([(
String
,
Integer
)],
[(
String
,
Integer
)]))]
->
[(
String
,
Integer
)]
->
[
String
]
->
PetriNet
makePetriNetWithTransFromStrings
name
places
arcs
initial
gs
=
[(
String
,
Integer
)]
->
[
String
]
->
[[
String
]]
->
[[
String
]]
->
PetriNet
makePetriNetWithTransFromStrings
name
places
arcs
initial
gs
fixedTraps
fixedSiphons
=
makePetriNetWithTrans
name
(
map
Place
places
)
(
map
toTArc
arcs
)
(
map
(
first
Place
)
initial
)
(
map
Transition
gs
)
(
map
(
map
Place
)
fixedTraps
)
(
map
(
map
Place
)
fixedSiphons
)
where
toTArc
(
t
,
(
is
,
os
))
=
(
Transition
t
,
(
map
(
first
Place
)
is
,
map
(
first
Place
)
os
))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment