Commit c9113b43 authored by Philipp Meyer's avatar Philipp Meyer

Rename options and properties

parent 1809caa1
...@@ -21,8 +21,8 @@ import qualified Printer.DOT as DOTPrinter ...@@ -21,8 +21,8 @@ import qualified Printer.DOT as DOTPrinter
import Property import Property
import StructuralComputation import StructuralComputation
import Solver import Solver
import Solver.TerminalMarkingsUniqueConsensus import Solver.LayeredTermination
import Solver.TerminalMarkingReachable import Solver.StrongConsensus
writeFiles :: String -> PopulationProtocol -> [Property] -> OptIO () writeFiles :: String -> PopulationProtocol -> [Property] -> OptIO ()
writeFiles basename pp props = do writeFiles basename pp props = do
...@@ -47,9 +47,8 @@ checkFile file = do ...@@ -47,9 +47,8 @@ checkFile file = do
format <- opt inputFormat format <- opt inputFormat
let parser = case format of let parser = case format of
InPP -> PPParser.parseContent InPP -> PPParser.parseContent
(pp,props) <- liftIO $ parseFile parser file pp <- liftIO $ parseFile parser file
implicitProperties <- opt optProperties props <- opt optProperties
let props' = props ++ map (makeImplicitProperty pp) implicitProperties
verbosePut 1 $ "Analyzing " ++ showNetName pp verbosePut 1 $ "Analyzing " ++ showNetName pp
verbosePut 2 $ verbosePut 2 $
"Number of states: " ++ show (length (states pp)) "Number of states: " ++ show (length (states pp))
...@@ -65,33 +64,22 @@ checkFile file = do ...@@ -65,33 +64,22 @@ checkFile file = do
output <- opt optOutput output <- opt optOutput
case output of case output of
Just outputfile -> Just outputfile ->
writeFiles outputfile pp props' writeFiles outputfile pp props
Nothing -> return () Nothing -> return ()
-- TODO: short-circuit? parallel? -- TODO: short-circuit? parallel?
rs <- mapM (checkProperty pp) props' rs <- mapM (checkProperty pp) props
verbosePut 0 "" verbosePut 0 ""
return $ resultsAnd rs return $ resultsAnd rs
makeImplicitProperty :: PopulationProtocol -> ImplicitProperty -> Property
makeImplicitProperty _ TerminalMarkingsUniqueConsensus =
Property "reachable terminal markings have a unique consensus" $ Constraint TerminalMarkingsUniqueConsensusConstraint
makeImplicitProperty _ TerminalMarkingReachable =
Property "terminal marking reachable" $ Constraint TerminalMarkingReachableConstraint
checkProperty :: PopulationProtocol -> Property -> OptIO PropResult checkProperty :: PopulationProtocol -> Property -> OptIO PropResult
checkProperty pp p = do checkProperty pp prop = do
verbosePut 1 $ "\nChecking " ++ showPropertyName p verbosePut 1 $ "\nChecking " ++ show prop
verbosePut 3 $ show p r <- case prop of
r <- case pcont p of Correctness -> error "not yet implemented"
-- (Safety pf) -> checkSafetyProperty pp pf LayeredTermination -> checkLayeredTermination pp
-- (Liveness pf) -> checkLivenessProperty pp pf StrongConsensus -> checkStrongConsensus pp
(Constraint pc) -> checkConstraintProperty pp pc verbosePut 0 $ show prop ++ " " ++ show r
verbosePut 0 $ showPropertyName p ++ " " ++
case r of
Satisfied -> "is satisfied."
Unsatisfied -> "is not satisfied."
Unknown-> "may not be satisfied."
return r return r
printInvariant :: (Show a, Invariant a) => (Maybe [a], [a]) -> OptIO PropResult printInvariant :: (Show a, Invariant a) => (Maybe [a], [a]) -> OptIO PropResult
...@@ -112,66 +100,60 @@ printInvariant (baseInvResult, addedInv) = ...@@ -112,66 +100,60 @@ printInvariant (baseInvResult, addedInv) =
mapM_ (putLine . show) addedInv mapM_ (putLine . show) addedInv
return Satisfied return Satisfied
checkConstraintProperty :: PopulationProtocol -> ConstraintProperty -> OptIO PropResult checkStrongConsensus :: PopulationProtocol -> OptIO PropResult
checkConstraintProperty pp cp = checkStrongConsensus pp = do
case cp of r <- checkStrongConsensus' pp [] [] []
TerminalMarkingsUniqueConsensusConstraint -> checkTerminalMarkingsUniqueConsensusProperty pp
TerminalMarkingReachableConstraint -> checkTerminalMarkingReachableProperty pp
checkTerminalMarkingsUniqueConsensusProperty :: PopulationProtocol -> OptIO PropResult
checkTerminalMarkingsUniqueConsensusProperty pp = do
r <- checkTerminalMarkingsUniqueConsensusProperty' pp [] [] []
case r of case r of
(Nothing, _, _, _) -> return Satisfied (Nothing, _, _, _) -> return Satisfied
(Just _, _, _, _) -> return Unknown (Just _, _, _, _) -> return Unknown
checkTerminalMarkingsUniqueConsensusProperty' :: PopulationProtocol -> checkStrongConsensus' :: PopulationProtocol ->
[Trap] -> [Siphon] -> [StableInequality] -> [Trap] -> [Siphon] -> [StableInequality] ->
OptIO (Maybe TerminalMarkingsUniqueConsensusCounterExample, [Trap], [Siphon], [StableInequality]) OptIO (Maybe StrongConsensusCounterExample, [Trap], [Siphon], [StableInequality])
checkTerminalMarkingsUniqueConsensusProperty' pp utraps usiphons inequalities = do checkStrongConsensus' pp utraps usiphons inequalities = do
r <- checkSat $ checkTerminalMarkingsUniqueConsensusSat pp utraps usiphons inequalities r <- checkSat $ checkStrongConsensusSat pp utraps usiphons inequalities
case r of case r of
Nothing -> return (Nothing, utraps, usiphons, inequalities) Nothing -> return (Nothing, utraps, usiphons, inequalities)
Just c -> do Just c -> do
refine <- opt optRefinementType refine <- opt optRefinementType
if isJust refine then if isJust refine then
refineTerminalMarkingsUniqueConsensusProperty pp utraps usiphons inequalities c refineStrongConsensus pp utraps usiphons inequalities c
else else
return (Just c, utraps, usiphons, inequalities) return (Just c, utraps, usiphons, inequalities)
refineTerminalMarkingsUniqueConsensusProperty :: PopulationProtocol -> refineStrongConsensus :: PopulationProtocol ->
[Trap] -> [Siphon] -> [StableInequality] -> TerminalMarkingsUniqueConsensusCounterExample -> [Trap] -> [Siphon] -> [StableInequality] -> StrongConsensusCounterExample ->
OptIO (Maybe TerminalMarkingsUniqueConsensusCounterExample, [Trap], [Siphon], [StableInequality]) OptIO (Maybe StrongConsensusCounterExample, [Trap], [Siphon], [StableInequality])
refineTerminalMarkingsUniqueConsensusProperty pp utraps usiphons inequalities c@(m0, m1, m2, x1, x2) = do refineStrongConsensus pp utraps usiphons inequalities c@(m0, m1, m2, x1, x2) = do
r1 <- checkSatMin $ Solver.TerminalMarkingsUniqueConsensus.findTrapConstraintsSat pp m0 m1 m2 x1 x2 r1 <- checkSatMin $ Solver.StrongConsensus.findTrapConstraintsSat pp m0 m1 m2 x1 x2
case r1 of case r1 of
Nothing -> do Nothing -> do
r2 <- checkSatMin $ Solver.TerminalMarkingsUniqueConsensus.findUSiphonConstraintsSat pp m0 m1 m2 x1 x2 r2 <- checkSatMin $ Solver.StrongConsensus.findUSiphonConstraintsSat pp m0 m1 m2 x1 x2
case r2 of case r2 of
Nothing -> do Nothing -> do
r3 <- checkSatMin $ Solver.TerminalMarkingsUniqueConsensus.findUTrapConstraintsSat pp m0 m1 m2 x1 x2 r3 <- checkSatMin $ Solver.StrongConsensus.findUTrapConstraintsSat pp m0 m1 m2 x1 x2
case r3 of case r3 of
Nothing -> return (Just c, utraps, usiphons, inequalities) Nothing -> return (Just c, utraps, usiphons, inequalities)
Just utrap -> Just utrap ->
checkTerminalMarkingsUniqueConsensusProperty' pp (utrap:utraps) usiphons inequalities checkStrongConsensus' pp (utrap:utraps) usiphons inequalities
Just usiphon -> Just usiphon ->
checkTerminalMarkingsUniqueConsensusProperty' pp utraps (usiphon:usiphons) inequalities checkStrongConsensus' pp utraps (usiphon:usiphons) inequalities
Just trap -> Just trap ->
checkTerminalMarkingsUniqueConsensusProperty' pp (trap:utraps) usiphons inequalities checkStrongConsensus' pp (trap:utraps) usiphons inequalities
checkTerminalMarkingReachableProperty :: PopulationProtocol -> OptIO PropResult checkLayeredTermination :: PopulationProtocol -> OptIO PropResult
checkTerminalMarkingReachableProperty pp = do checkLayeredTermination pp = do
let nonTrivialTriplets = filter (not . trivialTriplet) $ generateTriplets pp let nonTrivialTriplets = filter (not . trivialTriplet) $ generateTriplets pp
checkTerminalMarkingReachableProperty' pp nonTrivialTriplets 1 $ genericLength $ transitions pp checkLayeredTermination' pp nonTrivialTriplets 1 $ genericLength $ transitions pp
checkTerminalMarkingReachableProperty' :: PopulationProtocol -> [Triplet] -> Integer -> Integer -> OptIO PropResult checkLayeredTermination' :: PopulationProtocol -> [Triplet] -> Integer -> Integer -> OptIO PropResult
checkTerminalMarkingReachableProperty' pp triplets k kmax = do checkLayeredTermination' pp triplets k kmax = do
verbosePut 1 $ "Checking terminal marking reachable with at most " ++ show k ++ " partitions" verbosePut 1 $ "Checking terminal marking reachable with at most " ++ show k ++ " partitions"
r <- checkSatMin $ checkTerminalMarkingReachableSat pp triplets k r <- checkSatMin $ checkLayeredTerminationSat pp triplets k
case r of case r of
Nothing -> Nothing ->
if k < kmax then if k < kmax then
checkTerminalMarkingReachableProperty' pp triplets (k + 1) kmax checkLayeredTermination' pp triplets (k + 1) kmax
else else
return Unknown return Unknown
Just inv -> do Just inv -> do
...@@ -195,15 +177,13 @@ main = do ...@@ -195,15 +177,13 @@ main = do
rs <- runReaderT (mapM checkFile files) opts' rs <- runReaderT (mapM checkFile files) opts'
-- TODO: short-circuit with Control.Monad.Loops? parallel -- TODO: short-circuit with Control.Monad.Loops? parallel
-- execution? -- execution?
case resultsAnd rs of let r = resultsAnd rs
case r of
Satisfied -> Satisfied ->
exitSuccessWith "All properties satisfied." exitSuccessWith $ "All properties " ++ show r
Unsatisfied -> _ ->
exitFailureWith "Some properties are not satisfied" exitFailureWith $ "Some properties " ++ show r
Unknown ->
exitFailureWith "Some properties may not be satisfied."
-- TODO: Always exit with exit code 0 unless an error occured
exitSuccessWith :: String -> IO () exitSuccessWith :: String -> IO ()
exitSuccessWith msg = do exitSuccessWith msg = do
putStrLn msg putStrLn msg
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
module Options module Options
(InputFormat(..),OutputFormat(..),RefinementType(..), (InputFormat(..),OutputFormat(..),RefinementType(..),
ImplicitProperty(..),Options(..),startOptions,options,parseArgs, Options(..),startOptions,options,parseArgs,
usageInformation) usageInformation)
where where
...@@ -10,6 +10,8 @@ import Control.Applicative ((<$>)) ...@@ -10,6 +10,8 @@ import Control.Applicative ((<$>))
import System.Console.GetOpt import System.Console.GetOpt
import System.Environment (getArgs) import System.Environment (getArgs)
import Property (Property(..))
data InputFormat = InPP deriving (Read) data InputFormat = InPP deriving (Read)
data OutputFormat = OutDOT deriving (Read) data OutputFormat = OutDOT deriving (Read)
...@@ -18,10 +20,6 @@ instance Show InputFormat where ...@@ -18,10 +20,6 @@ instance Show InputFormat where
instance Show OutputFormat where instance Show OutputFormat where
show OutDOT = "DOT" show OutDOT = "DOT"
data ImplicitProperty = TerminalMarkingsUniqueConsensus
| TerminalMarkingReachable
deriving (Show,Read)
data RefinementType = TrapRefinement data RefinementType = TrapRefinement
| SiphonRefinement | SiphonRefinement
| UTrapRefinement | UTrapRefinement
...@@ -32,12 +30,11 @@ data Options = Options { inputFormat :: InputFormat ...@@ -32,12 +30,11 @@ data Options = Options { inputFormat :: InputFormat
, optVerbosity :: Int , optVerbosity :: Int
, optShowHelp :: Bool , optShowHelp :: Bool
, optShowVersion :: Bool , optShowVersion :: Bool
, optProperties :: [ImplicitProperty] , optProperties :: [Property]
, optRefinementType :: Maybe [RefinementType] , optRefinementType :: Maybe [RefinementType]
, optMinimizeRefinement :: Int , optMinimizeRefinement :: Int
, optSMTAuto :: Bool , optSMTAuto :: Bool
, optInvariant :: Bool , optInvariant :: Bool
, optBoolConst :: Bool
, optOutput :: Maybe String , optOutput :: Maybe String
, outputFormat :: OutputFormat , outputFormat :: OutputFormat
, optUseProperties :: Bool , optUseProperties :: Bool
...@@ -54,7 +51,6 @@ startOptions = Options { inputFormat = InPP ...@@ -54,7 +51,6 @@ startOptions = Options { inputFormat = InPP
, optMinimizeRefinement = 0 , optMinimizeRefinement = 0
, optSMTAuto = True , optSMTAuto = True
, optInvariant = False , optInvariant = False
, optBoolConst = False
, optOutput = Nothing , optOutput = Nothing
, outputFormat = OutDOT , outputFormat = OutDOT
, optUseProperties = True , optUseProperties = True
...@@ -63,35 +59,22 @@ startOptions = Options { inputFormat = InPP ...@@ -63,35 +59,22 @@ startOptions = Options { inputFormat = InPP
options :: [ OptDescr (Options -> Either String Options) ] options :: [ OptDescr (Options -> Either String Options) ]
options = options =
[ Option "" ["pp"] [ Option "" ["layered-termination"]
(NoArg (\opt -> Right opt { inputFormat = InPP }))
"Use the population protocol input format"
, Option "" ["structure"]
(NoArg (\opt -> Right opt { optPrintStructure = True }))
"Print structural information"
, Option "" ["terminal-markings-unique-consensus"]
(NoArg (\opt -> Right opt { (NoArg (\opt -> Right opt {
optProperties = optProperties opt ++ [TerminalMarkingsUniqueConsensus] optProperties = optProperties opt ++ [LayeredTermination]
})) }))
"Prove that terminal markings have a unique consensus" "Prove that the protocol satisfies layered termination"
, Option "" ["terminal-marking-reachable"] , Option "" ["strong-consensus"]
(NoArg (\opt -> Right opt { (NoArg (\opt -> Right opt {
optProperties = optProperties opt ++ [TerminalMarkingReachable] optProperties = optProperties opt ++ [StrongConsensus]
})) }))
"Prove that a terminal marking is reachable" "Prove that the protocol satisfies strong consensus"
, Option "i" ["invariant"] , Option "i" ["invariant"]
(NoArg (\opt -> Right opt { optInvariant = True })) (NoArg (\opt -> Right opt { optInvariant = True }))
"Generate an invariant" "Generate an invariant"
, Option "" ["bool-const"]
(NoArg (\opt -> Right opt { optBoolConst = True }))
("Use boolean constraints instead of integer ones\n" ++
" for transition invariant")
, Option "r" ["refinement"] , Option "r" ["refinement"]
(ReqArg (\arg opt -> (ReqArg (\arg opt ->
let addRef ref = let addRef ref =
...@@ -111,6 +94,16 @@ options = ...@@ -111,6 +94,16 @@ options =
"METHOD") "METHOD")
("Refine with METHOD (trap, siphon, utrap, usiphon)") ("Refine with METHOD (trap, siphon, utrap, usiphon)")
, Option "s" ["structure"]
(NoArg (\opt -> Right opt { optPrintStructure = True }))
"Print structural information"
, Option "" ["in-pp"]
(NoArg (\opt -> Right opt { inputFormat = InPP }))
"Use the population protocol input format"
, Option "o" ["output"] , Option "o" ["output"]
(ReqArg (\arg opt -> Right opt { (ReqArg (\arg opt -> Right opt {
optOutput = Just arg optOutput = Just arg
......
...@@ -187,29 +187,17 @@ formAtom = try linIneq ...@@ -187,29 +187,17 @@ formAtom = try linIneq
formula :: Parser (Formula String) formula :: Parser (Formula String)
formula = buildExpressionParser formOperatorTable formAtom <?> "formula" formula = buildExpressionParser formOperatorTable formAtom <?> "formula"
propertyType :: Parser PropertyType predicate :: Parser (Formula PopulationProtocol.State)
propertyType = predicate = do
(reserved "safety" *> return SafetyType) <|> reserved "predicate"
(reserved "liveness" *> return LivenessType)
property :: Parser Property
property = do
pt <- propertyType
reserved "property"
name <- option "" ident name <- option "" ident
case pt of form <- braces formula
SafetyType -> do return (fmap PopulationProtocol.State form)
form <- braces formula
return Property parseContent :: Parser PopulationProtocol
{ pname=name, pcont=Safety (fmap PopulationProtocol.State form) }
LivenessType -> do
form <- braces formula
return Property { pname=name, pcont=Liveness (fmap Transition form) }
parseContent :: Parser (PopulationProtocol,[Property])
parseContent = do parseContent = do
whiteSpace whiteSpace
pp <- populationProtocol pp <- populationProtocol
properties <- many property -- properties <- many predicate
eof eof
return (pp, properties) return pp
...@@ -2,11 +2,6 @@ ...@@ -2,11 +2,6 @@
module Property module Property
(Property(..), (Property(..),
showPropertyName,
renameProperty,
PropertyType(..),
PropertyContent(..),
ConstraintProperty(..),
Formula(..), Formula(..),
Op(..), Op(..),
Term(..), Term(..),
...@@ -18,8 +13,6 @@ module Property ...@@ -18,8 +13,6 @@ module Property
resultsOr) resultsOr)
where where
import PopulationProtocol
data Term a = data Term a =
Var a Var a
| Const Integer | Const Integer
...@@ -84,58 +77,21 @@ instance Functor Formula where ...@@ -84,58 +77,21 @@ instance Functor Formula where
fmap f (p :&: q) = fmap f p :&: fmap f q fmap f (p :&: q) = fmap f p :&: fmap f q
fmap f (p :|: q) = fmap f p :|: fmap f q fmap f (p :|: q) = fmap f p :|: fmap f q
-- TODO: add functions to transform formula to CNF/DNF data Property = Correctness
| LayeredTermination
data PropertyType = SafetyType | StrongConsensus
| LivenessType
| ConstraintType
data ConstraintProperty = TerminalMarkingsUniqueConsensusConstraint
| TerminalMarkingReachableConstraint
instance Show ConstraintProperty where
show TerminalMarkingsUniqueConsensusConstraint = "reachable terminal markings have a unique consensus"
show TerminalMarkingReachableConstraint = "terminal marking reachable"
data PropertyContent = Safety (Formula State)
| Liveness (Formula Transition)
| Constraint ConstraintProperty
showPropertyType :: PropertyContent -> String instance Show Property where
showPropertyType (Safety _) = "safety" show Correctness = "correctness"
showPropertyType (Liveness _) = "liveness" show LayeredTermination = "layered termination"
showPropertyType (Constraint _) = "constraint" show StrongConsensus = "strong consensus"
showPropertyContent :: PropertyContent -> String
showPropertyContent (Safety f) = show f
showPropertyContent (Liveness f) = show f
showPropertyContent (Constraint c) = show c
instance Show PropertyContent where
show pc = showPropertyType pc ++ " (" ++ showPropertyContent pc ++ ")"
data Property = Property { data PropResult = Satisfied | Unsatisfied | Unknown deriving (Eq)
pname :: String,
pcont :: PropertyContent
}
instance Show Property where instance Show PropResult where
show p = show Satisfied = "satisfied"
showPropertyName p ++ show Unsatisfied = "not satisfied"
" { " ++ showPropertyContent (pcont p) ++ " }" show Unknown = "may not be satisfied"
renameProperty :: (String -> String) -> Property -> Property
renameProperty f (Property pn (Safety pf)) =
Property pn (Safety (fmap (renameState f) pf))
renameProperty f (Property pn (Liveness pf)) =
Property pn (Liveness (fmap (renameTransition f) pf))
renameProperty _ p = p
showPropertyName :: Property -> String
showPropertyName p = showPropertyType (pcont p) ++ " property" ++
(if null (pname p) then "" else " " ++ show (pname p))
data PropResult = Satisfied | Unsatisfied | Unknown deriving (Show,Read,Eq)
resultAnd :: PropResult -> PropResult -> PropResult resultAnd :: PropResult -> PropResult -> PropResult
resultAnd Satisfied x = x resultAnd Satisfied x = x
......
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
module Solver.TerminalMarkingReachable module Solver.LayeredTermination
(checkTerminalMarkingReachableSat, (checkLayeredTerminationSat,
TerminalMarkingReachableInvariant) LayeredTerminationInvariant)
where where
import Data.SBV import Data.SBV
...@@ -17,15 +17,15 @@ import StructuralComputation ...@@ -17,15 +17,15 @@ import StructuralComputation
type InvariantSize = ([Int], [Integer], [Int]) type InvariantSize = ([Int], [Integer], [Int])
type TerminalMarkingReachableInvariant = [BlockInvariant] type LayeredTerminationInvariant = [LayerInvariant]
data BlockInvariant = data LayerInvariant =
BlockInvariant (Integer, [Transition], IVector State) LayerInvariant (Integer, [Transition], IVector State)
instance Invariant BlockInvariant where instance Invariant LayerInvariant where
invariantSize (BlockInvariant (_, ti, yi)) = if null ti then 0 else size yi invariantSize (LayerInvariant (_, ti, yi)) = if null ti then 0 else size yi
instance Show BlockInvariant where instance Show LayerInvariant where
show (BlockInvariant (i, ti, yi)) = show (LayerInvariant (i, ti, yi)) =
"T_" ++ show i ++ ":\n" ++ unlines (map show ti) ++ "T_" ++ show i ++ ":\n" ++ unlines (map show ti) ++
(if null ti then "" else "\nY_" ++ show i ++ ": " ++ intercalate " + " (map showWeighted (items yi)) ++ "\n") (if null ti then "" else "\nY_" ++ show i ++ ": " ++ intercalate " + " (map showWeighted (items yi)) ++ "\n")
...@@ -38,8 +38,8 @@ checkNonNegativityConstraints :: (Ord a, Show a) => [SIMap a] -> SBool ...@@ -38,8 +38,8 @@ checkNonNegativityConstraints :: (Ord a, Show a) => [SIMap a] -> SBool
checkNonNegativityConstraints xs = checkNonNegativityConstraints xs =
bAnd $ map nonNegativityConstraints xs bAnd $ map nonNegativityConstraints xs
blockTerminationConstraints :: PopulationProtocol -> Integer -> SIMap Transition -> SIMap State -> SBool layerTerminationConstraints :: PopulationProtocol -> Integer -> SIMap Transition -> SIMap State -> SBool
blockTerminationConstraints pp i b y = layerTerminationConstraints pp i b y =
bAnd $ map checkTransition $ transitions pp bAnd $ map checkTransition $ transitions pp
where checkTransition t = where checkTransition t =
let incoming = map addState $ lpre pp t let incoming = map addState $ lpre pp t
...@@ -49,46 +49,46 @@ blockTerminationConstraints pp i b y = ...@@ -49,46 +49,46 @@ blockTerminationConstraints pp i b y =
terminationConstraints :: PopulationProtocol -> Integer -> SIMap Transition -> [SIMap State] -> SBool terminationConstraints :: PopulationProtocol -> Integer -> SIMap Transition -> [SIMap State] -> SBool
terminationConstraints pp k b ys = terminationConstraints pp k b ys =
bAnd $ [blockTerminationConstraints pp i b y | (i,y) <- zip [1..] ys] bAnd $ [layerTerminationConstraints pp i b y | (i,y) <- zip [1..] ys]
blockConstraints :: PopulationProtocol -> Integer -> SIMap Transition -> SBool layerConstraints :: PopulationProtocol -> Integer -> SIMap Transition -> SBool
blockConstraints pp k b = layerConstraints pp k b =
bAnd $ map checkBlock $ transitions pp bAnd $ map checkLayer $ transitions pp
where checkBlock t = literal 1 .<= val b t &&& val b t .<= literal k where checkLayer t = literal 1 .<= val b t &&& val b t .<= literal k
blockOrderConstraints :: PopulationProtocol -> [Triplet] -> Integer -> SIMap Transition -> SBool layerOrderConstraints :: PopulationProtocol -> [Triplet] -> Integer -> SIMap Transition -> SBool
blockOrderConstraints pp triplets k b = layerOrderConstraints pp triplets k b =
bAnd $ map checkTriplet triplets bAnd $ map checkTriplet triplets
where checkTriplet (s,t,ts) = (val b s .> val b t) ==> bOr (map (\t' -> val b t' .== val b t) ts) where checkTriplet (s,t,ts) = (val b s .> val b t) ==> bOr (map (\t' -> val b t' .== val b t) ts)
checkTerminalMarkingReachable :: PopulationProtocol -> [Triplet] -> Integer -> SIMap Transition -> [SIMap State] -> Maybe (Int, InvariantSize) -> SBool checkLayeredTermination :: PopulationProtocol -> [Triplet] -> Integer -> SIMap Transition -> [SIMap State] -> Maybe (Int, InvariantSize) -> SBool
checkTerminalMarkingReachable pp triplets k b ys sizeLimit = checkLayeredTermination pp triplets k b ys sizeLimit =
blockConstraints pp k b &&& layerConstraints pp k b &&&
terminationConstraints pp k b ys &&& terminationConstraints pp k b ys &&&
blockOrderConstraints pp triplets k b &&& layerOrderConstraints pp triplets k b &&&
checkNonNegativityConstraints ys &&& checkNonNegativityConstraints ys &&&
checkSizeLimit k b ys sizeLimit checkSizeLimit k b ys sizeLimit
checkTerminalMarkingReachableSat :: PopulationProtocol -> [Triplet] -> Integer -> MinConstraintProblem Integer TerminalMarkingReachableInvariant InvariantSize checkLayeredTerminationSat :: PopulationProtocol -> [Triplet] -> Integer -> MinConstraintProblem Integer LayeredTerminationInvariant InvariantSize
checkTerminalMarkingReachableSat pp triplets k = checkLayeredTerminationSat pp triplets k =
let makeYName i = (++) (genericReplicate i '\'') let makeYName i = (++) (genericReplicate i '\'')
ys = [makeVarMapWith (makeYName i) $ states pp | i <- [1..k]] ys = [makeVarMapWith (makeYName i) $ states pp | i <- [1..k]]
b = makeVarMap $ transitions pp b = makeVarMap $ transitions pp