Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
i7
peregrine
Commits
94cbefa8
Commit
94cbefa8
authored
Jan 31, 2017
by
Philipp J. Meyer
Browse files
changed unique terminal marking to terminal markings have a unique consensus
parent
0bbb82c8
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/Main.hs
View file @
94cbefa8
...
...
@@ -38,7 +38,7 @@ import Solver.SafetyInvariant
import
Solver.SComponentWithCut
import
Solver.SComponent
import
Solver.Simplifier
import
Solver.
Unique
TerminalMarking
import
Solver.TerminalMarking
sUniqueConsensus
import
Solver.NonConsensusState
import
Solver.TerminalMarkingReachable
--import Solver.Interpolant
...
...
@@ -218,8 +218,8 @@ makeImplicitProperty _ StructFinalPlace =
Property
"final place"
$
Structural
FinalPlace
makeImplicitProperty
_
StructCommunicationFree
=
Property
"communication free"
$
Structural
CommunicationFree
makeImplicitProperty
_
Unique
TerminalMarking
=
Property
"
unique
terminal marking"
$
Constraint
Unique
TerminalMarkingConstraint
makeImplicitProperty
_
TerminalMarking
sUniqueConsensus
=
Property
"terminal marking
s have a unique consensus
"
$
Constraint
TerminalMarking
sUniqueConsensus
Constraint
makeImplicitProperty
_
NonConsensusState
=
Property
"non-consensus state"
$
Constraint
NonConsensusStateConstraint
makeImplicitProperty
_
TerminalMarkingReachable
=
...
...
@@ -450,46 +450,46 @@ checkStructuralProperty net struct =
checkConstraintProperty
::
PetriNet
->
ConstraintProperty
->
OptIO
PropResult
checkConstraintProperty
net
cp
=
case
cp
of
Unique
TerminalMarkingConstraint
->
check
Unique
TerminalMarkingProperty
net
TerminalMarking
sUniqueConsensus
Constraint
->
checkTerminalMarking
sUniqueConsensus
Property
net
NonConsensusStateConstraint
->
checkNonConsensusStateProperty
net
TerminalMarkingReachableConstraint
->
checkTerminalMarkingReachableProperty
net
check
Unique
TerminalMarkingProperty
::
PetriNet
->
OptIO
PropResult
check
Unique
TerminalMarkingProperty
net
=
do
r
<-
check
Unique
TerminalMarkingProperty'
net
(
fixedTraps
net
)
(
fixedSiphons
net
)
checkTerminalMarking
sUniqueConsensus
Property
::
PetriNet
->
OptIO
PropResult
checkTerminalMarking
sUniqueConsensus
Property
net
=
do
r
<-
checkTerminalMarking
sUniqueConsensus
Property'
net
(
fixedTraps
net
)
(
fixedSiphons
net
)
case
r
of
(
Nothing
,
_
,
_
)
->
return
Satisfied
(
Just
_
,
_
,
_
)
->
return
Unknown
check
Unique
TerminalMarkingProperty'
::
PetriNet
->
checkTerminalMarking
sUniqueConsensus
Property'
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
OptIO
(
Maybe
Unique
TerminalMarkingCounterExample
,
[
Trap
],
[
Siphon
])
check
Unique
TerminalMarkingProperty'
net
traps
siphons
=
do
r
<-
checkSat
$
check
Unique
TerminalMarkingSat
net
traps
siphons
OptIO
(
Maybe
TerminalMarking
sUniqueConsensus
CounterExample
,
[
Trap
],
[
Siphon
])
checkTerminalMarking
sUniqueConsensus
Property'
net
traps
siphons
=
do
r
<-
checkSat
$
checkTerminalMarking
sUniqueConsensus
Sat
net
traps
siphons
case
r
of
Nothing
->
return
(
Nothing
,
traps
,
siphons
)
Just
c
->
do
refine
<-
opt
optRefinementType
if
isJust
refine
then
refine
Unique
TerminalMarkingProperty
net
traps
siphons
c
refineTerminalMarking
sUniqueConsensus
Property
net
traps
siphons
c
else
return
(
Just
c
,
traps
,
siphons
)
refine
Unique
TerminalMarkingProperty
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
Unique
TerminalMarkingCounterExample
->
OptIO
(
Maybe
Unique
TerminalMarkingCounterExample
,
[
Trap
],
[
Siphon
])
refine
Unique
TerminalMarkingProperty
net
traps
siphons
c
@
(
m0
,
m1
,
m2
,
x1
,
x2
)
=
do
r1
<-
checkSatMin
$
Solver
.
Unique
TerminalMarking
.
checkUnmarkedTrapSat
net
m0
m1
m2
x1
x2
refineTerminalMarking
sUniqueConsensus
Property
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
TerminalMarking
sUniqueConsensus
CounterExample
->
OptIO
(
Maybe
TerminalMarking
sUniqueConsensus
CounterExample
,
[
Trap
],
[
Siphon
])
refineTerminalMarking
sUniqueConsensus
Property
net
traps
siphons
c
@
(
m0
,
m1
,
m2
,
x1
,
x2
)
=
do
r1
<-
checkSatMin
$
Solver
.
TerminalMarking
sUniqueConsensus
.
checkUnmarkedTrapSat
net
m0
m1
m2
x1
x2
case
r1
of
Nothing
->
do
r2
<-
checkSatMin
$
Solver
.
Unique
TerminalMarking
.
checkUnmarkedSiphonSat
net
m0
m1
m2
x1
x2
r2
<-
checkSatMin
$
Solver
.
TerminalMarking
sUniqueConsensus
.
checkUnmarkedSiphonSat
net
m0
m1
m2
x1
x2
case
r2
of
Nothing
->
return
(
Just
c
,
traps
,
siphons
)
Just
siphon
->
check
Unique
TerminalMarkingProperty'
net
traps
(
siphon
:
siphons
)
checkTerminalMarking
sUniqueConsensus
Property'
net
traps
(
siphon
:
siphons
)
Just
trap
->
check
Unique
TerminalMarkingProperty'
net
(
trap
:
traps
)
siphons
checkTerminalMarking
sUniqueConsensus
Property'
net
(
trap
:
traps
)
siphons
checkNonConsensusStateProperty
::
PetriNet
->
OptIO
PropResult
checkNonConsensusStateProperty
net
=
do
...
...
src/Options.hs
View file @
94cbefa8
...
...
@@ -31,7 +31,7 @@ data ImplicitProperty = Termination
|
StructParallel
|
StructFinalPlace
|
StructCommunicationFree
|
Unique
TerminalMarking
|
TerminalMarking
sUniqueConsensus
|
NonConsensusState
|
TerminalMarkingReachable
deriving
(
Show
,
Read
)
...
...
@@ -180,11 +180,11 @@ options =
}))
"Prove that the net is communication-free"
,
Option
""
[
"
unique-
terminal-marking"
]
,
Option
""
[
"terminal-marking
s-unique-consensus
"
]
(
NoArg
(
\
opt
->
Right
opt
{
optProperties
=
Unique
TerminalMarking
:
optProperties
opt
optProperties
=
TerminalMarking
sUniqueConsensus
:
optProperties
opt
}))
"Prove that a
l
l markings
of the net
have a unique
terminal marking
"
"Prove that
termin
al markings have a unique
consensus
"
,
Option
""
[
"non-consensus-state"
]
(
NoArg
(
\
opt
->
Right
opt
{
...
...
src/Property.hs
View file @
94cbefa8
...
...
@@ -92,12 +92,12 @@ data PropertyType = SafetyType
|
StructuralType
|
ConstraintType
data
ConstraintProperty
=
Unique
TerminalMarkingConstraint
data
ConstraintProperty
=
TerminalMarking
sUniqueConsensus
Constraint
|
NonConsensusStateConstraint
|
TerminalMarkingReachableConstraint
instance
Show
ConstraintProperty
where
show
Unique
TerminalMarkingConstraint
=
"
unique
terminal marking"
show
TerminalMarking
sUniqueConsensus
Constraint
=
"terminal marking
s have a unique consensus
"
show
NonConsensusStateConstraint
=
"non-consensus state"
show
TerminalMarkingReachableConstraint
=
"terminal marking reachable"
...
...
src/Solver/
Unique
TerminalMarking.hs
→
src/Solver/TerminalMarking
sUniqueConsensus
.hs
View file @
94cbefa8
{-# LANGUAGE FlexibleContexts #-}
module
Solver.
Unique
TerminalMarking
(
check
Unique
TerminalMarkingSat
,
Unique
TerminalMarkingCounterExample
,
module
Solver.TerminalMarking
sUniqueConsensus
(
checkTerminalMarking
sUniqueConsensus
Sat
,
TerminalMarking
sUniqueConsensus
CounterExample
,
checkUnmarkedTrapSat
,
checkUnmarkedSiphonSat
)
where
import
Data.SBV
import
qualified
Data.Map
as
M
import
Data.List
((
\\
))
import
Util
import
PetriNet
import
Property
import
Solver
type
Unique
TerminalMarkingCounterExample
=
(
Marking
,
Marking
,
Marking
,
FiringVector
,
FiringVector
)
type
TerminalMarking
sUniqueConsensus
CounterExample
=
(
Marking
,
Marking
,
Marking
,
FiringVector
,
FiringVector
)
stateEquationConstraints
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Transition
->
SBool
stateEquationConstraints
net
m0
m
x
=
...
...
@@ -37,13 +38,14 @@ terminalConstraints net m =
where
checkTransition
t
=
bOr
$
map
checkPlace
$
lpre
net
t
checkPlace
(
p
,
w
)
=
val
m
p
.<=
literal
(
fromInteger
(
w
-
1
))
nonEqualityConstraints
::
(
Ord
a
,
Show
a
)
=>
PetriNet
->
SIMap
a
->
SIMap
a
->
SBool
nonEqualityConstraints
net
m1
m2
=
if
elemsSet
m1
/=
elemsSet
m2
then
false
else
bOr
$
map
checkNonEquality
$
elems
m1
where
checkNonEquality
x
=
val
m1
x
./=
val
m2
x
initialMarkingConstraints
::
PetriNet
->
SIMap
Place
->
SBool
initialMarkingConstraints
net
m0
=
sum
(
mval
m0
(
places
net
\\
initials
net
))
.==
0
differentConsensusConstraints
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SBool
differentConsensusConstraints
net
m1
m2
=
(
sum
(
mval
m1
(
yesStates
net
))
.>
0
&&&
sum
(
mval
m2
(
noStates
net
))
.>
0
)
|||
(
sum
(
mval
m1
(
noStates
net
))
.>
0
&&&
sum
(
mval
m2
(
yesStates
net
))
.>
0
)
checkTrap
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Place
->
SIMap
Transition
->
SIMap
Transition
->
Trap
->
SBool
checkTrap
net
m0
m1
m2
x1
x2
trap
=
...
...
@@ -67,10 +69,11 @@ checkSiphonConstraints :: PetriNet -> SIMap Place -> SIMap Place -> SIMap Place
checkSiphonConstraints
net
m0
m1
m2
x1
x2
siphons
=
bAnd
$
map
(
checkSiphon
net
m0
m1
m2
x1
x2
)
siphons
check
Unique
TerminalMarking
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Place
->
SIMap
Transition
->
SIMap
Transition
->
checkTerminalMarking
sUniqueConsensus
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Place
->
SIMap
Transition
->
SIMap
Transition
->
[
Trap
]
->
[
Siphon
]
->
SBool
checkUniqueTerminalMarking
net
m0
m1
m2
x1
x2
traps
siphons
=
nonEqualityConstraints
net
m1
m2
&&&
checkTerminalMarkingsUniqueConsensus
net
m0
m1
m2
x1
x2
traps
siphons
=
initialMarkingConstraints
net
m0
&&&
differentConsensusConstraints
net
m1
m2
&&&
stateEquationConstraints
net
m0
m1
x1
&&&
stateEquationConstraints
net
m0
m2
x2
&&&
nonNegativityConstraints
m0
&&&
...
...
@@ -83,8 +86,8 @@ checkUniqueTerminalMarking net m0 m1 m2 x1 x2 traps siphons =
checkTrapConstraints
net
m0
m1
m2
x1
x2
traps
&&&
checkSiphonConstraints
net
m0
m1
m2
x1
x2
siphons
check
Unique
TerminalMarkingSat
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
ConstraintProblem
Integer
Unique
TerminalMarkingCounterExample
check
Unique
TerminalMarkingSat
net
traps
siphons
=
checkTerminalMarking
sUniqueConsensus
Sat
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
ConstraintProblem
Integer
TerminalMarking
sUniqueConsensus
CounterExample
checkTerminalMarking
sUniqueConsensus
Sat
net
traps
siphons
=
let
m0
=
makeVarMap
$
places
net
m1
=
makeVarMapWith
prime
$
places
net
m2
=
makeVarMapWith
(
prime
.
prime
)
$
places
net
...
...
@@ -92,10 +95,10 @@ checkUniqueTerminalMarkingSat net traps siphons =
x2
=
makeVarMapWith
prime
$
transitions
net
in
(
"unique terminal marking"
,
"(m0, m1, m2, x1, x2)"
,
getNames
m0
++
getNames
m1
++
getNames
m2
++
getNames
x1
++
getNames
x2
,
\
fm
->
check
Unique
TerminalMarking
net
(
fmap
fm
m0
)
(
fmap
fm
m1
)
(
fmap
fm
m2
)
(
fmap
fm
x1
)
(
fmap
fm
x2
)
traps
siphons
,
\
fm
->
checkTerminalMarking
sUniqueConsensus
net
(
fmap
fm
m0
)
(
fmap
fm
m1
)
(
fmap
fm
m2
)
(
fmap
fm
x1
)
(
fmap
fm
x2
)
traps
siphons
,
\
fm
->
markingsFromAssignment
(
fmap
fm
m0
)
(
fmap
fm
m1
)
(
fmap
fm
m2
)
(
fmap
fm
x1
)
(
fmap
fm
x2
))
markingsFromAssignment
::
IMap
Place
->
IMap
Place
->
IMap
Place
->
IMap
Transition
->
IMap
Transition
->
Unique
TerminalMarkingCounterExample
markingsFromAssignment
::
IMap
Place
->
IMap
Place
->
IMap
Place
->
IMap
Transition
->
IMap
Transition
->
TerminalMarking
sUniqueConsensus
CounterExample
markingsFromAssignment
m0
m1
m2
x1
x2
=
(
makeVector
m0
,
makeVector
m1
,
makeVector
m2
,
makeVector
x1
,
makeVector
x2
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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