Commit 2829680d authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Added option to not use refinement

parent 64a250c5
...@@ -28,6 +28,7 @@ data Options = Options { inputFormat :: InputFormat ...@@ -28,6 +28,7 @@ data Options = Options { inputFormat :: InputFormat
, optShowHelp :: Bool , optShowHelp :: Bool
, optShowVersion :: Bool , optShowVersion :: Bool
, proveTermination :: Bool , proveTermination :: Bool
, optRefine :: Bool
} }
startOptions :: Options startOptions :: Options
...@@ -36,6 +37,7 @@ startOptions = Options { inputFormat = PNET ...@@ -36,6 +37,7 @@ startOptions = Options { inputFormat = PNET
, optShowHelp = False , optShowHelp = False
, optShowVersion = False , optShowVersion = False
, proveTermination = False , proveTermination = False
, optRefine = True
} }
options :: [ OptDescr (Options -> Either String Options) ] options :: [ OptDescr (Options -> Either String Options) ]
...@@ -56,6 +58,10 @@ options = ...@@ -56,6 +58,10 @@ options =
(NoArg (\opt -> Right opt { proveTermination = True })) (NoArg (\opt -> Right opt { proveTermination = True }))
"Prove termination" "Prove termination"
, Option "n" ["no-refinement"]
(NoArg (\opt -> Right opt { optRefine = False }))
"Don't use refinement"
, Option "v" ["verbose"] , Option "v" ["verbose"]
(NoArg (\opt -> Right opt { optVerbose = True })) (NoArg (\opt -> Right opt { optVerbose = True }))
"Enable verbose messages" "Enable verbose messages"
...@@ -77,33 +83,34 @@ parseArgs = do ...@@ -77,33 +83,34 @@ parseArgs = do
return $ (,files) <$> foldl (>>=) (return startOptions) actions return $ (,files) <$> foldl (>>=) (return startOptions) actions
(_, _, errs) -> return $ Left $ concat errs (_, _, errs) -> return $ Left $ concat errs
checkFile :: Parser (PetriNet,[Property]) -> Bool -> [Property] -> checkFile :: Parser (PetriNet,[Property]) -> Bool -> Bool -> [Property] ->
String -> IO Bool String -> IO Bool
checkFile parser verbose addedProperties file = do checkFile parser verbose refine addedProperties file = do
putStrLn $ "Reading \"" ++ file ++ "\"" putStrLn $ "Reading \"" ++ file ++ "\""
(net,properties) <- parseFile parser file (net,properties) <- parseFile parser file
putStrLn $ "Analyzing " ++ showNetName net putStrLn $ "Analyzing " ++ showNetName net
when verbose (do when verbose (do
print net
putStrLn $ "Places: " ++ show (length $ places net) putStrLn $ "Places: " ++ show (length $ places net)
putStrLn $ "Transitions: " ++ show (length $ transitions net) putStrLn $ "Transitions: " ++ show (length $ transitions net)
) )
rs <- mapM (checkProperty verbose net) (addedProperties ++ properties) rs <- mapM (checkProperty verbose net refine)
(addedProperties ++ properties)
putStrLn "" putStrLn ""
return $ and rs return $ and rs
checkProperty :: Bool -> PetriNet -> Property -> IO Bool checkProperty :: Bool -> PetriNet -> Bool -> Property -> IO Bool
checkProperty verbose net p = do checkProperty verbose net refine p = do
putStrLn $ "\nChecking " ++ showPropertyName p putStrLn $ "\nChecking " ++ showPropertyName p
r <- case ptype p of r <- case ptype p of
Safety -> checkSafetyProperty verbose net (pformula p) [] Safety -> checkSafetyProperty verbose net refine (pformula p) []
Liveness -> checkLivenessProperty verbose net (pformula p) [] Liveness -> checkLivenessProperty verbose net refine (pformula p) []
putStrLn $ if r then "Property is satisfied." putStrLn $ if r then "Property is satisfied."
else "Property may not be satisfied." else "Property may not be satisfied."
return r return r
checkSafetyProperty :: Bool -> PetriNet -> Formula -> [[String]] -> IO Bool checkSafetyProperty :: Bool -> PetriNet -> Bool ->
checkSafetyProperty verbose net f traps = do Formula -> [[String]] -> IO Bool
checkSafetyProperty verbose net refine f traps = do
r <- checkSat $ checkStateEquationSat net f traps r <- checkSat $ checkStateEquationSat net f traps
case r of case r of
Nothing -> return True Nothing -> return True
...@@ -111,19 +118,25 @@ checkSafetyProperty verbose net f traps = do ...@@ -111,19 +118,25 @@ checkSafetyProperty verbose net f traps = do
let assigned = markedPlacesFromAssignment net a let assigned = markedPlacesFromAssignment net a
putStrLn "Assignment found" putStrLn "Assignment found"
when verbose (putStrLn $ "Places marked: " ++ show assigned) when verbose (putStrLn $ "Places marked: " ++ show assigned)
rt <- checkSat $ checkTrapSat net assigned if refine then do
case rt of rt <- checkSat $ checkTrapSat net assigned
Nothing -> do case rt of
putStrLn "No trap found." Nothing -> do
return False putStrLn "No trap found."
Just at -> do return False
let trap = trapFromAssignment at Just at -> do
putStrLn "Trap found" let trap = trapFromAssignment at
when verbose (putStrLn $ "Places in trap: " ++ show trap) putStrLn "Trap found"
checkSafetyProperty verbose net f (trap:traps) when verbose (putStrLn $ "Places in trap: " ++
show trap)
checkLivenessProperty :: Bool -> PetriNet -> Formula -> [([String],[String])] -> IO Bool checkSafetyProperty verbose net refine f
checkLivenessProperty verbose net f strans = do (trap:traps)
else
return False
checkLivenessProperty :: Bool -> PetriNet -> Bool ->
Formula -> [([String],[String])] -> IO Bool
checkLivenessProperty verbose net refine f strans = do
r <- checkSat $ checkTransitionInvariantSat net f strans r <- checkSat $ checkTransitionInvariantSat net f strans
case r of case r of
Nothing -> return True Nothing -> return True
...@@ -131,16 +144,20 @@ checkLivenessProperty verbose net f strans = do ...@@ -131,16 +144,20 @@ checkLivenessProperty verbose net f strans = do
let fired = firedTransitionsFromAssignment ax let fired = firedTransitionsFromAssignment ax
putStrLn "Assignment found" putStrLn "Assignment found"
when verbose (putStrLn $ "Transitions fired: " ++ show fired) when verbose (putStrLn $ "Transitions fired: " ++ show fired)
rt <- checkSat $ checkSComponentSat net fired ax if refine then do
case rt of rt <- checkSat $ checkSComponentSat net fired ax
Nothing -> do case rt of
putStrLn "No S-component found" Nothing -> do
return False putStrLn "No S-component found"
Just as -> do return False
let sOutIn = getSComponentOutIn net ax as Just as -> do
putStrLn "S-component found" let sOutIn = getSComponentOutIn net ax as
when verbose (putStrLn $ "Out/In: " ++ show sOutIn) putStrLn "S-component found"
checkLivenessProperty verbose net f (sOutIn:strans) when verbose (putStrLn $ "Out/In: " ++ show sOutIn)
checkLivenessProperty verbose net refine f
(sOutIn:strans)
else
return False
main :: IO () main :: IO ()
main = do main = do
...@@ -160,7 +177,8 @@ main = do ...@@ -160,7 +177,8 @@ main = do
TPN -> TPN.parseContent TPN -> TPN.parseContent
let properties = [ Property "termination" Liveness FTrue let properties = [ Property "termination" Liveness FTrue
| proveTermination opts ] | proveTermination opts ]
rs <- mapM (checkFile parser (optVerbose opts) properties) files rs <- mapM (checkFile parser (optVerbose opts) (optRefine opts)
properties) files
if and rs then if and rs then
exitSuccessWith "All properties satisfied." exitSuccessWith "All properties satisfied."
else else
......
Supports Markdown
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