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
c51c68df
Commit
c51c68df
authored
Jul 24, 2014
by
Philipp Meyer
Browse files
Made output much faster by using byte string builders
parent
f0373636
Changes
5
Hide whitespace changes
Inline
Side-by-side
slapnet.cabal
View file @
c51c68df
...
...
@@ -21,6 +21,8 @@ executable slapnet
main-is: Main.hs
other-modules:
-- other-extensions:
build-depends: base >=4 && <5, sbv, parsec, containers, transformers
build-depends: base >=4 && <5, sbv, parsec, containers, transformers,
bytestring
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -fsimpl-tick-factor=1000
src/Main.hs
View file @
c51c68df
...
...
@@ -10,6 +10,7 @@ import Control.Monad
import
Control.Applicative
((
<$>
))
import
Control.Arrow
(
first
)
import
Data.List
(
partition
)
import
qualified
Data.ByteString.Lazy
as
L
import
Parser
import
qualified
Parser.PNET
as
PNET
...
...
@@ -180,16 +181,16 @@ parseArgs = do
writeFiles
::
Int
->
String
->
PetriNet
->
[
Property
]
->
IO
()
writeFiles
verbosity
basename
net
props
=
do
verbosePut
verbosity
1
$
"Writing "
++
showNetName
net
++
" to "
++
basename
writeFile
basename
$
LOLAPrinter
.
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
writeFile
file
$
LOLAPrinter
.
printProperty
p
L
.
writeFile
file
$
LOLAPrinter
.
printProperty
p
)
(
zip
props
[(
1
::
Integer
)
..
])
verbosePut
verbosity
1
$
"Writing properties to "
++
basename
++
".sara"
writeFile
(
basename
++
".sara"
)
$
unlines
$
map
(
SARAPrinter
.
printPropert
y
basename
net
)
props
L
.
writeFile
(
basename
++
".sara"
)
$
SARAPrinter
.
printPropert
ies
basename
net
props
checkFile
::
Parser
(
PetriNet
,[
Property
])
->
Int
->
Bool
->
[
ImplicitProperty
]
->
[
NetTransformation
]
->
...
...
@@ -206,10 +207,10 @@ checkFile parser verbosity refine implicitProperties transformations
"Places: "
++
show
(
length
$
places
net'
)
++
"; "
++
"Transitions: "
++
show
(
length
$
transitions
net'
)
verbosePut
verbosity
3
$
show
net'
rs
<-
mapM
(
checkProperty
verbosity
net'
refine
)
props'''
case
output
of
Just
outputfile
->
writeFiles
verbosity
outputfile
net'
props'''
Nothing
->
return
()
rs
<-
mapM
(
checkProperty
verbosity
net'
refine
)
props'''
verbosePut
verbosity
0
""
return
$
and
rs
...
...
src/Printer.hs
View file @
c51c68df
module
Printer
(
validateId
)
(
validateId
,
intercalate
)
where
import
Data.Char
import
Data.ByteString.Builder
import
Data.Monoid
validateId
::
String
->
String
validateId
""
=
"_"
validateId
(
x
:
xs
)
=
(
if
isAlpha
x
then
x
else
'_'
)
:
map
(
\
c
->
if
isAlphaNum
c
then
c
else
'_'
)
xs
intercalate
::
Builder
->
[
Builder
]
->
Builder
intercalate
_
[]
=
mempty
intercalate
sep
(
x
:
xs
)
=
x
<>
go
xs
where
go
=
foldr
(
\
y
->
(
<>
)
(
sep
<>
y
))
mempty
src/Printer/LOLA.hs
View file @
c51c68df
{-# LANGUAGE OverloadedStrings #-}
module
Printer.LOLA
(
printNet
,
printProperty
)
where
import
Data.List
(
intercalate
)
import
qualified
Data.ByteString.Lazy
as
L
import
Data.ByteString.Builder
import
Data.Monoid
import
Printer
import
PetriNet
import
Property
printNet
::
PetriNet
->
String
printNet
net
=
let
showWeight
(
p
,
x
)
=
p
++
":"
++
show
x
ps
=
"PLACE "
++
intercalate
","
(
places
net
)
++
";
\n
"
is
=
"MARKING "
++
intercalate
","
(
map
showWeight
(
initials
net
))
++
";
\n
"
renderNet
::
PetriNet
->
Builder
renderNet
net
=
let
showWeight
(
p
,
x
)
=
stringUtf8
p
<>
":"
<>
integerDec
x
ps
=
"PLACE "
<>
intercalate
","
(
map
stringUtf8
(
places
net
))
<>
";
\n
"
is
=
"MARKING "
<>
intercalate
","
(
map
showWeight
(
initials
net
))
<>
";
\n
"
makeTransition
t
=
let
(
preT
,
postT
)
=
context
net
t
preS
=
"CONSUME "
++
intercalate
","
(
map
showWeight
preT
)
++
";
\n
"
postS
=
"PRODUCE "
++
intercalate
","
(
map
showWeight
postT
)
++
";
\n
"
in
"TRANSITION "
++
t
++
"
\n
"
++
preS
++
postS
preS
=
"CONSUME "
<>
intercalate
","
(
map
showWeight
preT
)
<>
";
\n
"
postS
=
"PRODUCE "
<>
intercalate
","
(
map
showWeight
postT
)
<>
";
\n
"
in
"TRANSITION "
<>
stringUtf8
t
<>
"
\n
"
<>
preS
<>
postS
ts
=
map
makeTransition
(
transitions
net
)
in
unlines
(
ps
:
is
:
ts
)
printTerm
::
Term
->
String
printTerm
(
Var
x
)
=
x
printTerm
(
Const
c
)
=
show
c
printTerm
(
Minus
t
)
=
"-"
++
printTerm
t
printTerm
(
t
:+:
u
)
=
"("
++
printTerm
t
++
" + "
++
printTerm
u
++
")"
printTerm
(
t
:-:
u
)
=
"("
++
printTerm
t
++
" - "
++
printTerm
u
++
")"
printTerm
(
t
:*:
u
)
=
printTerm
t
++
" * "
++
printTerm
u
printOp
::
Op
->
String
printOp
Gt
=
" > "
printOp
Ge
=
" >= "
printOp
Eq
=
" = "
printOp
Ne
=
" != "
printOp
Le
=
" <= "
printOp
Lt
=
" < "
printLinIneq
::
LinearInequation
->
String
printLinIneq
(
LinIneq
lhs
op
rhs
)
=
printTerm
lhs
++
printOp
op
++
printTerm
rhs
printFormula
::
Formula
->
String
printFormula
FTrue
=
"TRUE"
printFormula
FFalse
=
"FALSE"
printFormula
(
Atom
a
)
=
printLinIneq
a
printFormula
(
Neg
p
)
=
"NOT "
++
"("
++
printFormula
p
++
")"
printFormula
(
p
:&:
q
)
=
printFormula
p
++
" AND "
++
printFormula
q
printFormula
(
p
:|:
q
)
=
"("
++
printFormula
p
++
" OR "
++
printFormula
q
++
")"
printProperty
::
Property
->
String
printProperty
(
Property
_
Safety
f
)
=
"EF ("
++
printFormula
f
++
")
\n
"
printProperty
(
Property
_
Liveness
_
)
=
in
intercalate
"
\n
"
(
ps
:
is
:
ts
)
printNet
::
PetriNet
->
L
.
ByteString
printNet
=
toLazyByteString
.
renderNet
renderTerm
::
Term
->
Builder
renderTerm
(
Var
x
)
=
stringUtf8
x
renderTerm
(
Const
c
)
=
integerDec
c
renderTerm
(
Minus
t
)
=
"-"
<>
renderTerm
t
renderTerm
(
t
:+:
u
)
=
"("
<>
renderTerm
t
<>
" + "
<>
renderTerm
u
<>
")"
renderTerm
(
t
:-:
u
)
=
"("
<>
renderTerm
t
<>
" - "
<>
renderTerm
u
<>
")"
renderTerm
(
t
:*:
u
)
=
renderTerm
t
<>
" * "
<>
renderTerm
u
renderOp
::
Op
->
Builder
renderOp
Gt
=
" > "
renderOp
Ge
=
" >= "
renderOp
Eq
=
" = "
renderOp
Ne
=
" != "
renderOp
Le
=
" <= "
renderOp
Lt
=
" < "
renderLinIneq
::
LinearInequation
->
Builder
renderLinIneq
(
LinIneq
lhs
op
rhs
)
=
renderTerm
lhs
<>
renderOp
op
<>
renderTerm
rhs
renderFormula
::
Formula
->
Builder
renderFormula
FTrue
=
"TRUE"
renderFormula
FFalse
=
"FALSE"
renderFormula
(
Atom
a
)
=
renderLinIneq
a
renderFormula
(
Neg
p
)
=
"NOT "
<>
"("
<>
renderFormula
p
<>
")"
renderFormula
(
p
:&:
q
)
=
renderFormula
p
<>
" AND "
<>
renderFormula
q
renderFormula
(
p
:|:
q
)
=
"("
<>
renderFormula
p
<>
" OR "
<>
renderFormula
q
<>
")"
renderProperty
::
Property
->
Builder
renderProperty
(
Property
_
Safety
f
)
=
"EF ("
<>
renderFormula
f
<>
")
\n
"
renderProperty
(
Property
_
Liveness
_
)
=
error
"liveness property not supported for lola"
printProperty
::
Property
->
L
.
ByteString
printProperty
=
toLazyByteString
.
renderProperty
src/Printer/SARA.hs
View file @
c51c68df
{-# LANGUAGE OverloadedStrings #-}
module
Printer.SARA
(
printPropert
y
)
(
printPropert
ies
)
where
import
Data.List
(
intercalate
)
import
qualified
Data.ByteString.Lazy
as
L
import
Data.ByteString.Builder
import
Data.Monoid
import
Printer
import
PetriNet
import
Property
printSimpleTerm
::
Integer
->
Term
->
String
printSimpleTerm
fac
(
Var
x
)
=
if
fac
==
1
then
x
else
show
fac
++
x
printSimpleTerm
fac
(
Const
c
)
=
show
(
fac
*
c
)
printSimpleTerm
fac
(
Const
c
:*:
t
)
=
printSimpleTerm
(
fac
*
c
)
t
printSimpleTerm
fac
(
t
:*:
Const
c
)
=
printSimpleTerm
(
fac
*
c
)
t
printSimpleTerm
fac
(
Minus
t
)
=
printSimpleTerm
(
-
fac
)
t
printSimpleTerm
_
t
=
error
$
"term not supported for sara: "
++
show
t
printTerm
::
Term
->
String
printTerm
(
t
:+:
u
)
=
printTerm
t
++
"+"
++
printSimpleTerm
1
u
printTerm
(
t
:-:
u
)
=
printTerm
t
++
"+"
++
printSimpleTerm
(
-
1
)
u
printTerm
t
=
printSimpleTerm
1
t
printOp
::
Op
->
String
printOp
Ge
=
">"
printOp
Eq
=
":"
printOp
Le
=
"<"
printOp
op
=
error
$
"operand not supported for sara: "
++
show
op
printLinIneq
::
LinearInequation
->
String
printLinIneq
(
LinIneq
lhs
op
(
Const
c
))
=
printTerm
lhs
++
printOp
op
++
show
c
printLinIneq
l
=
error
$
"linear inequation not supported for sara: "
++
show
l
printFormula
::
Formula
->
String
printFormula
(
Atom
a
)
=
printLinIneq
a
printFormula
(
Neg
_
)
=
error
"negation not supported for sara"
printFormula
(
p
:&:
q
)
=
printFormula
p
++
","
++
printFormula
q
printFormula
f
=
error
$
"formula not supported for sara: "
++
show
f
printProperty
::
String
->
PetriNet
->
Property
->
String
printProperty
filename
net
(
Property
propname
Safety
f
)
=
"PROBLEM "
++
validateId
propname
++
":
\n
"
++
"GOAL REACHABILITY;
\n
"
++
"FILE "
++
reverse
(
takeWhile
(
/=
'/'
)
(
reverse
filename
))
++
" TYPE LOLA;
\n
"
++
"INITIAL "
++
intercalate
","
(
map
(
\
(
p
,
i
)
->
p
++
":"
++
show
i
)
(
initials
net
))
++
";
\n
"
++
"FINAL COVER;
\n
"
++
"CONSTRAINTS "
++
printFormula
f
++
";"
printProperty
_
_
(
Property
_
Liveness
_
)
=
renderSimpleTerm
::
Integer
->
Term
->
Builder
renderSimpleTerm
fac
(
Var
x
)
=
if
fac
==
1
then
stringUtf8
x
else
integerDec
fac
<>
stringUtf8
x
renderSimpleTerm
fac
(
Const
c
)
=
integerDec
(
fac
*
c
)
renderSimpleTerm
fac
(
Const
c
:*:
t
)
=
renderSimpleTerm
(
fac
*
c
)
t
renderSimpleTerm
fac
(
t
:*:
Const
c
)
=
renderSimpleTerm
(
fac
*
c
)
t
renderSimpleTerm
fac
(
Minus
t
)
=
renderSimpleTerm
(
-
fac
)
t
renderSimpleTerm
_
t
=
error
$
"term not supported for sara: "
<>
show
t
renderTerm
::
Term
->
Builder
renderTerm
(
t
:+:
u
)
=
renderTerm
t
<>
"+"
<>
renderSimpleTerm
1
u
renderTerm
(
t
:-:
u
)
=
renderTerm
t
<>
"+"
<>
renderSimpleTerm
(
-
1
)
u
renderTerm
t
=
renderSimpleTerm
1
t
renderOp
::
Op
->
Builder
renderOp
Ge
=
">"
renderOp
Eq
=
":"
renderOp
Le
=
"<"
renderOp
op
=
error
$
"operand not supported for sara: "
<>
show
op
renderLinIneq
::
LinearInequation
->
Builder
renderLinIneq
(
LinIneq
lhs
op
(
Const
c
))
=
renderTerm
lhs
<>
renderOp
op
<>
integerDec
c
renderLinIneq
l
=
error
$
"linear inequation not supported for sara: "
<>
show
l
renderFormula
::
Formula
->
Builder
renderFormula
(
Atom
a
)
=
renderLinIneq
a
renderFormula
(
Neg
_
)
=
error
"negation not supported for sara"
renderFormula
(
p
:&:
q
)
=
renderFormula
p
<>
","
<>
renderFormula
q
renderFormula
f
=
error
$
"formula not supported for sara: "
<>
show
f
renderProperty
::
String
->
PetriNet
->
Property
->
Builder
renderProperty
filename
net
(
Property
propname
Safety
f
)
=
"PROBLEM "
<>
stringUtf8
(
validateId
propname
)
<>
":
\n
"
<>
"GOAL REACHABILITY;
\n
"
<>
"FILE "
<>
stringUtf8
(
reverse
(
takeWhile
(
/=
'/'
)
(
reverse
filename
)))
<>
" TYPE LOLA;
\n
"
<>
"INITIAL "
<>
intercalate
","
(
map
(
\
(
p
,
i
)
->
stringUtf8
p
<>
":"
<>
integerDec
i
)
(
initials
net
))
<>
";
\n
"
<>
"FINAL COVER;
\n
"
<>
"CONSTRAINTS "
<>
renderFormula
f
<>
";"
renderProperty
_
_
(
Property
_
Liveness
_
)
=
error
"liveness property not supported for sara"
printProperties
::
String
->
PetriNet
->
[
Property
]
->
L
.
ByteString
printProperties
filename
net
props
=
toLazyByteString
$
intercalate
"
\n
"
$
map
(
renderProperty
filename
net
)
props
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