05.11., 9:00 - 11:00: Due to updates GitLab may be unavailable for some minutes between 09:00 and 11:00.

Commit c61e5ef7 authored by Stefan Jaax's avatar Stefan Jaax

Merge branch 'json' into 'master'

Json

See merge request i7/peregrine!1
parents cb83555d c1c7e6b2
...@@ -16,47 +16,39 @@ and the build system [cabal >= 1.22](https://www.haskell.org/cabal/). ...@@ -16,47 +16,39 @@ and the build system [cabal >= 1.22](https://www.haskell.org/cabal/).
Input Input
------ ------
Peregrine takes a single population protocol as input. Peregrine takes a single population protocol as JSON-encoded input.
The following example shows how a protocol is encoded: The following example shows the input format:
``` ```
population protocol "Majority Protocol" { {
states { a b a_small b_small} "title": "Majority Protocol",
transitions { t1 t2 t3 t4 } "states": ["A", "a", "B", "b"],
arcs { { a, b } -> t1 -> { a_small, b_small } "transitions": [
{ b, a_small } -> t2 -> { b, b_small } { "name": "t1",
{ a, b_small } -> t3 -> { a, a_small } "pre": ["A", "B"],
{ a_small, b_small } -> t4 -> { a_small, a_small } "post": ["a", "b"]
} },
initial { a b } { "name": "t2",
true { a a_small } "pre": ["B", "a"],
false { b b_small } "post": ["B", "b"]
},
{ "name": "t3",
"pre": ["A", "b"],
"post": ["A", "a"]
},
{ "name": "t4",
"pre": ["a", "b"],
"post": ["a", "a"]
}
],
initialStates: ["A", "B"],
trueStates: ["A", "a"],
predicate: "A >= B",
description: "This protocol computes whether there are more B-states than A-states"
} }
``` ```
* After the keyword *population protocol* the name of the protocol is given in
quotes.
* Finite sets are specified in braces
through space- or comma-separated lists of names.
Names consist of alphanumerical characters or underscores.
* The set of states is given after the identifier *states*.
* In order to make transitions identifiable,
each transition must be given a name after the keyword *transitions*.
* Transitions are defined after the keyword *arcs*; there must be one definition
for each transition name.
* The set following the keyword *initial* specifies states that can
belong to an initial population.
* The sets following the keywords *true* and *false* identify the states
that map to true and false, respectively.
Usage Usage
------- -------
......
...@@ -21,6 +21,6 @@ executable pp-print ...@@ -21,6 +21,6 @@ executable pp-print
main-is: Main.hs main-is: Main.hs
other-modules: other-modules:
-- other-extensions: -- other-extensions:
build-depends: multiset, base >= 4.8, containers build-depends: multiset, base >= 4.8, containers, aeson, aeson-pretty, bytestring
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
import System.Environment (getArgs) import System.Environment (getArgs)
import PopulationProtocol import PopulationProtocol
import ProtocolOutput import ProtocolOutput
import qualified Data.ByteString.Lazy as BS
usageAction :: IO () usageAction :: IO ()
usageAction = do usageAction = do
...@@ -20,57 +21,57 @@ usageAction = do ...@@ -20,57 +21,57 @@ usageAction = do
majorityAction :: IO () majorityAction :: IO ()
majorityAction = putStr $ protocolToPetriNet createMajorityProtocol "Majority Protocol" majorityAction = BS.putStr $ pp2JSON createMajorityProtocol "Majority Protocol"
broadCastAction :: IO () broadCastAction :: IO ()
broadCastAction = putStr $ protocolToPetriNet createBroadcastProtocol "BroadCast Protocol" broadCastAction = BS.putStr $ pp2JSON createBroadcastProtocol "BroadCast Protocol"
simpleAction :: IO () simpleAction :: IO ()
simpleAction = putStr $ protocolToPetriNet simpleProtocol "Simple Protocol" simpleAction = BS.putStr $ pp2JSON simpleProtocol "Simple Protocol"
newBirdsAction :: [String] -> IO () newBirdsAction :: [String] -> IO ()
newBirdsAction [x] = let pp = createNewBirdsProtocol (read x) in newBirdsAction [x] = let pp = createNewBirdsProtocol (read x) in
putStr $ protocolToPetriNet pp ("New birds protocol with c = " ++ x) BS.putStr $ pp2JSON pp ("New birds protocol with c = " ++ x)
logFlockOfBirdsAction :: [String] -> IO () logFlockOfBirdsAction :: [String] -> IO ()
logFlockOfBirdsAction [x] = let pp = createLogFlockOfBirdsProtocol (read x) in logFlockOfBirdsAction [x] = let pp = createLogFlockOfBirdsProtocol (read x) in
putStr $ protocolToPetriNet pp ("Log Flock of birds protocol with c = " ++ x) BS.putStr $ pp2JSON pp ("Log Flock of birds protocol with c = " ++ x)
effThresholdAction :: [String] -> IO () effThresholdAction :: [String] -> IO ()
effThresholdAction [x] = let pp = createEfficientThresholdProtocol (read x) in effThresholdAction [x] = let pp = createEfficientThresholdProtocol (read x) in
putStr $ protocolToPetriNet pp ("Efficient Flock of birds protocol with c = " ++ x) BS.putStr $ pp2JSON pp ("Efficient Flock of birds protocol with c = " ++ x)
flockOfBirdsAction :: [String] -> IO () flockOfBirdsAction :: [String] -> IO ()
flockOfBirdsAction [x] = let pp = createFlockOfBirdsProtocol (read x) in flockOfBirdsAction [x] = let pp = createFlockOfBirdsProtocol (read x) in
putStr $ protocolToPetriNet pp ("Flock of birds protocol with c = " ++ x) BS.putStr $ pp2JSON pp ("Flock of birds protocol with c = " ++ x)
verifiableFlockOfBirdsAction :: [String] -> IO () verifiableFlockOfBirdsAction :: [String] -> IO ()
verifiableFlockOfBirdsAction [x] = let pp = createVerifiableFlockOfBirdsProtocol (read x) in verifiableFlockOfBirdsAction [x] = let pp = createVerifiableFlockOfBirdsProtocol (read x) in
putStr $ protocolToPetriNet pp ("Verifiable flock of birds protocol with c = " ++ x) BS.putStr $ pp2JSON pp ("Verifiable flock of birds protocol with c = " ++ x)
oldThresholdAction :: [String] -> IO () oldThresholdAction :: [String] -> IO ()
oldThresholdAction [x, y] = let pp = createOldThresholdProtocol (read x) (read y) in oldThresholdAction [x, y] = let pp = createOldThresholdProtocol (read x) (read y) in
putStr $ protocolToPetriNet pp ("Old Threshold Protocol with l = " ++ x ++ " and c = " ++ y) BS.putStr $ pp2JSON pp ("Old Threshold Protocol with l = " ++ x ++ " and c = " ++ y)
oldThresholdAction _ = usageAction oldThresholdAction _ = usageAction
thresholdAction :: [String] -> IO () thresholdAction :: [String] -> IO ()
thresholdAction [x, y] = let (Just pp) = createThresholdProtocol (read x) (read y) in thresholdAction [x, y] = let (Just pp) = createThresholdProtocol (read x) (read y) in
putStr $ protocolToPetriNet pp ("Threshold Protocol with l = " ++ x ++ " and c = " ++ y) BS.putStr $ pp2JSON pp ("Threshold Protocol with l = " ++ x ++ " and c = " ++ y)
thresholdAction _ = usageAction thresholdAction _ = usageAction
moduloAction :: [String] -> IO () moduloAction :: [String] -> IO ()
moduloAction [x, y] = let pp = createModuloProtocol (read x) (read y) in moduloAction [x, y] = let pp = createModuloProtocol (read x) (read y) in
putStr $ protocolToPetriNet pp ("Modulo Protocol with m = " ++ x ++ " and c = " ++ y) BS.putStr $ pp2JSON pp ("Modulo Protocol with m = " ++ x ++ " and c = " ++ y)
moduloAction _ = usageAction moduloAction _ = usageAction
layeredProtocolAction :: [String] -> IO () layeredProtocolAction :: [String] -> IO ()
layeredProtocolAction [m] = let pp = createMLayerProtocol (read m) in layeredProtocolAction [m] = let pp = createMLayerProtocol (read m) in
putStr $ protocolToPetriNet pp ("Layered Protocol with m = " ++ m ++ " layers.") BS.putStr $ pp2JSON pp ("Layered Protocol with m = " ++ m ++ " layers.")
main = do main = do
args <- getArgs args <- getArgs
......
{-# LANGUAGE DeriveGeneric #-}
module ProtocolOutput where module ProtocolOutput where
import Util import Util
import PopulationProtocol import qualified PopulationProtocol as P
import Data.Aeson
import Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy as BS
import GHC.Generics (Generic)
nonSilentActions :: (Ord qs) => PopulationProtocol qs -> [(qs, qs)] nonSilentActions :: (Ord qs) => P.PopulationProtocol qs -> [(qs, qs)]
nonSilentActions pp = [(q1, q2) | q1 <- states pp nonSilentActions pp = [(q1, q2) | q1 <- P.states pp
, q2 <- states pp , q2 <- P.states pp
, q1 <= q2 , q1 <= q2
, (trans pp) (q1, q2) /= (q1, q2) , (P.trans pp) (q1, q2) /= (q1, q2)
, (trans pp) (q1, q2) /= (q2, q1)] , (P.trans pp) (q1, q2) /= (q2, q1)]
places :: (Show qs) => qs -> qs -> String places :: (Show qs) => qs -> qs -> String
places q1 q2 = "{ " ++ toVar q1 ++ ", " ++ toVar q2 ++ " }" places q1 q2 = "{ " ++ toVar q1 ++ ", " ++ toVar q2 ++ " }"
data TransStruct = TransStruct { name :: String
, pre :: [String]
, post :: [String]
} deriving (Eq, Ord, Show, Generic)
data PPStruct = PPStruct { title :: String
, states :: [String]
, transitions :: [TransStruct]
, initialStates :: [String]
, trueStates :: [String]
, predicate :: Maybe String
} deriving (Eq, Ord, Show, Generic)
instance ToJSON TransStruct
instance ToJSON PPStruct
protocolToPetriNet :: (Show qs, Ord qs) => PopulationProtocol qs -> String -> String pp2JSON :: (Show qs, Ord qs) => P.PopulationProtocol qs -> String -> BS.ByteString
protocolToPetriNet pp name = pp2JSON pp str = encodePretty $
"population protocol " ++ show name ++ " {" ++ "\n" ++ PPStruct { title = str
" states { " ++ unwords (toVar <$> states pp) ++ "}" ++ "\n" ++ , states = toVar <$> P.states pp
" transitions { " ++ unwords (transToVar <$> nonSilentActions pp) ++ " }" ++ "\n" ++ , transitions = [ TransStruct { name = transToVar (q1, q2)
" arcs {" ++ "\n" ++ , pre = toVar <$> [q1, q2]
unlines [" " ++ places q1 q2 ++ " -> " ++ transToVar (q1, q2) ++ " -> " ++ places q1' q2' | , post = toVar <$> [q1', q2']
(q1, q2) <- nonSilentActions pp, let (q1', q2') = (trans pp) (q1, q2)] ++ }
" }\n" ++ | (q1, q2) <- nonSilentActions pp
" initial {" ++ unwords (toVar <$> initial pp) ++ "}\n" ++ , let (q1', q2') = (P.trans pp) (q1, q2)
" true {" ++ unwords (toVar <$> [q | q <- states pp, (opinion pp) q]) ++ "}\n" ++ ]
" false {" ++ unwords (toVar <$> [q | q <- states pp, not ((opinion pp) q)]) ++ "}\n" ++ , initialStates = toVar <$> P.initial pp
(case (predicate pp) of , trueStates = toVar <$> [q | q <- P.states pp, (P.opinion pp) q]
Nothing -> "" , predicate = P.predicate pp
Just p -> " predicate { " ++ p ++ " }\n" }
) ++
"}"
population protocol "Broadcast Protocol" { { "title": "Broadcast Protocol",
states { _true _false } "states": ["true", "false"],
transitions { x_false_true } "transitions": [{ "name": "true,false->true,true",
arcs { "pre": ["true", "false"],
{ _false, _true } -> x_false_true -> { _true, _true } "post": ["true", "true"]
} }
initial { _true _false } ],
true { _true } "initialStates": ["true", "false"],
false { _false } "trueStates": ["true"],
predicate { _true >= 1 } "predicate": "true >= 1"
} }
population protocol "Flock of Birds Protocol (variant 1) with c = 4" {
states { _0 _1 _2 _3 _4 }
transitions { x_0_4 x_1_1 x_1_2 x_1_3 x_1_4 x_2_2 x_2_3 x_2_4 x_3_3 x_3_4 }
arcs {
{ _0, _4 } -> x_0_4 -> { _4, _4 }
{ _1, _1 } -> x_1_1 -> { _2, _0 }
{ _1, _2 } -> x_1_2 -> { _3, _0 }
{ _1, _3 } -> x_1_3 -> { _4, _4 }
{ _1, _4 } -> x_1_4 -> { _4, _4 }
{ _2, _2 } -> x_2_2 -> { _4, _4 }
{ _2, _3 } -> x_2_3 -> { _4, _4 }
{ _2, _4 } -> x_2_4 -> { _4, _4 }
{ _3, _3 } -> x_3_3 -> { _4, _4 }
{ _3, _4 } -> x_3_4 -> { _4, _4 }
}
initial { _0 _1 }
true { _4 }
false { _0 _1 _2 _3 }
predicate { _1 >= 4 }
}
population protocol "Flock of Birds Protocol (variant 2) with c = 4" {
states { _0 _1 _2 _3 _4 }
transitions { x_0_4 x_1_1 x_1_4 x_2_2 x_2_4 x_3_3 x_3_4 }
arcs {
{ _0, _4 } -> x_0_4 -> { _4, _4 }
{ _1, _1 } -> x_1_1 -> { _1, _2 }
{ _1, _4 } -> x_1_4 -> { _4, _4 }
{ _2, _2 } -> x_2_2 -> { _2, _3 }
{ _2, _4 } -> x_2_4 -> { _4, _4 }
{ _3, _3 } -> x_3_3 -> { _3, _4 }
{ _3, _4 } -> x_3_4 -> { _4, _4 }
}
initial { _0 _1 }
true { _4 }
false { _0 _1 _2 _3 }
predicate { _1 >= 4 }
}
population protocol "Majority Protocol" { {
states { good bad neutral mildlybad } "transitions": [
transitions { x_good_bad x_good_mildlybad x_bad_neutral x_neutral_mildlybad } {
arcs { "pre": [
{ good, bad } -> x_good_bad -> { neutral, mildlybad } "_a",
{ good, mildlybad } -> x_good_mildlybad -> { good, neutral } "_b"
{ bad, neutral } -> x_bad_neutral -> { bad, mildlybad } ],
{ neutral, mildlybad } -> x_neutral_mildlybad -> { mildlybad, mildlybad } "post": [
} "_asmall",
initial { good bad } "_bsmall"
true { good neutral } ],
false { bad mildlybad } "name": "x__a__b"
predicate { good > bad } },
} {
"pre": [
"_a",
"_bsmall"
],
"post": [
"_a",
"_asmall"
],
"name": "x__a__bsmall"
},
{
"pre": [
"_b",
"_asmall"
],
"post": [
"_b",
"_bsmall"
],
"name": "x__b__asmall"
},
{
"pre": [
"_asmall",
"_bsmall"
],
"post": [
"_bsmall",
"_bsmall"
],
"name": "x__asmall__bsmall"
}
],
"states": [
"_a",
"_b",
"_asmall",
"_bsmall"
],
"initialStates": [
"_a",
"_b"
],
"predicate": "_a > _b",
"trueStates": [
"_a",
"_asmall"
],
"title": "Majority Protocol"
}
\ No newline at end of file
population protocol "Remainder Protocol with m = 3 and c = 1" { {
states { _0 _1 _2 _true _false } "transitions": [
transitions { x_0_0 x_0_1 x_0_2 x_0_true x_1_1 x_1_2 x_1_false x_2_2 x_2_true } {
arcs { "pre": [
{ _0, _0 } -> x_0_0 -> { _0, _false } "_mod0",
{ _0, _1 } -> x_0_1 -> { _1, _true } "_mod0"
{ _0, _2 } -> x_0_2 -> { _2, _false } ],
{ _0, _true } -> x_0_true -> { _0, _false } "post": [
{ _1, _1 } -> x_1_1 -> { _2, _false } "_mod0",
{ _1, _2 } -> x_1_2 -> { _0, _false } "_modpassivefalse"
{ _1, _false } -> x_1_false -> { _1, _true } ],
{ _2, _2 } -> x_2_2 -> { _1, _true } "name": "x__mod0__mod0"
{ _2, _true } -> x_2_true -> { _2, _false } },
} {
initial { _0 _1 _2 } "pre": [
true { _1 _true } "_mod0",
false { _0 _2 _false } "_mod1"
predicate { ],
EXISTS k : _1 + 2 * _2 = 1 + 3*k "post": [
} "_mod1",
} "_modpassivetrue"
],
"name": "x__mod0__mod1"
},
{
"pre": [
"_mod0",
"_mod2"
],
"post": [
"_mod2",
"_modpassivefalse"
],
"name": "x__mod0__mod2"
},
{
"pre": [
"_mod0",
"_modpassivetrue"
],
"post": [
"_mod0",
"_modpassivefalse"
],
"name": "x__mod0__modpassivetrue"
},
{
"pre": [
"_mod1",
"_mod1"
],
"post": [
"_mod2",
"_modpassivefalse"
],
"name": "x__mod1__mod1"
},
{
"pre": [
"_mod1",
"_mod2"
],
"post": [
"_mod0",
"_modpassivefalse"
],
"name": "x__mod1__mod2"
},
{
"pre": [
"_mod1",
"_modpassivefalse"
],
"post": [
"_mod1",
"_modpassivetrue"
],
"name": "x__mod1__modpassivefalse"
},
{
"pre": [
"_mod2",
"_mod2"
],
"post": [
"_mod1",
"_modpassivetrue"
],
"name": "x__mod2__mod2"
},
{
"pre": [
"_mod2",
"_modpassivetrue"
],
"post": [
"_mod2",
"_modpassivefalse"
],
"name": "x__mod2__modpassivetrue"
}
],
"states": [
"_mod0",
"_mod1",
"_mod2",
"_modpassivetrue",
"_modpassivefalse"
],
"initialStates": [
"_mod0",
"_mod1",
"_mod2"
],
"predicate": "EXISTS k : 0 * _mod0 + 1 * _mod1 + 2 * _mod2 = 1 + 3 * k",
"trueStates": [
"_mod1",
"_modpassivetrue"
],
"title": "Modulo Protocol with m = 3 and c = 1"
}
\ No newline at end of file
This diff is collapsed.
...@@ -22,8 +22,8 @@ executable peregrine ...@@ -22,8 +22,8 @@ executable peregrine
main-is: Main.hs main-is: Main.hs
other-modules: other-modules:
-- other-extensions: -- other-extensions:
build-depends: base >=4 && <5, sbv, parsec, containers, transformers, build-depends: base >=4 && <5, sbv, parsec >= 3.1, containers, transformers,
bytestring, mtl, stm, async, parallel-io bytestring, mtl, stm, async, parallel-io, text, aeson
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -fsimpl-tick-factor=1000 -threaded -rtsopts -with-rtsopts=-N ghc-options: -fsimpl-tick-factor=1000 -threaded -rtsopts -with-rtsopts=-N
...@@ -3,6 +3,8 @@ module Parser ...@@ -3,6 +3,8 @@ module Parser
where where
import Text.Parsec import Text.Parsec
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
type Parser a = Parsec String () a type Parser a = Parsec String () a
...@@ -14,7 +16,7 @@ parseString p str = ...@@ -14,7 +16,7 @@ parseString p str =
parseFile :: Parser a -> String -> IO a parseFile :: Parser a -> String -> IO a
parseFile p file = do parseFile p file = do
contents <- readFile file contents <- T.unpack <$> TIO.readFile file
case parse p file contents of case parse p file contents of
Left e -> print e >> fail "parse error" Left e -> print e >> fail "parse error"
Right r -> return r Right r -> return r
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Parser.PP module Parser.PP
(parseContent) (parseContent)
where where
import Data.Aeson
import Data.Aeson.TH (deriveJSON, defaultOptions)
import Control.Applicative ((<*),(*>),(<$>)) import Control.Applicative ((<*),(*>),(<$>))
import Data.Functor.Identity import Data.Functor.Identity
import Text.Parsec import Text.Parsec
import qualified Data.Set as S
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.Text as T