Skip to content

peregrine
peregrine
Commit 650084a7 authored by Philipp Meyer's avatar Philipp Meyer
Browse files
Options

Allow specification of refinements in different orders

parent 9676c8c2
Hide whitespace changes
Inline Side-by-side
Showing with 88 additions and 53 deletions
src/Main.hs
View file @ 650084a7
......@@ -92,42 +92,48 @@ printInvariant inv = do
checkStrongConsensus :: PopulationProtocol -> OptIO PropResult
checkStrongConsensus pp = do
r <- checkStrongConsensus' pp [] []
r <- checkStrongConsensus' pp ([], [])
case r of
(Nothing, _, _) -> return Satisfied
(Just _, _, _) -> return Unknown
(Nothing, _) -> return Satisfied
(Just _, _) -> return Unknown
checkStrongConsensus' :: PopulationProtocol -> [Trap] -> [Siphon] ->
OptIO (Maybe StrongConsensusCounterExample, [Trap], [Siphon])
checkStrongConsensus' pp utraps usiphons = do
r <- checkSat $ checkStrongConsensusSat pp utraps usiphons
checkStrongConsensus' :: PopulationProtocol -> RefinementObjects ->
OptIO (Maybe StrongConsensusCounterExample, RefinementObjects)
checkStrongConsensus' pp refinements = do
r <- checkSat $ checkStrongConsensusSat pp refinements
case r of
Nothing -> return (Nothing, utraps, usiphons)
Nothing -> return (Nothing, refinements)
Just c -> do
refine <- opt optRefinementType
if isJust refine then
refineStrongConsensus pp utraps usiphons c
else
return (Just c, utraps, usiphons)
refineStrongConsensus :: PopulationProtocol -> [Trap] -> [Siphon] -> StrongConsensusCounterExample ->
OptIO (Maybe StrongConsensusCounterExample, [Trap], [Siphon])
refineStrongConsensus pp utraps usiphons c = do
r1 <- checkSatMin $ Solver.StrongConsensus.findTrapConstraintsSat pp c
case r1 of
optRefine <- opt optRefinementType
let refinementMethods = case optRefine of
RefDefault -> [TrapRefinement, SiphonRefinement, UTrapRefinement, USiphonRefinement]
RefList rs -> rs
RefAll -> error "not yet implemented"
refineStrongConsensus pp refinementMethods refinements c
refineStrongConsensus :: PopulationProtocol -> [RefinementType] -> RefinementObjects ->
StrongConsensusCounterExample ->
OptIO (Maybe StrongConsensusCounterExample, RefinementObjects)
refineStrongConsensus pp [] refinements c = return (Just c, refinements)
refineStrongConsensus pp (ref:refs) refinements c = do
let refinementMethod = case ref of
TrapRefinement -> Solver.StrongConsensus.findTrapConstraintsSat
SiphonRefinement -> Solver.StrongConsensus.findSiphonConstraintsSat
UTrapRefinement -> Solver.StrongConsensus.findUTrapConstraintsSat
USiphonRefinement -> Solver.StrongConsensus.findUSiphonConstraintsSat
r <- checkSatMin $ refinementMethod pp c
case r of
Nothing -> do
r2 <- checkSatMin $ Solver.StrongConsensus.findUSiphonConstraintsSat pp c
case r2 of
Nothing -> do
r3 <- checkSatMin $ Solver.StrongConsensus.findUTrapConstraintsSat pp c
case r3 of
Nothing -> return (Just c, utraps, usiphons)
Just utrap ->
checkStrongConsensus' pp (utrap:utraps) usiphons
Just usiphon ->
checkStrongConsensus' pp utraps (usiphon:usiphons)
Just trap ->
checkStrongConsensus' pp (trap:utraps) usiphons
refineStrongConsensus 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)
checkStrongConsensus' pp refinements'
checkLayeredTermination :: PopulationProtocol -> OptIO PropResult
checkLayeredTermination pp = do
......
src/Options.hs
View file @ 650084a7
{-# LANGUAGE TupleSections #-}
module Options
(InputFormat(..),OutputFormat(..),RefinementType(..),
(InputFormat(..),OutputFormat(..),RefinementType(..),RefinementOption(..),
Options(..),startOptions,options,parseArgs,
usageInformation)
where
......@@ -26,12 +26,16 @@ data RefinementType = TrapRefinement
| USiphonRefinement
deriving (Show,Read)
data RefinementOption = RefDefault
| RefList [RefinementType]
| RefAll
data Options = Options { inputFormat :: InputFormat
, optVerbosity :: Int
, optShowHelp :: Bool
, optShowVersion :: Bool
, optProperties :: [Property]
, optRefinementType :: Maybe [RefinementType]
, optRefinementType :: RefinementOption
, optMinimizeRefinement :: Int
, optSMTAuto :: Bool
, optInvariant :: Bool
......@@ -47,7 +51,7 @@ startOptions = Options { inputFormat = InPP
, optShowHelp = False
, optShowVersion = False
, optProperties = []
, optRefinementType = Just [TrapRefinement, SiphonRefinement, UTrapRefinement, USiphonRefinement]
, optRefinementType = RefDefault
, optMinimizeRefinement = 0
, optSMTAuto = True
, optInvariant = False
......@@ -78,21 +82,21 @@ options =
, Option "r" ["refinement"]
(ReqArg (\arg opt ->
let addRef ref =
Right opt { optRefinementType =
case optRefinementType opt of
Nothing -> Just [ref]
Just(refs) -> Just (refs ++ [ref])
}
case optRefinementType opt of
RefDefault -> RefList [ref]
(RefList refs) -> RefList (refs ++ [ref])
RefAll -> RefAll
in case arg of
"trap" -> addRef TrapRefinement
"siphon" -> addRef SiphonRefinement
"utrap" -> addRef UTrapRefinement
"usiphon" -> addRef USiphonRefinement
"none" -> Right opt { optRefinementType = RefList [] }
"trap" -> Right opt { optRefinementType = addRef TrapRefinement }
"siphon" -> Right opt { optRefinementType = addRef SiphonRefinement }
"utrap" -> Right opt { optRefinementType = addRef UTrapRefinement }
"usiphon" -> Right opt { optRefinementType = addRef USiphonRefinement }
"all" -> Right opt { optRefinementType = RefAll }
_ -> Left ("invalid argument for refinement method: " ++ arg)
)
"METHOD")
("Refine with METHOD (trap, siphon, utrap, usiphon)")
("Refine with METHOD (trap, siphon, utrap, usiphon, none, all)")
, Option "s" ["structure"]
(NoArg (\opt -> Right opt { optPrintStructure = True }))
......
src/Solver/StrongConsensus.hs
View file @ 650084a7
......@@ -3,7 +3,9 @@
module Solver.StrongConsensus
(checkStrongConsensusSat,
StrongConsensusCounterExample,
RefinementObjects,
findTrapConstraintsSat,
findSiphonConstraintsSat,
findUTrapConstraintsSat,
findUSiphonConstraintsSat)
where
......@@ -18,6 +20,7 @@ import Property
import Solver
type StrongConsensusCounterExample = (Configuration, Configuration, Configuration, FlowVector, FlowVector)
type RefinementObjects = ([Trap], [Siphon])
stateEquationConstraints :: PopulationProtocol -> SIMap State -> SIMap State -> SIMap Transition -> SBool
stateEquationConstraints pp m0 m x =
......@@ -84,8 +87,8 @@ checkUSiphonConstraints pp m0 m1 m2 x1 x2 siphons =
bAnd $ map (checkUSiphon pp m0 m1 m2 x1 x2) siphons
checkStrongConsensus :: PopulationProtocol -> SIMap State -> SIMap State -> SIMap State -> SIMap Transition -> SIMap Transition ->
[Trap] -> [Siphon] -> SBool
checkStrongConsensus pp m0 m1 m2 x1 x2 utraps usiphons =
RefinementObjects -> SBool
checkStrongConsensus pp m0 m1 m2 x1 x2 (utraps, usiphons) =
stateEquationConstraints pp m0 m1 x1 &&&
stateEquationConstraints pp m0 m2 x2 &&&
initialConfiguration pp m0 &&&
......@@ -100,8 +103,8 @@ checkStrongConsensus pp m0 m1 m2 x1 x2 utraps usiphons =
checkUTrapConstraints pp m0 m1 m2 x1 x2 utraps &&&
checkUSiphonConstraints pp m0 m1 m2 x1 x2 usiphons
checkStrongConsensusSat :: PopulationProtocol -> [Trap] -> [Siphon] -> ConstraintProblem Integer StrongConsensusCounterExample
checkStrongConsensusSat pp utraps usiphons =
checkStrongConsensusSat :: PopulationProtocol -> RefinementObjects -> ConstraintProblem Integer StrongConsensusCounterExample
checkStrongConsensusSat pp refinements =
let m0 = makeVarMap $ states pp
m1 = makeVarMapWith prime $ states pp
m2 = makeVarMapWith (prime . prime) $ states pp
......@@ -109,11 +112,11 @@ checkStrongConsensusSat pp utraps usiphons =
x2 = makeVarMapWith prime $ transitions pp
in ("strong consensus", "(c0, c1, c2, x1, x2)",
getNames m0 ++ getNames m1 ++ getNames m2 ++ getNames x1 ++ getNames x2,
\fm -> checkStrongConsensus pp (fmap fm m0) (fmap fm m1) (fmap fm m2) (fmap fm x1) (fmap fm x2) utraps usiphons,
\fm -> configurationsFromAssignment (fmap fm m0) (fmap fm m1) (fmap fm m2) (fmap fm x1) (fmap fm x2))
\fm -> checkStrongConsensus pp (fmap fm m0) (fmap fm m1) (fmap fm m2) (fmap fm x1) (fmap fm x2) refinements,
\fm -> counterExampleFromAssignment (fmap fm m0) (fmap fm m1) (fmap fm m2) (fmap fm x1) (fmap fm x2))
configurationsFromAssignment :: IMap State -> IMap State -> IMap State -> IMap Transition -> IMap Transition -> StrongConsensusCounterExample
configurationsFromAssignment m0 m1 m2 x1 x2 =
counterExampleFromAssignment :: IMap State -> IMap State -> IMap State -> IMap Transition -> IMap Transition -> StrongConsensusCounterExample
counterExampleFromAssignment m0 m1 m2 x1 x2 =
(makeVector m0, makeVector m1, makeVector m2, makeVector x1, makeVector x2)
-- trap and siphon refinement constraints
......@@ -130,6 +133,10 @@ trapConstraints :: PopulationProtocol -> SIMap State -> SBool
trapConstraints pp b =
bAnd $ map (trapConstraint pp b) $ transitions pp
siphonConstraints :: PopulationProtocol -> SIMap State -> SBool
siphonConstraints pp b =
bAnd $ map (siphonConstraint pp b) $ transitions pp
uTrapConstraints :: PopulationProtocol -> FlowVector -> SIMap State -> SBool
uTrapConstraints pp x b =
bAnd $ map (trapConstraint pp b) $ elems x
......@@ -212,6 +219,24 @@ findUTrapConstraintsSat pp c =
\fm -> findUTrapConstraints pp c (fmap fm b) sizeLimit,
\fm -> statesFromAssignment (fmap fm b)))
findSiphonConstraints :: PopulationProtocol -> StrongConsensusCounterExample -> SIMap State -> Maybe (Int, Integer) -> SBool
findSiphonConstraints pp (m0, m1, m2, x1, x2) b sizeLimit =
checkSizeLimit b sizeLimit &&&
checkBinary b &&&
siphonConstraints pp b &&&
statesUnmarkedByConfiguration pp m0 b &&&
(statesPresetOfSequence pp x1 b ||| statesPresetOfSequence pp x2 b)
findSiphonConstraintsSat :: PopulationProtocol -> StrongConsensusCounterExample -> MinConstraintProblem Integer Siphon Integer
findSiphonConstraintsSat pp c =
let b = makeVarMap $ states pp
in (minimizeMethod, \sizeLimit ->
("siphon used by x1 or x2 and unmarked in m0", "siphon",
getNames b,
\fm -> findSiphonConstraints pp c (fmap fm b) sizeLimit,
\fm -> statesFromAssignment (fmap fm b)))
findUSiphonConstraints :: PopulationProtocol -> StrongConsensusCounterExample -> SIMap State -> Maybe (Int, Integer) -> SBool
findUSiphonConstraints pp (m0, m1, m2, x1, x2) b sizeLimit =
checkSizeLimit b sizeLimit &&&
......
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