The name of the initial branch for new projects is now "main" instead of "master". Existing projects remain unchanged. More information: https://doku.lrz.de/display/PUBLIC/GitLab

Commit 29184fb1 authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Used Z3 API for transition invariants

parent 30287c06
...@@ -25,7 +25,7 @@ import Property ...@@ -25,7 +25,7 @@ import Property
import Solver import Solver
import Solver.StateEquation import Solver.StateEquation
import Solver.TrapConstraints import Solver.TrapConstraints
--import Solver.TransitionInvariant import Solver.TransitionInvariant
--import Solver.SComponent --import Solver.SComponent
data InputFormat = PNET | LOLA | TPN | MIST deriving (Show,Read) data InputFormat = PNET | LOLA | TPN | MIST deriving (Show,Read)
...@@ -330,14 +330,14 @@ checkSafetyProperty verbosity net refine f traps = do ...@@ -330,14 +330,14 @@ checkSafetyProperty verbosity net refine f traps = do
checkLivenessProperty :: Int -> PetriNet -> Bool -> checkLivenessProperty :: Int -> PetriNet -> Bool ->
Formula -> [([String],[String])] -> IO Bool Formula -> [([String],[String])] -> IO Bool
checkLivenessProperty verbosity net refine f strans = do checkLivenessProperty verbosity net refine f strans = do
r <- return Nothing -- checkSatInt $ checkTransitionInvariantSat net f strans r <- checkSatInt $ checkTransitionInvariantSat net f strans
case r of case r of
Nothing -> return True Nothing -> return True
Just ax -> do Just ax -> do
let fired = [] -- firedTransitionsFromAssignment ax let fired = firedTransitionsFromAssignment ax
verbosePut verbosity 1 "Assignment found" verbosePut verbosity 1 "Assignment found"
-- verbosePut verbosity 2 $ "Transitions fired: " ++ show fired verbosePut verbosity 2 $ "Transitions fired: " ++ show fired
-- verbosePut verbosity 3 $ "Assignment: " ++ show ax verbosePut verbosity 3 $ "Assignment: " ++ show ax
if refine then do if refine then do
rt <- return Nothing -- checkSat $ checkSComponentSat net fired ax rt <- return Nothing -- checkSat $ checkSComponentSat net fired ax
case rt of case rt of
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
module Solver module Solver
(checkSat,checkSatInt,checkSatBool,MModelS,MModelI,MModelB, (checkSat,checkSatInt,checkSatBool,MModelS,MModelI,MModelB,
MModel(..),mVal,mValues,mElemsWith,mElemSum,CModel(..), MModel(..),mVal,mValues,mElemsWith,mElemSum,CModel(..),
Z3Type(..),mkOr',mkAnd') Z3Type(..),mkOr',mkAnd',mkAdd',mkSub',mkMul')
where where
import Z3.Monad import Z3.Monad
...@@ -20,7 +20,7 @@ type MModelI = MModel Integer ...@@ -20,7 +20,7 @@ type MModelI = MModel Integer
type MModelB = MModel (Maybe Bool) type MModelB = MModel (Maybe Bool)
class Z3Type a where class Z3Type a where
mkVal :: a -> Z3 AST -- TODO: needed? mkVal :: a -> Z3 AST
getVal :: AST -> Z3 a getVal :: AST -> Z3 a
instance Z3Type Integer where instance Z3Type Integer where
...@@ -54,6 +54,18 @@ mkAnd' :: [AST] -> Z3 AST ...@@ -54,6 +54,18 @@ mkAnd' :: [AST] -> Z3 AST
mkAnd' [] = mkTrue mkAnd' [] = mkTrue
mkAnd' xs = mkAnd xs mkAnd' xs = mkAnd xs
mkAdd' :: [AST] -> Z3 AST
mkAdd' [] = mkInt (0::Integer)
mkAdd' xs = mkAdd xs
mkSub' :: [AST] -> Z3 AST
mkSub' [] = mkInt (0::Integer)
mkSub' xs = mkSub xs
mkMul' :: [AST] -> Z3 AST
mkMul' [] = mkInt (1::Integer)
mkMul' xs = mkMul xs
--class SMModel a where --class SMModel a where
-- mElem :: MModel a -> String -> Z3 AST -- mElem :: MModel a -> String -> Z3 AST
-- mNotElem :: MModel a -> String -> Z3 AST -- mNotElem :: MModel a -> String -> Z3 AST
......
...@@ -3,47 +3,56 @@ module Solver.TransitionInvariant ...@@ -3,47 +3,56 @@ module Solver.TransitionInvariant
firedTransitionsFromAssignment) firedTransitionsFromAssignment)
where where
import Data.SBV import Z3.Monad
import Control.Monad
import PetriNet import PetriNet
import Property import Property
import Solver import Solver
import Solver.Formula import Solver.Formula
tInvariantConstraints :: PetriNet -> ModelSI -> SBool tInvariantConstraints :: PetriNet -> MModelS -> Z3 ()
tInvariantConstraints net m = tInvariantConstraints net m =
bAnd $ map checkTransitionEquation $ places net mapM_ (assertCnstr <=< checkTransitionEquation) $ places net
where checkTransitionEquation p = where checkTransitionEquation p = do
let incoming = map addTransition $ lpre net p incoming <- mapM (addTransition 1 ) $ lpre net p
outgoing = map addTransition $ lpost net p outgoing <- mapM (addTransition (-1)) $ lpost net p
in sum incoming - sum outgoing .>= 0 sums <- mkAdd' (incoming ++ outgoing)
addTransition (t,w) = literal w * mVal m t mkGe sums =<< mkVal (0::Integer)
addTransition fac (t,w) =
finalInvariantConstraints :: ModelSI -> SBool mkVal (fac*w) >>= \w' -> mkMul [w', mVal m t]
finalInvariantConstraints m = sum (mValues m) .> 0
finalInvariantConstraints :: MModelS -> Z3 ()
nonnegativityConstraints :: ModelSI -> SBool finalInvariantConstraints m = do
nonnegativityConstraints m = bAnd $ map (.>= 0) $ mValues m sums <- mkAdd' (mValues m)
assertCnstr =<< mkGt sums =<< mkVal (0::Integer)
checkSComponentTransitions :: [([String],[String])] -> ModelSI -> SBool
checkSComponentTransitions strans m = bAnd $ map checkInOut strans nonnegativityConstraints :: MModelS -> Z3 ()
where checkInOut (sOut,sIn) = nonnegativityConstraints m = mapM_ (assertCnstr <=< geZero) $ mValues m
bAnd (map (\t -> mVal m t .> 0) sOut) ==> where geZero v = mkGe v =<< mkVal (0::Integer)
bOr (map (\t -> mVal m t .> 0) sIn)
checkSComponentTransitions :: [([String],[String])] -> MModelS -> Z3 ()
checkSComponentTransitions strans m = mapM_ (assertCnstr <=< checkInOut) strans
where checkInOut (sOut,sIn) = do
lhs <- mkAnd' =<<
mapM (\t -> mkGt (mVal m t) =<< mkVal (0::Integer)) sOut
rhs <- mkOr' =<<
mapM (\t -> mkGt (mVal m t) =<< mkVal (0::Integer)) sIn
mkImplies lhs rhs
checkTransitionInvariant :: PetriNet -> Formula -> [([String],[String])] -> checkTransitionInvariant :: PetriNet -> Formula -> [([String],[String])] ->
ModelSI -> SBool MModelS -> Z3 ()
checkTransitionInvariant net f strans m = checkTransitionInvariant net f strans m = do
tInvariantConstraints net m &&& tInvariantConstraints net m
nonnegativityConstraints m &&& nonnegativityConstraints m
finalInvariantConstraints m &&& finalInvariantConstraints m
checkSComponentTransitions strans m &&& checkSComponentTransitions strans m
evaluateFormula f m assertCnstr =<< evaluateFormula f m
checkTransitionInvariantSat :: PetriNet -> Formula -> [([String],[String])] -> checkTransitionInvariantSat :: PetriNet -> Formula -> [([String],[String])] ->
([String], ModelSI -> SBool) ([String], MModelS -> Z3 ())
checkTransitionInvariantSat net f strans = checkTransitionInvariantSat net f strans =
(transitions net, checkTransitionInvariant net f strans) (transitions net, checkTransitionInvariant net f strans)
firedTransitionsFromAssignment :: ModelI -> [String] firedTransitionsFromAssignment :: MModelI -> [String]
firedTransitionsFromAssignment = mElemsWith (> 0) firedTransitionsFromAssignment = mElemsWith (> 0)
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