Starting from 2021-07-01, all LRZ GitLab users will be required to explicitly accept the GitLab Terms of Service. Please see the detailed information at https://doku.lrz.de/display/PUBLIC/GitLab and make sure that your projects conform to the requirements.

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