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
import Solver
import Solver.LayeredTermination
import Solver.StrongConsensus
import Solver.ReachableTermConfigInConsensus
writeFiles :: String -> PopulationProtocol -> [Property] -> OptIO ()
writeFiles basename pp props = do
......@@ -81,6 +82,7 @@ checkProperty pp prop = do
LayeredTermination -> checkLayeredTermination pp
StrongConsensus -> checkStrongConsensus False pp
StrongConsensusWithCorrectness -> checkStrongConsensus True pp
ReachableTermConfigInConsensus -> checkReachableTermConfigInConsensus pp
verbosePut 0 $ show prop ++ " " ++ show r
return r
......@@ -92,6 +94,52 @@ printInvariant inv = do
" (total of " ++ show (sum invSize) ++ ")"
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 checkCorrectness pp = do
r <- checkStrongConsensus' checkCorrectness pp ([], [])
......
......@@ -89,6 +89,10 @@ options =
(NoArg (addProperty StrongConsensusWithCorrectness))
"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"]
(NoArg (\opt -> Right opt { optInvariant = True }))
"Generate an invariant"
......
......@@ -17,6 +17,6 @@ parseString p str =
parseFile :: Parser a -> String -> IO a
parseFile p file = do
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"
Right r -> return r
......@@ -130,11 +130,13 @@ instance Functor Formula where
data Property = LayeredTermination
| StrongConsensus
| StrongConsensusWithCorrectness
| ReachableTermConfigInConsensus
instance Show Property where
show LayeredTermination = "layered termination"
show StrongConsensus = "strong consensus"
show StrongConsensusWithCorrectness = "strong consensus with correctness"
show ReachableTermConfigInConsensus = "terminal configurations are in consensus"
data PropResult = Satisfied | Unsatisfied | Unknown deriving (Eq)
......
This diff is collapsed.
......@@ -287,7 +287,7 @@ findUSiphonConstraintsSat pp c =
statesFromAssignment :: IMap State -> ([State], Integer)
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 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