2.12.2021, 9:00 - 11:00: Due to updates GitLab may be unavailable for some minutes between 09:00 and 11:00.

Commit 1329e5f6 authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Extended option to choose refinement type

parent 41902d45
...@@ -5,6 +5,7 @@ import System.IO ...@@ -5,6 +5,7 @@ import System.IO
import Control.Monad import Control.Monad
import Control.Arrow (first) import Control.Arrow (first)
import Data.List (partition) import Data.List (partition)
import Data.Maybe
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Control.Monad.Reader import Control.Monad.Reader
...@@ -254,8 +255,8 @@ checkSafetyProperty' net f traps = do ...@@ -254,8 +255,8 @@ checkSafetyProperty' net f traps = do
case r of case r of
Nothing -> return (Nothing, traps) Nothing -> return (Nothing, traps)
Just m -> do Just m -> do
refine <- opt optRefine refine <- opt optRefinementType
if refine then if isJust refine then
refineSafetyProperty net f traps m refineSafetyProperty net f traps m
else else
return (Just m, traps) return (Just m, traps)
...@@ -307,34 +308,42 @@ checkLivenessProperty' net f cuts = do ...@@ -307,34 +308,42 @@ checkLivenessProperty' net f cuts = do
case r of case r of
Nothing -> return (Nothing, cuts) Nothing -> return (Nothing, cuts)
Just x -> do Just x -> do
refine <- opt optRefine rt <- findLivenessRefinement net x
if refine then do case rt of
rt <- findLivenessRefinement net x Nothing ->
case rt of return (Just x, cuts)
Nothing -> Just cut ->
return (Just x, cuts) checkLivenessProperty' net f (cut:cuts)
Just cut ->
checkLivenessProperty' net f (cut:cuts)
else
return (Just x, cuts)
findLivenessRefinement :: PetriNet -> FiringVector -> findLivenessRefinement :: PetriNet -> FiringVector ->
OptIO (Maybe Cut) OptIO (Maybe Cut)
findLivenessRefinement net x = do findLivenessRefinement net x = do
refinementType <- opt optRefinementType refinementType <- opt optRefinementType
case refinementType of case refinementType of
TrapRefinement -> Just TrapRefinement ->
findLivenessRefinementByEmptyTraps net (initialMarking net) x [] findLivenessRefinementByEmptyTraps net (initialMarking net) x []
SComponentRefinement -> do Just SComponentRefinement -> do
r1 <- findLivenessRefinementBySComponent net x r1 <- findLivenessRefinementBySComponent net x
case r1 of case r1 of
Nothing -> findLivenessRefinementByEmptyTraps net Nothing -> findLivenessRefinementByEmptyTraps net
(initialMarking net) x [] (initialMarking net) x []
Just _ -> return r1 Just _ -> return r1
Just SComponentWithCutRefinement -> do
r1 <- findLivenessRefinementBySComponentWithCut net x
case r1 of
Nothing -> findLivenessRefinementByEmptyTraps net
(initialMarking net) x []
Just _ -> return r1
Nothing -> return Nothing
findLivenessRefinementBySComponent :: PetriNet -> FiringVector -> findLivenessRefinementBySComponent :: PetriNet -> FiringVector ->
OptIO (Maybe Cut) OptIO (Maybe Cut)
findLivenessRefinementBySComponent net x = findLivenessRefinementBySComponent net x =
checkSatMin $ checkSComponentSat net x
findLivenessRefinementBySComponentWithCut :: PetriNet -> FiringVector ->
OptIO (Maybe Cut)
findLivenessRefinementBySComponentWithCut net x =
checkSatMin $ checkSComponentWithCutSat net x checkSatMin $ checkSComponentWithCutSat net x
findLivenessRefinementByEmptyTraps :: PetriNet -> Marking -> FiringVector -> findLivenessRefinementByEmptyTraps :: PetriNet -> Marking -> FiringVector ->
...@@ -352,7 +361,7 @@ findLivenessRefinementByEmptyTraps net m x traps = do ...@@ -352,7 +361,7 @@ findLivenessRefinementByEmptyTraps net m x traps = do
return Nothing return Nothing
Just trap -> do Just trap -> do
let traps' = trap:traps let traps' = trap:traps
rm <- local (\opts -> opts { optRefine = False }) $ rm <- local (\opts -> opts { optRefinementType = Nothing }) $
checkSafetyProperty' net FTrue traps' checkSafetyProperty' net FTrue traps'
case rm of case rm of
(Nothing, _) -> do (Nothing, _) -> do
......
...@@ -33,7 +33,7 @@ data ImplicitProperty = Termination ...@@ -33,7 +33,7 @@ data ImplicitProperty = Termination
| StructCommunicationFree | StructCommunicationFree
deriving (Show,Read) deriving (Show,Read)
data RefinementType = TrapRefinement | SComponentRefinement data RefinementType = TrapRefinement | SComponentRefinement | SComponentWithCutRefinement
deriving (Show,Read) deriving (Show,Read)
data Options = Options { inputFormat :: InputFormat data Options = Options { inputFormat :: InputFormat
...@@ -42,9 +42,8 @@ data Options = Options { inputFormat :: InputFormat ...@@ -42,9 +42,8 @@ data Options = Options { inputFormat :: InputFormat
, optShowVersion :: Bool , optShowVersion :: Bool
, optProperties :: [ImplicitProperty] , optProperties :: [ImplicitProperty]
, optTransformations :: [NetTransformation] , optTransformations :: [NetTransformation]
, optRefine :: Bool
, optSimpFormula :: Int , optSimpFormula :: Int
, optRefinementType :: RefinementType , optRefinementType :: Maybe RefinementType
, optMinimizeRefinement :: Int , optMinimizeRefinement :: Int
, optInvariant :: Bool , optInvariant :: Bool
, optOutput :: Maybe String , optOutput :: Maybe String
...@@ -60,9 +59,8 @@ startOptions = Options { inputFormat = PNET ...@@ -60,9 +59,8 @@ startOptions = Options { inputFormat = PNET
, optShowVersion = False , optShowVersion = False
, optProperties = [] , optProperties = []
, optTransformations = [] , optTransformations = []
, optRefine = True
, optSimpFormula = 2 , optSimpFormula = 2
, optRefinementType = SComponentRefinement , optRefinementType = Just SComponentWithCutRefinement
, optMinimizeRefinement = 0 , optMinimizeRefinement = 0
, optInvariant = False , optInvariant = False
, optOutput = Nothing , optOutput = Nothing
...@@ -128,7 +126,7 @@ options = ...@@ -128,7 +126,7 @@ options =
optProperties = DeadlockFreeUnlessFinal : optProperties opt optProperties = DeadlockFreeUnlessFinal : optProperties opt
})) }))
("Prove that the net is deadlock-free\n" ++ ("Prove that the net is deadlock-free\n" ++
"unless it is in the final marking") " unless it is in the final marking")
, Option "" ["final-state-unreachable"] , Option "" ["final-state-unreachable"]
(NoArg (\opt -> Right opt { (NoArg (\opt -> Right opt {
...@@ -179,17 +177,17 @@ options = ...@@ -179,17 +177,17 @@ options =
(NoArg (\opt -> Right opt { optInvariant = True })) (NoArg (\opt -> Right opt { optInvariant = True }))
"Generate an invariant" "Generate an invariant"
, Option "n" ["no-refinement"] , Option "r" ["refinement"]
(NoArg (\opt -> Right opt { optRefine = False })) (ReqArg (\arg opt -> case reads arg :: [(Int, String)] of
"Don't use refinement" [(0, "")] -> Right opt { optRefinementType = Nothing }
[(1, "")] -> Right opt { optRefinementType = Just SComponentWithCutRefinement }
, Option "" ["trap-refinement"] [(2, "")] -> Right opt { optRefinementType = Just SComponentRefinement }
(NoArg (\opt -> Right opt { optRefinementType = TrapRefinement })) [(3, "")] -> Right opt { optRefinementType = Just TrapRefinement }
"Only use empty trap refinement for liveness properties" _ -> Left ("invalid argument for refinement method: " ++ arg)
)
, Option "" ["scomponent-refinement"] "METHOD")
(NoArg (\opt -> Right opt { optRefinementType = SComponentRefinement })) ("Refine with METHOD (0=none, 1=SCompCut+Traps,\n" ++
"Use S-component refinement before trap refinement" " 2=SComp+Traps, 3=Traps)")
, Option "o" ["output"] , Option "o" ["output"]
(ReqArg (\arg opt -> Right opt { (ReqArg (\arg opt -> Right opt {
......
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