Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
i7
peregrine
Commits
b12fc08d
Commit
b12fc08d
authored
May 13, 2014
by
Philipp Meyer
Browse files
Extended solver logic for safety and liveness properties
parent
e6b6495e
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/Main.hs
View file @
b12fc08d
...
...
@@ -8,38 +8,47 @@ import PetriNet
import
Property
import
Solver
import
Solver.StateEquation
import
Solver.TransitionInvariant
import
Solver.TrapConstraints
import
Solver.TransitionInvariant
import
Solver.SComponent
checkSafetyProperty
::
PetriNet
->
Formula
->
[[
String
]]
->
IO
Bool
checkSafetyProperty
net
f
traps
=
do
r
<-
checkSat
$
checkStateEquationSat
net
f
traps
case
r
of
Nothing
->
return
True
Just
a
->
do
--print a
let
assigned
=
markedPlacesFromAssignment
net
a
putStrLn
$
"Assignment found marking "
++
show
assigned
rt
<-
checkSat
$
checkTrapSat
net
assigned
case
rt
of
Nothing
->
do
putStrLn
"No trap found."
return
False
Just
at
->
do
let
trap
=
trapFromAssignment
at
putStrLn
$
"Trap found with places "
++
show
trap
checkSafetyProperty
net
f
(
trap
:
traps
)
r
<-
checkSat
$
checkStateEquationSat
net
f
traps
case
r
of
Nothing
->
return
True
Just
a
->
do
--print a
let
assigned
=
markedPlacesFromAssignment
net
a
putStrLn
$
"Assignment found marking "
++
show
assigned
rt
<-
checkSat
$
checkTrapSat
net
assigned
case
rt
of
Nothing
->
do
putStrLn
"No trap found."
return
False
Just
at
->
do
let
trap
=
trapFromAssignment
at
putStrLn
$
"Trap found with places "
++
show
trap
checkSafetyProperty
net
f
(
trap
:
traps
)
checkLivenessProperty
::
PetriNet
->
Formula
->
IO
Bool
checkLivenessProperty
net
f
=
do
r
<-
checkSat
$
checkTransitionInvariantSat
net
f
case
r
of
Nothing
->
return
True
Just
m
->
do
putStrLn
"Assignment found:"
print
m
return
False
Just
a
->
do
let
fired
=
firedTransitionsFromAssignment
a
putStrLn
$
"Assignment found firing "
++
show
fired
rt
<-
checkSat
$
checkSComponentSat
net
a
case
rt
of
Nothing
->
do
putStrLn
"No S-component found"
return
False
Just
at
->
do
--let trap = trapFromAssignment at
putStrLn
$
"S-component found: "
++
show
at
-- checkLivenessProperty net f (trap:traps)
return
False
checkProperty
::
PetriNet
->
Property
->
IO
Bool
checkProperty
net
p
=
do
...
...
src/Solver/StateEquation.hs
View file @
b12fc08d
...
...
@@ -12,8 +12,7 @@ import Solver
import
Solver.Formula
placeConstraints
::
PetriNet
->
ModelSI
->
SBool
placeConstraints
net
m
=
bAnd
$
map
checkPlaceEquation
$
places
net
placeConstraints
net
m
=
bAnd
$
map
checkPlaceEquation
$
places
net
where
checkPlaceEquation
p
=
let
incoming
=
map
addTransition
$
lpre
net
p
outgoing
=
map
addTransition
$
lpost
net
p
...
...
@@ -21,20 +20,17 @@ placeConstraints net m =
in
pinit
+
sum
incoming
-
sum
outgoing
.==
(
m
M
.!
p
)
addTransition
(
t
,
w
)
=
literal
w
*
(
m
M
.!
t
)
nonnegativityConstraints
::
PetriNet
->
ModelSI
->
SBool
nonnegativityConstraints
net
m
=
bAnd
$
map
checkPT
$
places
net
++
transitions
net
where
checkPT
x
=
(
m
M
.!
x
)
.>=
0
nonnegativityConstraints
::
ModelSI
->
SBool
nonnegativityConstraints
m
=
bAnd
$
map
(
.>=
0
)
$
M
.
elems
m
checkTraps
::
[[
String
]]
->
ModelSI
->
SBool
checkTraps
traps
m
=
bAnd
$
map
checkTrapDelta
traps
checkTraps
traps
m
=
bAnd
$
map
checkTrapDelta
traps
where
checkTrapDelta
trap
=
sum
(
map
(
m
M
.!
)
trap
)
.>=
1
checkStateEquation
::
PetriNet
->
Formula
->
[[
String
]]
->
ModelSI
->
SBool
checkStateEquation
net
f
traps
m
=
placeConstraints
net
m
&&&
nonnegativityConstraints
net
m
&&&
nonnegativityConstraints
m
&&&
checkTraps
traps
m
&&&
evaluateFormula
f
m
...
...
src/Solver/TransitionInvariant.hs
View file @
b12fc08d
module
Solver.TransitionInvariant
(
checkTransitionInvariant
,
checkTransitionInvariantSat
)
(
checkTransitionInvariant
,
checkTransitionInvariantSat
,
firedTransitionsFromAssignment
)
where
import
Data.SBV
...
...
@@ -14,22 +15,27 @@ tInvariantConstraints :: PetriNet -> ModelSI -> SBool
tInvariantConstraints
net
m
=
bAnd
$
map
checkTransitionEquation
$
places
net
where
checkTransitionEquation
p
=
let
incoming
=
map
add
Place
$
lpre
net
p
outgoing
=
map
add
Place
$
lpost
net
p
let
incoming
=
map
add
Transition
$
lpre
net
p
outgoing
=
map
add
Transition
$
lpost
net
p
in
sum
outgoing
-
sum
incoming
.>=
0
add
Place
(
t
,
w
)
=
literal
w
*
(
m
M
.!
t
)
add
Transition
(
t
,
w
)
=
literal
w
*
(
m
M
.!
t
)
nonnegativityConstraints
::
PetriNet
->
ModelSI
->
SBool
nonnegativityConstraints
net
m
=
bAnd
$
map
checkT
$
transitions
net
where
checkT
t
=
(
m
M
.!
t
)
.>=
0
finalInvariantConstraints
::
ModelSI
->
SBool
finalInvariantConstraints
m
=
sum
(
M
.
elems
m
)
.>
0
nonnegativityConstraints
::
ModelSI
->
SBool
nonnegativityConstraints
m
=
bAnd
$
map
(
.>=
0
)
$
M
.
elems
m
checkTransitionInvariant
::
PetriNet
->
Formula
->
ModelSI
->
SBool
checkTransitionInvariant
net
f
m
=
tInvariantConstraints
net
m
&&&
nonnegativityConstraints
net
m
&&&
nonnegativityConstraints
m
&&&
finalInvariantConstraints
m
&&&
evaluateFormula
f
m
checkTransitionInvariantSat
::
PetriNet
->
Formula
->
([
String
],
ModelSI
->
SBool
)
checkTransitionInvariantSat
net
f
=
(
transitions
net
,
checkTransitionInvariant
net
f
)
firedTransitionsFromAssignment
::
ModelI
->
[
String
]
firedTransitionsFromAssignment
a
=
M
.
keys
$
M
.
filter
(
>
0
)
a
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