Commit ad99d8de authored by Philipp Meyer's avatar Philipp Meyer

Changed processing of option to check correctness

parent 07a1543e
...@@ -80,7 +80,8 @@ checkProperty pp prop = do ...@@ -80,7 +80,8 @@ 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 pp
StrongConsensus -> checkStrongConsensus pp StrongConsensus -> checkStrongConsensus False pp
StrongConsensusWithCorrectness -> checkStrongConsensus True pp
verbosePut 0 $ show prop ++ " " ++ show r verbosePut 0 $ show prop ++ " " ++ show r
return r return r
...@@ -92,20 +93,17 @@ printInvariant inv = do ...@@ -92,20 +93,17 @@ printInvariant inv = do
" (total of " ++ show (sum invSize) ++ ")" " (total of " ++ show (sum invSize) ++ ")"
mapM_ (putLine . show) inv mapM_ (putLine . show) inv
checkStrongConsensus :: PopulationProtocol -> OptIO PropResult checkStrongConsensus :: Bool -> PopulationProtocol -> OptIO PropResult
checkStrongConsensus pp = do checkStrongConsensus checkCorrectness pp = do
checkCorrectness <- opt optCorrectness r <- checkStrongConsensus' checkCorrectness pp ([], [])
when checkCorrectness $ verbosePut 1 "- additionally checking correctness"
r <- checkStrongConsensus' pp ([], [])
case r of case r of
(Nothing, _) -> return Satisfied (Nothing, _) -> return Satisfied
(Just _, _) -> return Unknown (Just _, _) -> return Unknown
checkStrongConsensus' :: PopulationProtocol -> RefinementObjects -> checkStrongConsensus' :: Bool -> PopulationProtocol -> RefinementObjects ->
OptIO (Maybe StrongConsensusCounterExample, RefinementObjects) OptIO (Maybe StrongConsensusCounterExample, RefinementObjects)
checkStrongConsensus' pp refinements = do checkStrongConsensus' checkCorrectness pp refinements = do
optRefine <- opt optRefinementType optRefine <- opt optRefinementType
checkCorrectness <- opt optCorrectness
case optRefine of case optRefine of
RefAll -> do RefAll -> do
r <- checkSat $ checkStrongConsensusCompleteSat checkCorrectness pp r <- checkSat $ checkStrongConsensusCompleteSat checkCorrectness pp
...@@ -121,16 +119,16 @@ checkStrongConsensus' pp refinements = do ...@@ -121,16 +119,16 @@ checkStrongConsensus' pp refinements = do
case optRefine of case optRefine of
RefDefault -> RefDefault ->
let refinementMethods = [TrapRefinement, SiphonRefinement, UTrapRefinement, USiphonRefinement] let refinementMethods = [TrapRefinement, SiphonRefinement, UTrapRefinement, USiphonRefinement]
in refineStrongConsensus pp refinementMethods refinements c in refineStrongConsensus checkCorrectness pp refinementMethods refinements c
RefList refinementMethods -> RefList refinementMethods ->
refineStrongConsensus pp refinementMethods refinements c refineStrongConsensus checkCorrectness pp refinementMethods refinements c
RefAll -> return (Nothing, refinements) RefAll -> return (Nothing, refinements)
refineStrongConsensus :: PopulationProtocol -> [RefinementType] -> RefinementObjects -> refineStrongConsensus :: Bool -> PopulationProtocol -> [RefinementType] -> RefinementObjects ->
StrongConsensusCounterExample -> StrongConsensusCounterExample ->
OptIO (Maybe StrongConsensusCounterExample, RefinementObjects) OptIO (Maybe StrongConsensusCounterExample, RefinementObjects)
refineStrongConsensus pp [] refinements c = return (Just c, refinements) refineStrongConsensus _ _ [] refinements c = return (Just c, refinements)
refineStrongConsensus pp (ref:refs) refinements c = do refineStrongConsensus checkCorrectness pp (ref:refs) refinements c = do
let refinementMethod = case ref of let refinementMethod = case ref of
TrapRefinement -> Solver.StrongConsensus.findTrapConstraintsSat TrapRefinement -> Solver.StrongConsensus.findTrapConstraintsSat
SiphonRefinement -> Solver.StrongConsensus.findSiphonConstraintsSat SiphonRefinement -> Solver.StrongConsensus.findSiphonConstraintsSat
...@@ -139,7 +137,7 @@ refineStrongConsensus pp (ref:refs) refinements c = do ...@@ -139,7 +137,7 @@ refineStrongConsensus pp (ref:refs) refinements c = do
r <- checkSatMin $ refinementMethod pp c r <- checkSatMin $ refinementMethod pp c
case r of case r of
Nothing -> do Nothing -> do
refineStrongConsensus pp refs refinements c refineStrongConsensus checkCorrectness pp refs refinements c
Just refinement -> do Just refinement -> do
let (utraps, usiphons) = refinements let (utraps, usiphons) = refinements
let refinements' = case ref of let refinements' = case ref of
...@@ -147,7 +145,7 @@ refineStrongConsensus pp (ref:refs) refinements c = do ...@@ -147,7 +145,7 @@ refineStrongConsensus pp (ref:refs) refinements c = do
SiphonRefinement -> (utraps, refinement:usiphons) SiphonRefinement -> (utraps, refinement:usiphons)
UTrapRefinement -> (refinement:utraps, usiphons) UTrapRefinement -> (refinement:utraps, usiphons)
USiphonRefinement -> (utraps, refinement:usiphons) USiphonRefinement -> (utraps, refinement:usiphons)
checkStrongConsensus' pp refinements' checkStrongConsensus' checkCorrectness pp refinements'
checkLayeredTermination :: PopulationProtocol -> OptIO PropResult checkLayeredTermination :: PopulationProtocol -> OptIO PropResult
checkLayeredTermination pp = do checkLayeredTermination pp = do
......
...@@ -38,7 +38,6 @@ data Options = Options { inputFormat :: InputFormat ...@@ -38,7 +38,6 @@ data Options = Options { inputFormat :: InputFormat
, optShowHelp :: Bool , optShowHelp :: Bool
, optShowVersion :: Bool , optShowVersion :: Bool
, optProperties :: PropertyOption , optProperties :: PropertyOption
, optCorrectness :: Bool
, optRefinementType :: RefinementOption , optRefinementType :: RefinementOption
, optMinimizeRefinement :: Int , optMinimizeRefinement :: Int
, optSMTAuto :: Bool , optSMTAuto :: Bool
...@@ -55,7 +54,6 @@ startOptions = Options { inputFormat = InPP ...@@ -55,7 +54,6 @@ startOptions = Options { inputFormat = InPP
, optShowHelp = False , optShowHelp = False
, optShowVersion = False , optShowVersion = False
, optProperties = PropDefault , optProperties = PropDefault
, optCorrectness = False
, optRefinementType = RefDefault , optRefinementType = RefDefault
, optMinimizeRefinement = 0 , optMinimizeRefinement = 0
, optSMTAuto = True , optSMTAuto = True
...@@ -66,26 +64,26 @@ startOptions = Options { inputFormat = InPP ...@@ -66,26 +64,26 @@ startOptions = Options { inputFormat = InPP
, optPrintStructure = False , optPrintStructure = False
} }
addProperty :: Property -> Options -> Either String Options
addProperty prop opt =
Right opt {
optProperties = case optProperties opt of
PropDefault -> PropList [prop]
(PropList props) -> PropList (props ++ [prop])
}
options :: [ OptDescr (Options -> Either String Options) ] options :: [ OptDescr (Options -> Either String Options) ]
options = options =
[ Option "" ["layered-termination"] [ Option "" ["layered-termination"]
(NoArg (\opt -> Right opt { (NoArg (addProperty LayeredTermination))
optProperties = case optProperties opt of
PropDefault -> PropList [LayeredTermination]
(PropList props) -> PropList ([LayeredTermination] ++ props)
}))
"Prove that the protocol satisfies layered termination" "Prove that the protocol satisfies layered termination"
, Option "" ["strong-consensus"] , Option "" ["strong-consensus"]
(NoArg (\opt -> Right opt { (NoArg (addProperty StrongConsensus))
optProperties = case optProperties opt of
PropDefault -> PropList [StrongConsensus]
(PropList props) -> PropList ([StrongConsensus] ++ props)
}))
"Prove that the protocol satisfies strong consensus" "Prove that the protocol satisfies strong consensus"
, Option "" ["correctness"] , Option "" ["correctness"]
(NoArg (\opt -> Right opt { optCorrectness = True })) (NoArg (addProperty StrongConsensusWithCorrectness))
"Prove that the protocol correctly satisfies the given predicate" "Prove that the protocol correctly satisfies the given predicate"
, Option "i" ["invariant"] , Option "i" ["invariant"]
......
...@@ -77,13 +77,14 @@ instance Functor Formula where ...@@ -77,13 +77,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
fmap f (p :|: q) = fmap f p :|: fmap f q fmap f (p :|: q) = fmap f p :|: fmap f q
data Property = Correctness data Property = LayeredTermination
| LayeredTermination
| StrongConsensus | StrongConsensus
| StrongConsensusWithCorrectness
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"
data PropResult = Satisfied | Unsatisfied | Unknown deriving (Eq) data PropResult = Satisfied | Unsatisfied | Unknown deriving (Eq)
......
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