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
1cca0e05
Commit
1cca0e05
authored
Jul 09, 2014
by
Philipp Meyer
Browse files
Extended parser and grammar to allow more liberal terms
parent
c06c711e
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/Main.hs
View file @
1cca0e05
...
...
@@ -137,13 +137,14 @@ checkFile parser verbosity refine implicitProperties file = do
"Places: "
++
show
(
length
$
places
net
)
++
"
\n
"
++
"Transitions: "
++
show
(
length
$
transitions
net
)
let
addedProperties
=
map
(
makeImplicitProperty
net
)
implicitProperties
print
properties
rs
<-
mapM
(
checkProperty
verbosity
net
refine
)
(
addedProperties
++
properties
)
verbosePut
verbosity
0
""
return
$
and
rs
placeOp
::
Op
->
(
String
,
Integer
)
->
Formula
placeOp
op
(
p
,
w
)
=
Atom
$
LinIneq
(
Term
[
Var
1
p
]
)
op
(
Term
[
Const
w
]
)
placeOp
op
(
p
,
w
)
=
Atom
$
LinIneq
(
Var
p
)
op
(
Const
w
)
makeImplicitProperty
::
PetriNet
->
ImplicitProperty
->
Property
makeImplicitProperty
_
Termination
=
Property
"termination"
Liveness
FTrue
...
...
src/Parser/PNET.hs
View file @
1cca0e05
...
...
@@ -2,8 +2,10 @@ module Parser.PNET
(
parseContent
)
where
import
Control.Applicative
((
<*
),(
*>
),(
<*>
),(
<$>
))
import
Control.Applicative
((
<*
),(
*>
),(
<$>
))
import
Data.Functor.Identity
import
Text.Parsec
import
Text.Parsec.Expr
import
Text.Parsec.Language
(
LanguageDef
,
emptyDef
)
import
qualified
Text.Parsec.Token
as
Token
...
...
@@ -20,7 +22,7 @@ languageDef =
Token
.
identStart
=
letter
<|>
char
'_'
,
Token
.
identLetter
=
alphaNum
<|>
char
'_'
,
Token
.
reservedNames
=
[
"true"
,
"false"
],
Token
.
reservedOpNames
=
[
"->"
,
"<"
,
"<="
,
"="
,
">="
,
">"
,
Token
.
reservedOpNames
=
[
"->"
,
"<"
,
"<="
,
"="
,
"!="
,
">="
,
">"
,
"+"
,
"-"
,
"*"
,
"&&"
,
"||"
,
"!"
]
}
...
...
@@ -122,23 +124,31 @@ petriNet = do
Arcs
a
->
(
ps
,
ts
,
a
++
as
,
is
)
Initial
i
->
(
ps
,
ts
,
as
,
i
++
is
)
preFactor
::
Parser
Integer
preFactor
=
(
reservedOp
"-"
*>
return
(
-
1
))
<|>
(
reservedOp
"+"
*>
return
1
)
binary
::
String
->
(
a
->
a
->
a
)
->
Assoc
->
Operator
String
()
Identity
a
binary
name
fun
=
Infix
(
reservedOp
name
*>
return
fun
)
prefix
::
String
->
(
a
->
a
)
->
Operator
String
()
Identity
a
prefix
name
fun
=
Prefix
(
reservedOp
name
*>
return
fun
)
linAtom
::
Integer
->
Parser
LinAtom
linAtom
fac
=
(
integer
>>=
\
lhs
->
option
(
Const
(
fac
*
lhs
))
$
Var
(
fac
*
lhs
)
<$>
(
reservedOp
"*"
*>
ident
)
)
<|>
Var
fac
<$>
ident
termOperatorTable
::
[[
Operator
String
()
Identity
Term
]]
termOperatorTable
=
[
[
prefix
"-"
Minus
]
,
[
binary
"*"
(
:*:
)
AssocLeft
]
,
[
binary
"+"
(
:+:
)
AssocLeft
,
binary
"-"
(
:-:
)
AssocLeft
]
]
termAtom
::
Parser
Term
termAtom
=
parens
term
<|>
(
Const
<$>
integer
)
<|>
(
Var
<$>
ident
)
term
::
Parser
Term
term
=
Term
<$>
((
:
)
<$>
(
option
1
preFactor
>>=
linAtom
)
<*>
many
(
preFactor
>>=
linAtom
))
term
=
buildExpressionParser
termOperatorTable
termAtom
<?>
"term"
parseOp
::
Parser
Op
parseOp
=
(
reservedOp
"<"
*>
return
Lt
)
<|>
(
reservedOp
"<="
*>
return
Le
)
<|>
(
reservedOp
"="
*>
return
Eq
)
<|>
(
reservedOp
"!="
*>
return
Ne
)
<|>
(
reservedOp
">"
*>
return
Gt
)
<|>
(
reservedOp
">="
*>
return
Ge
)
...
...
@@ -149,29 +159,21 @@ linIneq = do
rhs
<-
term
return
(
Atom
(
LinIneq
lhs
op
rhs
))
atom
::
Parser
Formula
atom
=
(
reserved
"true"
*>
return
FTrue
)
<|>
(
reserved
"false"
*>
return
FFalse
)
<|>
linIneq
parensForm
::
Parser
Formula
parensForm
=
atom
<|>
parens
formula
negation
::
Parser
Formula
negation
=
(
Neg
<$>
(
reservedOp
"!"
*>
negation
))
<|>
parensForm
conjunction
::
Parser
Formula
conjunction
=
do
lhs
<-
negation
option
lhs
((
lhs
:&:
)
<$>
(
reservedOp
"&&"
*>
conjunction
))
formOperatorTable
::
[[
Operator
String
()
Identity
Formula
]]
formOperatorTable
=
[
[
prefix
"!"
Neg
]
,
[
binary
"&&"
(
:&:
)
AssocRight
]
,
[
binary
"||"
(
:|:
)
AssocRight
]
]
disjunction
::
Parser
Formula
disjunction
=
do
lhs
<-
conjunction
option
lhs
((
lhs
:|:
)
<$>
(
reservedOp
"||"
*>
disjunction
))
formAtom
::
Parser
Formula
formAtom
=
parens
formula
<|>
(
reserved
"true"
*>
return
FTrue
)
<|>
(
reserved
"false"
*>
return
FFalse
)
<|>
linIneq
formula
::
Parser
Formula
formula
=
disjunction
formula
=
buildExpressionParser
formOperatorTable
formAtom
<?>
"formula"
propertyType
::
Parser
PropertyType
propertyType
=
...
...
src/Property.hs
View file @
1cca0e05
...
...
@@ -7,31 +7,31 @@ module Property
Formula
(
..
),
LinearInequation
(
..
),
Op
(
..
),
Term
(
..
),
LinAtom
(
..
))
Term
(
..
))
where
import
Data.List
(
intercalate
)
data
LinAtom
=
Var
Integer
String
|
Const
Integer
instance
Show
LinAtom
where
show
(
Var
c
x
)
|
c
==
1
=
x
show
(
Var
c
x
)
|
c
==
-
1
=
"-"
++
x
show
(
Var
c
x
)
=
show
c
++
"*"
++
x
show
(
Const
c
)
=
show
c
data
Term
=
Term
[
LinAtom
]
data
Term
=
Var
String
|
Const
Integer
|
Minus
Term
|
Term
:+:
Term
|
Term
:-:
Term
|
Term
:*:
Term
instance
Show
Term
where
show
(
Term
xs
)
=
intercalate
" + "
(
map
show
xs
)
show
(
Var
x
)
=
x
show
(
Const
c
)
=
show
c
show
(
Minus
t
)
=
"-("
++
show
t
++
")"
show
(
t
:+:
u
)
=
show
t
++
" + "
++
show
u
show
(
t
:-:
u
)
=
show
t
++
" - "
++
show
u
show
(
t
:*:
u
)
=
"("
++
show
t
++
") * ("
++
show
u
++
")"
data
Op
=
Gt
|
Ge
|
Eq
|
Le
|
Lt
data
Op
=
Gt
|
Ge
|
Eq
|
Ne
|
Le
|
Lt
instance
Show
Op
where
show
Gt
=
">"
show
Ge
=
"≥"
show
Eq
=
"="
show
Ne
=
"≠"
show
Le
=
"≤"
show
Lt
=
"<"
...
...
src/Solver/Formula.hs
View file @
1cca0e05
...
...
@@ -8,14 +8,18 @@ import Property
import
Solver
evaluateTerm
::
Term
->
ModelSI
->
SInteger
evaluateTerm
(
Term
xs
)
m
=
sum
$
map
evaluateLinAtom
xs
where
evaluateLinAtom
(
Var
c
x
)
=
literal
c
*
mVal
m
x
evaluateLinAtom
(
Const
c
)
=
literal
c
evaluateTerm
(
Var
x
)
m
=
mVal
m
x
evaluateTerm
(
Const
c
)
_
=
literal
c
evaluateTerm
(
Minus
t
)
m
=
-
evaluateTerm
t
m
evaluateTerm
(
t
:+:
u
)
m
=
evaluateTerm
t
m
+
evaluateTerm
u
m
evaluateTerm
(
t
:-:
u
)
m
=
evaluateTerm
t
m
-
evaluateTerm
u
m
evaluateTerm
(
t
:*:
u
)
m
=
evaluateTerm
t
m
*
evaluateTerm
u
m
opToFunction
::
Op
->
SInteger
->
SInteger
->
SBool
opToFunction
Gt
=
(
.>
)
opToFunction
Ge
=
(
.>=
)
opToFunction
Eq
=
(
.==
)
opToFunction
Ne
=
(
./=
)
opToFunction
Le
=
(
.<=
)
opToFunction
Lt
=
(
.<
)
...
...
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