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 by Philipp Meyer

### 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!