Commit 1488bd45 authored by Philipp Meyer's avatar Philipp Meyer

Add options to verify abstract population protocols

parent 940c7426
...@@ -79,7 +79,8 @@ checkProperty :: PopulationProtocol -> Property -> OptIO PropResult ...@@ -79,7 +79,8 @@ checkProperty :: PopulationProtocol -> Property -> OptIO PropResult
checkProperty pp prop = do checkProperty pp prop = do
verbosePut 1 $ "\nChecking " ++ show prop verbosePut 1 $ "\nChecking " ++ show prop
r <- case prop of r <- case prop of
LayeredTermination -> checkLayeredTermination pp LayeredTermination -> checkLayeredTermination False pp
DeterministicLayeredTermination -> checkLayeredTermination True pp
StrongConsensus -> checkStrongConsensus False pp StrongConsensus -> checkStrongConsensus False pp
StrongConsensusWithCorrectness -> checkStrongConsensus True pp StrongConsensusWithCorrectness -> checkStrongConsensus True pp
ReachableTermConfigInConsensus -> checkReachableTermConfigInConsensus pp ReachableTermConfigInConsensus -> checkReachableTermConfigInConsensus pp
...@@ -115,7 +116,7 @@ checkReachableTermConfigInConsensus' pp refinements = do ...@@ -115,7 +116,7 @@ checkReachableTermConfigInConsensus' pp refinements = do
in refineReachableTermConfigInConsensus pp refinementMethods refinements c in refineReachableTermConfigInConsensus pp refinementMethods refinements c
RefList refinementMethods -> RefList refinementMethods ->
refineReachableTermConfigInConsensus pp refinementMethods refinements c refineReachableTermConfigInConsensus pp refinementMethods refinements c
RefAll -> return (Nothing, refinements) RefAll -> error "All refinement method not supported for checking reachable term config in consensus"
refineReachableTermConfigInConsensus :: PopulationProtocol -> [RefinementType] -> RefinementObjects -> refineReachableTermConfigInConsensus :: PopulationProtocol -> [RefinementType] -> RefinementObjects ->
ReachableTermConfigInConsensusCounterExample -> ReachableTermConfigInConsensusCounterExample ->
...@@ -194,19 +195,19 @@ refineStrongConsensus checkCorrectness pp (ref:refs) refinements c = do ...@@ -194,19 +195,19 @@ refineStrongConsensus checkCorrectness pp (ref:refs) refinements c = do
USiphonRefinement -> (utraps, refinement:usiphons) USiphonRefinement -> (utraps, refinement:usiphons)
checkStrongConsensus' checkCorrectness pp refinements' checkStrongConsensus' checkCorrectness pp refinements'
checkLayeredTermination :: PopulationProtocol -> OptIO PropResult checkLayeredTermination :: Bool -> PopulationProtocol -> OptIO PropResult
checkLayeredTermination pp = do checkLayeredTermination deterministic pp = do
let nonTrivialTriplets = filter (not . trivialTriplet) $ generateTriplets pp let nonTrivialTriplets = filter (not . trivialTriplet) $ generateTriplets pp
checkLayeredTermination' pp nonTrivialTriplets 1 $ genericLength $ transitions pp checkLayeredTermination' deterministic pp nonTrivialTriplets 1 $ genericLength $ transitions pp
checkLayeredTermination' :: PopulationProtocol -> [Triplet] -> Integer -> Integer -> OptIO PropResult checkLayeredTermination' :: Bool -> PopulationProtocol -> [Triplet] -> Integer -> Integer -> OptIO PropResult
checkLayeredTermination' pp triplets k kmax = do checkLayeredTermination' deterministic pp triplets k kmax = do
verbosePut 1 $ "Checking layered termination with at most " ++ show k ++ " layers" verbosePut 1 $ "Checking layered termination with at most " ++ show k ++ " layers"
r <- checkSatMin $ checkLayeredTerminationSat pp triplets k r <- checkSatMin $ checkLayeredTerminationSat deterministic pp triplets k
case r of case r of
Nothing -> Nothing ->
if k < kmax then if k < kmax then
checkLayeredTermination' pp triplets (k + 1) kmax checkLayeredTermination' deterministic pp triplets (k + 1) kmax
else else
return Unknown return Unknown
Just inv -> do Just inv -> do
......
...@@ -81,6 +81,10 @@ options = ...@@ -81,6 +81,10 @@ options =
(NoArg (addProperty LayeredTermination)) (NoArg (addProperty LayeredTermination))
"Prove that the protocol satisfies layered termination" "Prove that the protocol satisfies layered termination"
, Option "" ["deterministic-layered-termination"]
(NoArg (addProperty DeterministicLayeredTermination))
"Prove that the protocol satisfies deterministic layered termination"
, Option "" ["strong-consensus"] , Option "" ["strong-consensus"]
(NoArg (addProperty StrongConsensus)) (NoArg (addProperty StrongConsensus))
"Prove that the protocol satisfies strong consensus" "Prove that the protocol satisfies strong consensus"
......
...@@ -128,12 +128,14 @@ instance Functor Formula where ...@@ -128,12 +128,14 @@ instance Functor Formula where
fmap f (p :|: q) = fmap f p :|: fmap f q fmap f (p :|: q) = fmap f p :|: fmap f q
data Property = LayeredTermination data Property = LayeredTermination
| DeterministicLayeredTermination
| StrongConsensus | StrongConsensus
| StrongConsensusWithCorrectness | StrongConsensusWithCorrectness
| ReachableTermConfigInConsensus | ReachableTermConfigInConsensus
instance Show Property where instance Show Property where
show LayeredTermination = "layered termination" show LayeredTermination = "layered termination"
show DeterministicLayeredTermination = "deterministic layered termination"
show StrongConsensus = "strong consensus" show StrongConsensus = "strong consensus"
show StrongConsensusWithCorrectness = "strong consensus with correctness" show StrongConsensusWithCorrectness = "strong consensus with correctness"
show ReachableTermConfigInConsensus = "terminal configurations are in consensus" show ReachableTermConfigInConsensus = "terminal configurations are in consensus"
......
...@@ -56,28 +56,35 @@ layerConstraints pp k b = ...@@ -56,28 +56,35 @@ layerConstraints pp k b =
bAnd $ map checkLayer $ transitions pp bAnd $ map checkLayer $ transitions pp
where checkLayer t = literal 1 .<= val b t &&& val b t .<= literal k where checkLayer t = literal 1 .<= val b t &&& val b t .<= literal k
deterministicLayerConstraints :: PopulationProtocol -> SIMap Transition -> SBool
deterministicLayerConstraints pp b =
bAnd $ map checkTransition [ (t1,t2) | t1 <- transitions pp, t2 <- transitions pp, t1 /= t2, samePreset (t1,t2) ]
where checkTransition (t1,t2) = (val b t1 .== val b t2)
samePreset (t1,t2) = (lpre pp t1 == lpre pp t2)
layerOrderConstraints :: PopulationProtocol -> [Triplet] -> Integer -> SIMap Transition -> SBool layerOrderConstraints :: PopulationProtocol -> [Triplet] -> Integer -> SIMap Transition -> SBool
layerOrderConstraints 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)
checkLayeredTermination :: PopulationProtocol -> [Triplet] -> Integer -> SIMap Transition -> [SIMap State] -> Maybe (Int, InvariantSize) -> SBool checkLayeredTermination :: Bool -> PopulationProtocol -> [Triplet] -> Integer -> SIMap Transition -> [SIMap State] -> Maybe (Int, InvariantSize) -> SBool
checkLayeredTermination pp triplets k b ys sizeLimit = checkLayeredTermination deterministic pp triplets k b ys sizeLimit =
layerConstraints pp k b &&& layerConstraints pp k b &&&
(if deterministic then deterministicLayerConstraints pp b else true) &&&
terminationConstraints pp k b ys &&& terminationConstraints pp k b ys &&&
layerOrderConstraints pp triplets k b &&& layerOrderConstraints pp triplets k b &&&
checkNonNegativityConstraints ys &&& checkNonNegativityConstraints ys &&&
checkSizeLimit k b ys sizeLimit checkSizeLimit k b ys sizeLimit
checkLayeredTerminationSat :: PopulationProtocol -> [Triplet] -> Integer -> MinConstraintProblem Integer LayeredTerminationInvariant InvariantSize checkLayeredTerminationSat :: Bool -> PopulationProtocol -> [Triplet] -> Integer -> MinConstraintProblem Integer LayeredTerminationInvariant InvariantSize
checkLayeredTerminationSat pp triplets k = checkLayeredTerminationSat deterministic 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
in (minimizeMethod, \sizeLimit -> in (minimizeMethod, \sizeLimit ->
("layered termination", "invariant", ("layered termination", "invariant",
concat (map getNames ys) ++ getNames b, concat (map getNames ys) ++ getNames b,
\fm -> checkLayeredTermination pp triplets k (fmap fm b) (map (fmap fm) ys) sizeLimit, \fm -> checkLayeredTermination deterministic pp triplets k (fmap fm b) (map (fmap fm) ys) sizeLimit,
\fm -> invariantFromAssignment pp k (fmap fm b) (map (fmap fm) ys))) \fm -> invariantFromAssignment pp k (fmap fm b) (map (fmap fm) ys)))
minimizeMethod :: Int -> InvariantSize -> String minimizeMethod :: Int -> InvariantSize -> String
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment