Commit 940c7426 authored by Philipp Meyer's avatar Philipp Meyer

Add option to check that all potentially reachable terminal

configurations are in consensus
parent 9792f989
...@@ -22,6 +22,7 @@ import StructuralComputation ...@@ -22,6 +22,7 @@ import StructuralComputation
import Solver import Solver
import Solver.LayeredTermination import Solver.LayeredTermination
import Solver.StrongConsensus import Solver.StrongConsensus
import Solver.ReachableTermConfigInConsensus
writeFiles :: String -> PopulationProtocol -> [Property] -> OptIO () writeFiles :: String -> PopulationProtocol -> [Property] -> OptIO ()
writeFiles basename pp props = do writeFiles basename pp props = do
...@@ -81,6 +82,7 @@ checkProperty pp prop = do ...@@ -81,6 +82,7 @@ checkProperty pp prop = do
LayeredTermination -> checkLayeredTermination pp LayeredTermination -> checkLayeredTermination pp
StrongConsensus -> checkStrongConsensus False pp StrongConsensus -> checkStrongConsensus False pp
StrongConsensusWithCorrectness -> checkStrongConsensus True pp StrongConsensusWithCorrectness -> checkStrongConsensus True pp
ReachableTermConfigInConsensus -> checkReachableTermConfigInConsensus pp
verbosePut 0 $ show prop ++ " " ++ show r verbosePut 0 $ show prop ++ " " ++ show r
return r return r
...@@ -92,6 +94,52 @@ printInvariant inv = do ...@@ -92,6 +94,52 @@ printInvariant inv = do
" (total of " ++ show (sum invSize) ++ ")" " (total of " ++ show (sum invSize) ++ ")"
mapM_ (putLine . show) inv mapM_ (putLine . show) inv
checkReachableTermConfigInConsensus :: PopulationProtocol -> OptIO PropResult
checkReachableTermConfigInConsensus pp = do
r <- checkReachableTermConfigInConsensus' pp ([], [])
case r of
(Nothing, _) -> return Satisfied
(Just _, _) -> return Unknown
checkReachableTermConfigInConsensus' :: PopulationProtocol -> RefinementObjects ->
OptIO (Maybe ReachableTermConfigInConsensusCounterExample, RefinementObjects)
checkReachableTermConfigInConsensus' pp refinements = do
optRefine <- opt optRefinementType
r <- checkSat $ checkReachableTermConfigInConsensusSat pp refinements
case r of
Nothing -> return (Nothing, refinements)
Just c -> do
case optRefine of
RefDefault ->
let refinementMethods = [TrapRefinement, SiphonRefinement, UTrapRefinement, USiphonRefinement]
in refineReachableTermConfigInConsensus pp refinementMethods refinements c
RefList refinementMethods ->
refineReachableTermConfigInConsensus pp refinementMethods refinements c
RefAll -> return (Nothing, refinements)
refineReachableTermConfigInConsensus :: PopulationProtocol -> [RefinementType] -> RefinementObjects ->
ReachableTermConfigInConsensusCounterExample ->
OptIO (Maybe ReachableTermConfigInConsensusCounterExample, RefinementObjects)
refineReachableTermConfigInConsensus _ [] refinements c = return (Just c, refinements)
refineReachableTermConfigInConsensus pp (ref:refs) refinements c = do
let refinementMethod = case ref of
TrapRefinement -> Solver.ReachableTermConfigInConsensus.findTrapConstraintsSat
SiphonRefinement -> Solver.ReachableTermConfigInConsensus.findSiphonConstraintsSat
UTrapRefinement -> Solver.ReachableTermConfigInConsensus.findUTrapConstraintsSat
USiphonRefinement -> Solver.ReachableTermConfigInConsensus.findUSiphonConstraintsSat
r <- checkSatMin $ refinementMethod pp c
case r of
Nothing -> do
refineReachableTermConfigInConsensus pp refs refinements c
Just refinement -> do
let (utraps, usiphons) = refinements
let refinements' = case ref of
TrapRefinement -> (refinement:utraps, usiphons)
SiphonRefinement -> (utraps, refinement:usiphons)
UTrapRefinement -> (refinement:utraps, usiphons)
USiphonRefinement -> (utraps, refinement:usiphons)
checkReachableTermConfigInConsensus' pp refinements'
checkStrongConsensus :: Bool -> PopulationProtocol -> OptIO PropResult checkStrongConsensus :: Bool -> PopulationProtocol -> OptIO PropResult
checkStrongConsensus checkCorrectness pp = do checkStrongConsensus checkCorrectness pp = do
r <- checkStrongConsensus' checkCorrectness pp ([], []) r <- checkStrongConsensus' checkCorrectness pp ([], [])
......
...@@ -89,6 +89,10 @@ options = ...@@ -89,6 +89,10 @@ options =
(NoArg (addProperty StrongConsensusWithCorrectness)) (NoArg (addProperty StrongConsensusWithCorrectness))
"Prove that the protocol correctly satisfies the given predicate" "Prove that the protocol correctly satisfies the given predicate"
, Option "" ["terminal-consensus"]
(NoArg (addProperty ReachableTermConfigInConsensus))
"Prove that reachable terminal configurations are in 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"
......
...@@ -17,6 +17,6 @@ parseString p str = ...@@ -17,6 +17,6 @@ parseString p str =
parseFile :: Parser a -> String -> IO a parseFile :: Parser a -> String -> IO a
parseFile p file = do parseFile p file = do
contents <- T.unpack <$> TIO.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
...@@ -130,11 +130,13 @@ instance Functor Formula where ...@@ -130,11 +130,13 @@ instance Functor Formula where
data Property = LayeredTermination data Property = LayeredTermination
| StrongConsensus | StrongConsensus
| StrongConsensusWithCorrectness | StrongConsensusWithCorrectness
| ReachableTermConfigInConsensus
instance Show Property where instance Show Property where
show LayeredTermination = "layered termination" show LayeredTermination = "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"
data PropResult = Satisfied | Unsatisfied | Unknown deriving (Eq) data PropResult = Satisfied | Unsatisfied | Unknown deriving (Eq)
......
This diff is collapsed.
...@@ -287,7 +287,7 @@ findUSiphonConstraintsSat pp c = ...@@ -287,7 +287,7 @@ findUSiphonConstraintsSat pp c =
statesFromAssignment :: IMap State -> ([State], Integer) statesFromAssignment :: IMap State -> ([State], Integer)
statesFromAssignment b = (M.keys (M.filter (> 0) b), sum (M.elems b)) statesFromAssignment b = (M.keys (M.filter (> 0) b), sum (M.elems b))
-- method with all refinements directly encoded into the SMT theoryüjw -- method with all refinements directly encoded into the SMT theory
findMaximalUnmarkedTrap :: PopulationProtocol -> Integer -> SIMap Transition -> SIMap State -> SIMap State -> SBool findMaximalUnmarkedTrap :: PopulationProtocol -> Integer -> SIMap Transition -> SIMap State -> SIMap State -> SBool
findMaximalUnmarkedTrap pp max x m rs = findMaximalUnmarkedTrap pp max x m rs =
......
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