Notice: If you are member of any public project or group, please make sure that your GitLab username is not the same as the LRZ identifier/Kennung (see https://gitlab.lrz.de/profile/account). Please change your username if necessary. For more information see the section "Public projects / Öffentliche Projekte" at https://doku.lrz.de/display/PUBLIC/GitLab . Thank you!

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