Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
9.2.2023: Due to updates GitLab will be unavailable for some minutes between 9:00 and 11:00.
Open sidebar
i7
peregrine
Commits
813ebf78
Commit
813ebf78
authored
Jan 31, 2017
by
Philipp J. Meyer
Browse files
renamed property for reachability of non-consensus terminal marking
parent
94cbefa8
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/Main.hs
View file @
813ebf78
...
...
@@ -39,7 +39,7 @@ import Solver.SComponentWithCut
import
Solver.SComponent
import
Solver.Simplifier
import
Solver.TerminalMarkingsUniqueConsensus
import
Solver.NonConsensus
State
import
Solver.NonConsensus
TerminalMarking
import
Solver.TerminalMarkingReachable
--import Solver.Interpolant
--import Solver.CommFreeReachability
...
...
@@ -219,9 +219,9 @@ makeImplicitProperty _ StructFinalPlace =
makeImplicitProperty
_
StructCommunicationFree
=
Property
"communication free"
$
Structural
CommunicationFree
makeImplicitProperty
_
TerminalMarkingsUniqueConsensus
=
Property
"terminal markings have a unique consensus"
$
Constraint
TerminalMarkingsUniqueConsensusConstraint
makeImplicitProperty
_
NonConsensus
State
=
Property
"non-consensus
stat
e"
$
Constraint
NonConsensus
State
Constraint
Property
"
reachable
terminal markings have a unique consensus"
$
Constraint
TerminalMarkingsUniqueConsensusConstraint
makeImplicitProperty
_
NonConsensus
TerminalMarking
=
Property
"
no
non-consensus
terminal marking reachabl
e"
$
Constraint
NonConsensus
TerminalMarking
Constraint
makeImplicitProperty
_
TerminalMarkingReachable
=
Property
"terminal marking reachable"
$
Constraint
TerminalMarkingReachableConstraint
...
...
@@ -451,7 +451,7 @@ checkConstraintProperty :: PetriNet -> ConstraintProperty -> OptIO PropResult
checkConstraintProperty
net
cp
=
case
cp
of
TerminalMarkingsUniqueConsensusConstraint
->
checkTerminalMarkingsUniqueConsensusProperty
net
NonConsensus
State
Constraint
->
checkNonConsensus
State
Property
net
NonConsensus
TerminalMarking
Constraint
->
checkNonConsensus
TerminalMarking
Property
net
TerminalMarkingReachableConstraint
->
checkTerminalMarkingReachableProperty
net
checkTerminalMarkingsUniqueConsensusProperty
::
PetriNet
->
OptIO
PropResult
...
...
@@ -491,42 +491,42 @@ refineTerminalMarkingsUniqueConsensusProperty net traps siphons c@(m0, m1, m2, x
Just
trap
->
checkTerminalMarkingsUniqueConsensusProperty'
net
(
trap
:
traps
)
siphons
checkNonConsensus
State
Property
::
PetriNet
->
OptIO
PropResult
checkNonConsensus
State
Property
net
=
do
r
<-
checkNonConsensus
State
Property'
net
(
fixedTraps
net
)
(
fixedSiphons
net
)
checkNonConsensus
TerminalMarking
Property
::
PetriNet
->
OptIO
PropResult
checkNonConsensus
TerminalMarking
Property
net
=
do
r
<-
checkNonConsensus
TerminalMarking
Property'
net
(
fixedTraps
net
)
(
fixedSiphons
net
)
case
r
of
(
Nothing
,
_
,
_
)
->
return
Satisfied
(
Just
_
,
_
,
_
)
->
return
Unknown
checkNonConsensus
State
Property'
::
PetriNet
->
checkNonConsensus
TerminalMarking
Property'
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
OptIO
(
Maybe
NonConsensus
State
CounterExample
,
[
Trap
],
[
Siphon
])
checkNonConsensus
State
Property'
net
traps
siphons
=
do
r
<-
checkSat
$
checkNonConsensus
State
Sat
net
traps
siphons
OptIO
(
Maybe
NonConsensus
TerminalMarking
CounterExample
,
[
Trap
],
[
Siphon
])
checkNonConsensus
TerminalMarking
Property'
net
traps
siphons
=
do
r
<-
checkSat
$
checkNonConsensus
TerminalMarking
Sat
net
traps
siphons
case
r
of
Nothing
->
return
(
Nothing
,
traps
,
siphons
)
Just
c
->
do
refine
<-
opt
optRefinementType
if
isJust
refine
then
refineNonConsensus
State
Property
net
traps
siphons
c
refineNonConsensus
TerminalMarking
Property
net
traps
siphons
c
else
return
(
Just
c
,
traps
,
siphons
)
refineNonConsensus
State
Property
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
NonConsensus
State
CounterExample
->
OptIO
(
Maybe
NonConsensus
State
CounterExample
,
[
Trap
],
[
Siphon
])
refineNonConsensus
State
Property
net
traps
siphons
c
@
(
m0
,
m
,
x
)
=
do
r1
<-
checkSatMin
$
Solver
.
NonConsensus
State
.
checkUnmarkedTrapSat
net
m0
m
x
refineNonConsensus
TerminalMarking
Property
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
NonConsensus
TerminalMarking
CounterExample
->
OptIO
(
Maybe
NonConsensus
TerminalMarking
CounterExample
,
[
Trap
],
[
Siphon
])
refineNonConsensus
TerminalMarking
Property
net
traps
siphons
c
@
(
m0
,
m
,
x
)
=
do
r1
<-
checkSatMin
$
Solver
.
NonConsensus
TerminalMarking
.
checkUnmarkedTrapSat
net
m0
m
x
case
r1
of
Nothing
->
do
r2
<-
checkSatMin
$
Solver
.
NonConsensus
State
.
checkUnmarkedSiphonSat
net
m0
m
x
r2
<-
checkSatMin
$
Solver
.
NonConsensus
TerminalMarking
.
checkUnmarkedSiphonSat
net
m0
m
x
case
r2
of
Nothing
->
return
(
Just
c
,
traps
,
siphons
)
Just
siphon
->
checkNonConsensus
State
Property'
net
traps
(
siphon
:
siphons
)
checkNonConsensus
TerminalMarking
Property'
net
traps
(
siphon
:
siphons
)
Just
trap
->
checkNonConsensus
State
Property'
net
(
trap
:
traps
)
siphons
checkNonConsensus
TerminalMarking
Property'
net
(
trap
:
traps
)
siphons
checkTerminalMarkingReachableProperty
::
PetriNet
->
OptIO
PropResult
checkTerminalMarkingReachableProperty
net
=
do
...
...
src/Options.hs
View file @
813ebf78
...
...
@@ -32,7 +32,7 @@ data ImplicitProperty = Termination
|
StructFinalPlace
|
StructCommunicationFree
|
TerminalMarkingsUniqueConsensus
|
NonConsensus
State
|
NonConsensus
TerminalMarking
|
TerminalMarkingReachable
deriving
(
Show
,
Read
)
...
...
@@ -186,11 +186,11 @@ options =
}))
"Prove that terminal markings have a unique consensus"
,
Option
""
[
"non-consensus-
state
"
]
,
Option
""
[
"non-consensus-
terminal-marking
"
]
(
NoArg
(
\
opt
->
Right
opt
{
optProperties
=
NonConsensus
State
:
optProperties
opt
optProperties
=
NonConsensus
TerminalMarking
:
optProperties
opt
}))
"Prove that no non-consensus terminal
state
is reachable from an initial marking"
"Prove that no non-consensus terminal
marking
is reachable from an initial marking"
,
Option
""
[
"terminal-marking-reachable"
]
(
NoArg
(
\
opt
->
Right
opt
{
...
...
src/Property.hs
View file @
813ebf78
...
...
@@ -93,12 +93,12 @@ data PropertyType = SafetyType
|
ConstraintType
data
ConstraintProperty
=
TerminalMarkingsUniqueConsensusConstraint
|
NonConsensus
State
Constraint
|
NonConsensus
TerminalMarking
Constraint
|
TerminalMarkingReachableConstraint
instance
Show
ConstraintProperty
where
show
TerminalMarkingsUniqueConsensusConstraint
=
"terminal markings have a unique consensus"
show
NonConsensus
State
Constraint
=
"non-consensus
stat
e"
show
TerminalMarkingsUniqueConsensusConstraint
=
"
reachable
terminal markings have a unique consensus"
show
NonConsensus
TerminalMarking
Constraint
=
"
no
non-consensus
terminal marking reachabl
e"
show
TerminalMarkingReachableConstraint
=
"terminal marking reachable"
data
PropertyContent
=
Safety
(
Formula
Place
)
...
...
src/Solver/NonConsensus
State
.hs
→
src/Solver/NonConsensus
TerminalMarking
.hs
View file @
813ebf78
{-# LANGUAGE FlexibleContexts #-}
module
Solver.NonConsensus
State
(
checkNonConsensus
State
Sat
,
NonConsensus
State
CounterExample
,
module
Solver.NonConsensus
TerminalMarking
(
checkNonConsensus
TerminalMarking
Sat
,
NonConsensus
TerminalMarking
CounterExample
,
checkUnmarkedTrapSat
,
checkUnmarkedSiphonSat
)
where
...
...
@@ -16,7 +16,7 @@ import PetriNet
import
Property
import
Solver
type
NonConsensus
State
CounterExample
=
(
RMarking
,
RMarking
,
RFiringVector
)
type
NonConsensus
TerminalMarking
CounterExample
=
(
RMarking
,
RMarking
,
RFiringVector
)
stateEquationConstraints
::
PetriNet
->
SRMap
Place
->
SRMap
Place
->
SRMap
Transition
->
SBool
stateEquationConstraints
net
m0
m
x
=
...
...
@@ -68,8 +68,8 @@ checkSiphonConstraints :: PetriNet -> SRMap Place -> SRMap Place -> SRMap Transi
checkSiphonConstraints
net
m0
m
x
siphons
=
bAnd
$
map
(
checkSiphon
net
m0
m
x
)
siphons
checkNonConsensus
State
::
PetriNet
->
SRMap
Place
->
SRMap
Place
->
SRMap
Transition
->
[
Trap
]
->
[
Siphon
]
->
SBool
checkNonConsensus
State
net
m0
m
x
traps
siphons
=
checkNonConsensus
TerminalMarking
::
PetriNet
->
SRMap
Place
->
SRMap
Place
->
SRMap
Transition
->
[
Trap
]
->
[
Siphon
]
->
SBool
checkNonConsensus
TerminalMarking
net
m0
m
x
traps
siphons
=
stateEquationConstraints
net
m0
m
x
&&&
nonNegativityConstraints
m0
&&&
nonNegativityConstraints
m
&&&
...
...
@@ -80,17 +80,17 @@ checkNonConsensusState net m0 m x traps siphons =
checkTrapConstraints
net
m0
m
x
traps
&&&
checkSiphonConstraints
net
m0
m
x
siphons
checkNonConsensus
State
Sat
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
ConstraintProblem
AlgReal
NonConsensus
State
CounterExample
checkNonConsensus
State
Sat
net
traps
siphons
=
checkNonConsensus
TerminalMarking
Sat
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
ConstraintProblem
AlgReal
NonConsensus
TerminalMarking
CounterExample
checkNonConsensus
TerminalMarking
Sat
net
traps
siphons
=
let
m0
=
makeVarMap
$
places
net
m
=
makeVarMapWith
prime
$
places
net
x
=
makeVarMap
$
transitions
net
in
(
"non-consensus state"
,
"(m0, m, x)"
,
getNames
m0
++
getNames
m
++
getNames
x
,
\
fm
->
checkNonConsensus
State
net
(
fmap
fm
m0
)
(
fmap
fm
m
)
(
fmap
fm
x
)
traps
siphons
,
\
fm
->
checkNonConsensus
TerminalMarking
net
(
fmap
fm
m0
)
(
fmap
fm
m
)
(
fmap
fm
x
)
traps
siphons
,
\
fm
->
markingsFromAssignment
(
fmap
fm
m0
)
(
fmap
fm
m
)
(
fmap
fm
x
))
markingsFromAssignment
::
RMap
Place
->
RMap
Place
->
RMap
Transition
->
NonConsensus
State
CounterExample
markingsFromAssignment
::
RMap
Place
->
RMap
Place
->
RMap
Transition
->
NonConsensus
TerminalMarking
CounterExample
markingsFromAssignment
m0
m
x
=
(
makeVector
m0
,
makeVector
m
,
makeVector
x
)
...
...
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