Commit 6546c613 authored by Philipp Meyer's avatar Philipp Meyer

Rename marking to configuration; simplify invariant

parent c9113b43
......@@ -82,23 +82,13 @@ checkProperty pp prop = do
verbosePut 0 $ show prop ++ " " ++ show r
return r
printInvariant :: (Show a, Invariant a) => (Maybe [a], [a]) -> OptIO PropResult
printInvariant (baseInvResult, addedInv) =
case baseInvResult of
Nothing -> do
verbosePut 0 "No invariant found"
return Unknown
Just baseInv -> do
verbosePut 0 "Invariant found"
let baseSize = map invariantSize baseInv
let addedSize = map invariantSize addedInv
verbosePut 2 $ "Number of atoms in base invariants: " ++ show baseSize ++
" (total of " ++ show (sum baseSize) ++ ")"
verbosePut 2 $ "Number of atoms in added invariants: " ++ show addedSize ++
" (total of " ++ show (sum addedSize) ++ ")"
mapM_ (putLine . show) baseInv
mapM_ (putLine . show) addedInv
return Satisfied
printInvariant :: (Show a, Invariant a) => [a] -> OptIO ()
printInvariant inv = do
verbosePut 0 "Invariant found"
let invSize = map invariantSize inv
verbosePut 2 $ "Number of atoms in invariants: " ++ show invSize ++
" (total of " ++ show (sum invSize) ++ ")"
mapM_ (putLine . show) inv
checkStrongConsensus :: PopulationProtocol -> OptIO PropResult
checkStrongConsensus pp = do
......@@ -148,7 +138,7 @@ checkLayeredTermination pp = do
checkLayeredTermination' :: PopulationProtocol -> [Triplet] -> Integer -> Integer -> OptIO PropResult
checkLayeredTermination' pp triplets k kmax = do
verbosePut 1 $ "Checking terminal marking reachable with at most " ++ show k ++ " partitions"
verbosePut 1 $ "Checking layered termination with at most " ++ show k ++ " layers"
r <- checkSatMin $ checkLayeredTerminationSat pp triplets k
case r of
Nothing ->
......@@ -158,10 +148,8 @@ checkLayeredTermination' pp triplets k kmax = do
return Unknown
Just inv -> do
invariant <- opt optInvariant
if invariant then
printInvariant (Just inv, [])
else
return Satisfied
when invariant $ printInvariant inv
return Satisfied
main :: IO ()
main = do
......
......@@ -2,8 +2,8 @@
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module PopulationProtocol
(PopulationProtocol,State(..),Transition(..),Marking,FiringVector,
RMarking,RFiringVector,
(PopulationProtocol,State(..),Transition(..),Configuration,FiringVector,
RConfiguration,RFiringVector,
renameState,renameTransition,renameStatesAndTransitions,
name,showNetName,states,transitions,
initialStates,
......@@ -29,8 +29,6 @@ instance Show State where
instance Show Transition where
show (Transition t) = t
type SimpleCut = (S.Set Transition, [S.Set Transition])
type ContextMap a b = M.Map a ([(b, Integer)],[(b, Integer)])
class (Ord a, Ord b) => Nodes a b | a -> b where
......@@ -59,16 +57,14 @@ instance Nodes State Transition where
instance Nodes Transition State where
contextMap = adjacencyT
type Marking = IVector State
type Configuration = IVector State
type FiringVector = IVector Transition
type RMarking = RVector State
type RConfiguration = RVector State
type RFiringVector = RVector Transition
type Trap = [State]
type Siphon = [State]
-- TODO: generalize cut type
type Cut = ([([State], [Transition])], [Transition])
class Invariant a where
invariantSize :: a -> Int
......
......@@ -75,7 +75,7 @@ checkLayeredTerminationSat pp triplets k =
ys = [makeVarMapWith (makeYName i) $ states pp | i <- [1..k]]
b = makeVarMap $ transitions pp
in (minimizeMethod, \sizeLimit ->
("terminal marking reachable", "invariant",
("layered termination", "invariant",
concat (map getNames ys) ++ getNames b,
\fm -> checkLayeredTermination pp triplets k (fmap fm b) (map (fmap fm) ys) sizeLimit,
\fm -> invariantFromAssignment pp k (fmap fm b) (map (fmap fm) ys)))
......
This diff is collapsed.
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