The expiration time for new job artifacts in CI/CD pipelines is now 30 days (GitLab default). Previously generated artifacts in already completed jobs will not be affected by the change. The latest artifacts for all jobs in the latest successful pipelines will be kept. More information: https://gitlab.lrz.de/help/user/admin_area/settings/continuous_integration.html#default-artifacts-expiration

Commit 35991dce authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Moved options to a monad

parent 4d7802a2
This diff is collapsed.
{-# LANGUAGE TupleSections #-}
module Options
(InputFormat(..),OutputFormat(..),NetTransformation(..),
ImplicitProperty(..),Options(..),startOptions,options,parseArgs,
usageInformation)
where
import Control.Applicative ((<$>))
import System.Console.GetOpt
import System.Environment (getArgs)
data InputFormat = PNET | LOLA | TPN | MIST deriving (Show,Read)
data OutputFormat = OutLOLA | OutSARA | OutSPEC | OutDOT deriving (Read)
instance Show OutputFormat where
show OutLOLA = "LOLA"
show OutSARA = "SARA"
show OutSPEC = "SPEC"
show OutDOT = "DOT"
data NetTransformation = TerminationByReachability
| ValidateIdentifiers
data ImplicitProperty = Termination
| DeadlockFree | DeadlockFreeUnlessFinal
| FinalStateUnreachable
| ProperTermination
| Safe | Bounded Integer
| StructFreeChoice
| StructParallel
| StructFinalPlace
| StructCommunicationFree
deriving (Show,Read)
data Options = Options { inputFormat :: InputFormat
, optVerbosity :: Int
, optShowHelp :: Bool
, optShowVersion :: Bool
, optProperties :: [ImplicitProperty]
, optTransformations :: [NetTransformation]
, optRefine :: Bool
, optInvariant :: Bool
, optOutput :: Maybe String
, outputFormat :: OutputFormat
, optUseProperties :: Bool
, optPrintStructure :: Bool
}
startOptions :: Options
startOptions = Options { inputFormat = PNET
, optVerbosity = 1
, optShowHelp = False
, optShowVersion = False
, optProperties = []
, optTransformations = []
, optRefine = True
, optInvariant = False
, optOutput = Nothing
, outputFormat = OutLOLA
, optUseProperties = True
, optPrintStructure = False
}
options :: [ OptDescr (Options -> Either String Options) ]
options =
[ Option "" ["pnet"]
(NoArg (\opt -> Right opt { inputFormat = PNET }))
"Use the pnet input format"
, Option "" ["lola"]
(NoArg (\opt -> Right opt { inputFormat = LOLA }))
"Use the lola input format"
, Option "" ["tpn"]
(NoArg (\opt -> Right opt { inputFormat = TPN }))
"Use the tpn input format"
, Option "" ["spec"]
(NoArg (\opt -> Right opt { inputFormat = MIST }))
"Use the mist input format"
, Option "s" ["structure"]
(NoArg (\opt -> Right opt { optPrintStructure = True }))
"Print structural information"
, Option "" ["validate-identifiers"]
(NoArg (\opt -> Right opt {
optTransformations = ValidateIdentifiers : optTransformations opt
}))
"Make identifiers valid for lola"
, Option "" ["termination-by-reachability"]
(NoArg (\opt -> Right opt {
optTransformations = TerminationByReachability : optTransformations opt
}))
"Prove termination by reducing it to reachability"
, Option "" ["termination"]
(NoArg (\opt -> Right opt {
optProperties = Termination : optProperties opt
}))
"Prove that the net is terminating"
, Option "" ["proper-termination"]
(NoArg (\opt -> Right opt {
optProperties = ProperTermination : optProperties opt
}))
"Prove termination in the final marking"
, Option "" ["deadlock-free"]
(NoArg (\opt -> Right opt {
optProperties = DeadlockFree : optProperties opt
}))
"Prove that the net is deadlock-free"
, Option "" ["deadlock-free-unless-final"]
(NoArg (\opt -> Right opt {
optProperties = DeadlockFreeUnlessFinal : optProperties opt
}))
("Prove that the net is deadlock-free\n" ++
"unless it is in the final marking")
, Option "" ["final-state-unreachable"]
(NoArg (\opt -> Right opt {
optProperties = FinalStateUnreachable : optProperties opt
}))
"Prove that the final state is unreachable"
, Option "" ["safe"]
(NoArg (\opt -> Right opt {
optProperties = Safe : optProperties opt
}))
"Prove that the net is safe, i.e. 1-bounded"
, Option "" ["bounded"]
(ReqArg (\arg opt -> case reads arg of
[(k, "")] -> Right opt {
optProperties = Bounded k : optProperties opt }
_ -> Left ("invalid argument for k-bounded option: " ++ arg)
)
"K")
"Prove that the net is K-bounded"
, Option "" ["free-choice"]
(NoArg (\opt -> Right opt {
optProperties = StructFreeChoice : optProperties opt
}))
"Prove that the net is free-choice"
, Option "" ["parallel"]
(NoArg (\opt -> Right opt {
optProperties = StructParallel : optProperties opt
}))
"Prove that the net has non-trivial parallellism"
, Option "" ["final-place"]
(NoArg (\opt -> Right opt {
optProperties = StructFinalPlace : optProperties opt
}))
"Prove that there is only one needed final place"
, Option "" ["communication-free"]
(NoArg (\opt -> Right opt {
optProperties = StructCommunicationFree : optProperties opt
}))
"Prove that the net is communication-free"
, Option "n" ["no-refinement"]
(NoArg (\opt -> Right opt { optRefine = False }))
"Don't use refinement"
, Option "i" ["invariant"]
(NoArg (\opt -> Right opt { optInvariant = True }))
"Try to generate an invariant"
, Option "o" ["output"]
(ReqArg (\arg opt -> Right opt {
optOutput = Just arg
})
"FILE")
"Write net and properties to FILE"
, Option "" ["out-lola"]
(NoArg (\opt -> Right opt { outputFormat = OutLOLA }))
"Use the lola output format"
, Option "" ["out-sara"]
(NoArg (\opt -> Right opt { outputFormat = OutSARA }))
"Use the sara output format"
, Option "" ["out-spec"]
(NoArg (\opt -> Right opt { outputFormat = OutSPEC }))
"Use the spec output format"
, Option "" ["out-dot"]
(NoArg (\opt -> Right opt { outputFormat = OutDOT }))
"Use the dot output format"
, Option "" ["no-given-properties"]
(NoArg (\opt -> Right opt {
optUseProperties = False
}))
"Do not use the properties given in the input file"
, Option "v" ["verbose"]
(NoArg (\opt -> Right opt { optVerbosity = optVerbosity opt + 1 }))
"Increase verbosity (may be specified more than once)"
, Option "q" ["quiet"]
(NoArg (\opt -> Right opt { optVerbosity = optVerbosity opt - 1 }))
"Decrease verbosity (may be specified more than once)"
, Option "V" ["version"]
(NoArg (\opt -> Right opt { optShowVersion = True }))
"Show version"
, Option "h" ["help"]
(NoArg (\opt -> Right opt { optShowHelp = True }))
"Show help"
]
parseArgs :: IO (Either String (Options, [String]))
parseArgs = do
args <- getArgs
case getOpt Permute options args of
(actions, files, []) ->
return $ (,files) <$> foldl (>>=) (return startOptions) actions
(_, _, errs) -> return $ Left $ concat errs
usageInformation :: String
usageInformation = usageInfo "SLAPnet" options
......@@ -10,6 +10,8 @@ import Data.SBV
import qualified Data.Map as M
import Util
import Options
import Control.Monad.IO.Class
type ConstraintProblem a b =
(String, String, [String], (String -> SBV a) -> SBool, (String -> a) -> b)
......@@ -26,20 +28,21 @@ symConstraints vars constraint = do
syms <- mapM exists vars
return $ constraint $ val $ M.fromList $ vars `zip` syms
checkSat :: (SatModel a, SymWord a, Show a, Show b) => Int ->
ConstraintProblem a b -> IO (Maybe b)
checkSat verbosity (problemName, resultName, vars, constraint, interpretation) = do
verbosePut verbosity 1 $ "Checking SAT of " ++ problemName
result <- satWith z3{verbose=verbosity >= 4} $
symConstraints vars constraint
checkSat :: (SatModel a, SymWord a, Show a, Show b) =>
ConstraintProblem a b -> OptIO (Maybe b)
checkSat (problemName, resultName, vars, constraint, interpretation) = do
verbosePut 1 $ "Checking SAT of " ++ problemName
verbosity <- opt optVerbosity
result <- liftIO (satWith z3{verbose=verbosity >= 4}
(symConstraints vars constraint))
case rebuildModel vars (getModel result) of
Nothing -> do
verbosePut verbosity 2 "- unsat"
verbosePut 2 "- unsat"
return Nothing
Just rawModel -> do
verbosePut verbosity 2 "- sat"
verbosePut 2 "- sat"
let model = interpretation $ val rawModel
verbosePut verbosity 3 $ "- " ++ resultName ++ ": " ++ show model
verbosePut verbosity 4 $ "- raw model: " ++ show rawModel
verbosePut 3 $ "- " ++ resultName ++ ": " ++ show model
verbosePut 4 $ "- raw model: " ++ show rawModel
return $ Just model
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-}
module Util
(verbosePut,elems,items,emap,prime,numPref,
(elems,items,emap,prime,numPref,
listSet,listMap,val,vals,mval,zeroVal,positiveVal,sumVal,
makeVarMap,makeVarMapWith,buildVector,makeVector,getNames,
Vector,Model,VarMap,SIMap,SBMap,IMap,BMap,showWeighted)
Vector,Model,VarMap,SIMap,SBMap,IMap,BMap,showWeighted,
OptIO,verbosePut,opt,putLine)
where
import Data.SBV
......@@ -13,6 +14,9 @@ import Control.Monad
import Data.List
import Data.Ord
import Data.Function
import Control.Monad.Reader
import Options
{-
- Various maps and functions on them
......@@ -93,12 +97,21 @@ listMap = map (foldl1 (\(x1,y1) (_,y2) -> (x1,y1 + y2))) .
groupBy ((==) `on` fst) . sortBy (comparing fst)
{-
- TODO: IO wrapper with options
- IO functions
-}
verbosePut :: Int -> Int -> String -> IO ()
verbosePut verbosity level str =
when (verbosity >= level) (putStrLn str)
type OptIO a = ReaderT Options IO a
opt :: (Options -> a) -> OptIO a
opt getOpt = liftM getOpt ask
verbosePut :: Int -> String -> OptIO ()
verbosePut level str = do
verbosity <- opt optVerbosity
when (verbosity >= level) (putLine str)
putLine :: String -> OptIO ()
putLine = liftIO . putStrLn
{-
- String functions
......
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