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
341129ab
Commit
341129ab
authored
Dec 01, 2014
by
Philipp Meyer
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Added option to check if net might have parallel execution
parent
a7aacd19
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
56 additions
and
17 deletions
+56
-17
src/Main.hs
src/Main.hs
+31
-11
src/Parser/PNET.hs
src/Parser/PNET.hs
+0
-1
src/Structure.hs
src/Structure.hs
+25
-5
No files found.
src/Main.hs
View file @
341129ab
...
...
@@ -22,6 +22,7 @@ import Printer
import
qualified
Printer.LOLA
as
LOLAPrinter
import
qualified
Printer.SARA
as
SARAPrinter
import
qualified
Printer.SPEC
as
SPECPrinter
import
qualified
Printer.DOT
as
DOTPrinter
import
Property
import
Structure
import
Solver
...
...
@@ -40,6 +41,8 @@ data ImplicitProperty = Termination
|
ProperTermination
|
Safe
|
Bounded
Integer
|
StructFreeChoice
|
StructParallel
|
StructFinalPlace
deriving
(
Show
,
Read
)
data
Options
=
Options
{
inputFormat
::
InputFormat
...
...
@@ -147,6 +150,18 @@ options =
}))
"Prove that the net is free-choice"
,
Option
""
[
"parallel"
]
(
NoArg
(
\
opt
->
Right
opt
{
optProperties
=
StructParallel
:
optProperties
opt
}))
"Prove that the net has non-trivial parallellism"
,
Option
""
[
"final-place"
]
(
NoArg
(
\
opt
->
Right
opt
{
optProperties
=
StructFinalPlace
:
optProperties
opt
}))
"Prove that there is only one needed final place"
,
Option
"n"
[
"no-refinement"
]
(
NoArg
(
\
opt
->
Right
opt
{
optRefine
=
False
}))
"Don't use refinement"
...
...
@@ -197,16 +212,17 @@ writeFiles :: Int -> String -> PetriNet -> [Property] -> IO ()
writeFiles
verbosity
basename
net
props
=
do
-- TODO: add options for different outputs
verbosePut
verbosity
1
$
"Writing "
++
showNetName
net
++
" to "
++
basename
L
.
writeFile
basename
$
LOLAPrinter
.
printNet
net
mapM_
(
\
(
p
,
i
)
->
do
let
file
=
basename
++
".task"
++
show
i
verbosePut
verbosity
1
$
"Writing "
++
showPropertyName
p
++
" to "
++
file
L
.
writeFile
file
$
LOLAPrinter
.
printProperty
p
)
(
zip
props
[(
1
::
Integer
)
..
])
verbosePut
verbosity
1
$
"Writing properties to "
++
basename
++
".sara"
L
.
writeFile
(
basename
++
".sara"
)
$
SARAPrinter
.
printProperties
basename
net
props
L
.
writeFile
basename
$
DOTPrinter
.
printNet
net
--L.writeFile basename $ LOLAPrinter.printNet net
--mapM_ (\(p,i) -> do
-- let file = basename ++ ".task" ++ show i
-- verbosePut verbosity 1 $ "Writing " ++ showPropertyName p ++
-- " to " ++ file
-- L.writeFile file $ LOLAPrinter.printProperty p
-- ) (zip props [(1::Integer)..])
--verbosePut verbosity 1 $ "Writing properties to " ++ basename ++ ".sara"
--L.writeFile (basename ++ ".sara") $
-- SARAPrinter.printProperties basename net props
--mapM_ (\(p,i) -> do
-- let file = basename ++ ".target" ++ show i
-- verbosePut verbosity 1 $ "Writing " ++ showPropertyName p ++
...
...
@@ -334,6 +350,10 @@ makeImplicitProperty net Safe =
in
Property
"safe"
$
pcont
bounded
makeImplicitProperty
_
StructFreeChoice
=
Property
"free choice"
$
Structural
FreeChoice
makeImplicitProperty
_
StructParallel
=
Property
"parallel"
$
Structural
Parallel
makeImplicitProperty
_
StructFinalPlace
=
Property
"final place"
$
Structural
FinalPlace
checkProperty
::
Int
->
PetriNet
->
Bool
->
Property
->
IO
PropResult
checkProperty
verbosity
net
refine
p
=
do
...
...
@@ -408,7 +428,7 @@ checkLivenessProperty verbosity net refine f strans = do
return
Unknown
checkStructuralProperty
::
Int
->
PetriNet
->
Structure
->
IO
PropResult
checkStructuralProperty
_
net
struct
=
do
checkStructuralProperty
_
net
struct
=
if
checkStructure
net
struct
then
return
Satisfied
else
...
...
src/Parser/PNET.hs
View file @
341129ab
...
...
@@ -12,7 +12,6 @@ import qualified Text.Parsec.Token as Token
import
Parser
import
PetriNet
(
PetriNet
,
makePetriNet
)
import
Property
import
Structure
languageDef
::
LanguageDef
()
languageDef
=
...
...
src/Structure.hs
View file @
341129ab
module
Structure
(
Structure
(
..
),
checkStructure
)
checkStructure
,
checkParallelT
)
where
import
PetriNet
import
Data.List
(
intersect
)
import
Data.List
(
intersect
,
sort
)
data
Structure
=
FreeChoice
data
Structure
=
FreeChoice
|
Parallel
|
FinalPlace
instance
Show
Structure
where
show
FreeChoice
=
"free choice"
show
Parallel
=
"parallel"
show
FinalPlace
=
"final place"
checkStructure
::
PetriNet
->
Structure
->
Bool
checkStructure
net
FreeChoice
=
all
freeChoiceCond
[(
p
,
s
)
|
p
<-
places
net
,
s
<-
places
net
]
where
freeChoiceCond
(
p
,
s
)
=
let
ppost
=
post
net
p
spost
=
post
net
s
let
ppost
=
sort
$
post
net
p
spost
=
sort
$
post
net
s
in
null
(
ppost
`
intersect
`
spost
)
||
ppost
==
spost
checkStructure
net
Parallel
=
any
(
checkParallelT
net
)
(
transitions
net
)
checkStructure
net
FinalPlace
=
length
(
filter
finalPlace
(
places
net
))
==
1
where
finalPlace
p
=
null
(
post
net
p
)
&&
all
(
\
t
->
length
(
post
net
t
)
==
1
)
(
pre
net
p
)
checkParallelT
::
PetriNet
->
String
->
Bool
checkParallelT
net
t
=
any
postComp
[(
p
,
s
)
|
p
<-
post
net
t
,
s
<-
post
net
t
]
where
postComp
(
p
,
s
)
=
let
ppost
=
sort
$
post
net
p
spost
=
sort
$
post
net
s
in
p
/=
s
&&
not
(
null
ppost
)
&&
not
(
null
spost
)
&&
ppost
/=
spost
&&
any
(
\
u
->
length
(
pre
net
u
)
==
1
)
ppost
&&
any
(
\
u
->
length
(
pre
net
u
)
==
1
)
spost
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