diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,88 @@ + +# Release Notes + +## 4.0.0 + +This release brings support for the new Z3 4.x API, +and *removes* support for the old API. +We are following a new version policy, yet compatible with Haskell's PVP. +So new versions are of the form *x.y.z*, +where *x* is the version of Z3 API supported, +*y* is a major revision of the bindings, +and *z* is a minor revision of the bindings. +Consequently, we bumped the version to *4.0.0* :-). + +Special thanks to Nadia Polikarpova, +who diagnosed a problem in our use of ```ForeignPtr``` finalizers, +and proposed a fix. + +### Cabal package + +* Relaxed dependencies, and removed upper bounds. + +### New features and API functions + +* Switched to Z3 4.x API. +* Reference counting is managed by the gargabe collector. +* Algebraic datatypes. (KC Sivaramakrishnan) +* ```Z3_get_ast_kind```, ```Z3_solver_check_assumptions```, ```Z3_solver_get_unsat_core```. (Nadia Polikarpova) +* ```Z3_mk_fresh_const```, ```Z3_mk_fresh_func_decl```. (KC Sivaramakrishnan) +* ```MonadFix``` instance for the ```Z3``` monad. (Pepe Iborra) +* Hspec test-suite, with just a couple of tests, more to come... +* A few more helpers for creating numerals, evaluating expressions, and so on. +* Module ```Z3.Base.C```, a very low-level interface to Z3 C API, is now exported. + Just in case you want to write your own marshaling layer ;-) + +### Removals and API-breaking changes + +* No more support for the old Z3 3.x API. +* Removed ```Z3.Lang``` module, this should re-appear as a separate package soon. +* ```MonadZ3``` instances must be ```Applicative```. +* Numerals API is now closer to Z3 C API. + So, for instance, ```mkInt``` now takes both an integer and a sort. + You can use ```mkInteger``` or ```mkIntNum``` instead. +* ```Z3.Monad.assertCnstr``` is now called ```Z3.Monad.assert```. + +### Refactoring and clean-up + +* Reduce boilerplate in Z3.Base. +* Fix docs to distinguish Z3 API functions and helpers. + +## 0.3.2 + +Thanks to Scott West and Nadia Polikarpova for contributing to this release. + +### Fixes + +* Fixed _solverCheckAndGetModel_ to return a model from an unknown satisfiability result, if one exists. (Nadia Polikarpova) +* Fixed mkMap API function to do **not** take the number of arrays as an input parameter, this should be equals to the length of the input array list. + Strictly speaking this is a minor break of the API but it was considered a but and therefore fixed. + +### Refactoring and clean-up + +* Reduced marshalling boilerplate in Z3.Base. + This is a very important step towards supporting Z3 4.0 API. +* Improved API documentation. + If you are having difficulties due to (presumably) poor API or source documentation, please let us know. + +### New features + +* Support running multiple queries under the same logical context, using _evalZ3WithEnv_. (Scott West) + +### Newly supported API functions + +* Many solver-related API functions (Scott West and Nadia Polikarpova). +* z3_mk_forall_const (Scott West), z3_mk_exists_const. +* Z3_get_version. + +### Deprecations + +* We deprecate _showContext_, _showModel_ and _getModel_; since we prefer to avoid deviations from Z3 API names. + Use _contextToString_, _modelToString_ and _checkAndGetModel_ instead. +* We deprecate the Z3.Lang interface, that will be moved to a separate pacakge. + Few people is using this (_DSL_ish) interface and it is arguably more unstable than Z3.Base or Z3.Monad. + It also introduces dependencies with GHC extensions like type families that we prefer to avoid in a more stable package. + +### Misc + +* Add SMT to categories in z3.cabal. diff --git a/HACKING.md b/HACKING.md new file mode 100644 --- /dev/null +++ b/HACKING.md @@ -0,0 +1,19 @@ + +# Contributing to Haskell Z3 bindings + +Most modules include a HACKING documentation section at the top that you should read before. + +We appreciate your contact before contributing to the project, +in order to avoid duplication of work and agree on possible design decisions. + +Please follow roughly the same coding style than us. + +Let us know if you find any barrier to contribute, so we can fix that :-) + +## Adding support an API function + +1. Declare the functions in Z3/Lang/C.hsc. +1. Lift the function to the IO monad in Z3/Base.hs, +there is a bunch of marshalling helpers that should make this trivial in most cases. +1. Lift the function to the Z3 monad in Z3/Monad.hs, +this is trivially done using one of the _liftFun_ helpers. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,80 @@ + +# Haskell bindings for Microsoft's Z3 (unofficial) + +These are Haskell bindings for the Z3 theorem prover. +We don't provide any high-level interface (e.g. in the form of a Haskell eDSL) here, +these bindings are targeted to those who want to build verification tools on top of Z3 in Haskell. + +[Changelog here.](https://bitbucket.org/iago/z3-haskell/src/tip/CHANGES.md) + +[Examples here.](https://bitbucket.org/iago/z3-haskell/src/tip/examples) + +[Do you want to contribute?](https://bitbucket.org/iago/z3-haskell/src/tip/CHANGES.md) + +## Installation + +Preferably use the [z3](http://hackage.haskell.org/package/z3) package. + +* Install a [Z3](https://github.com/Z3Prover/z3) *4.x* release. + (Support for Z3 *3.x* is provided by the *0.3.2* version of these bindings.) +* Just type _cabal install z3_ if you used the standard locations for dynamic libraries (_/usr/lib_) and header files (_/usr/include_). + + * Otherwise use the _--extra-lib-dirs_ and _--extra-include-dirs_ Cabal flags when installing. + +## Example + +Most people uses the ```Z3.Monad``` interface. +Here is an example script that solves the 4-queen puzzle: + + import Control.Applicative + import Control.Monad ( join ) + import Data.Maybe + import qualified Data.Traversable as T + + import Z3.Monad + + script :: Z3 (Maybe [Integer]) + script = do + q1 <- mkFreshIntVar "q1" + q2 <- mkFreshIntVar "q2" + q3 <- mkFreshIntVar "q3" + q4 <- mkFreshIntVar "q4" + _1 <- mkInteger 1 + _4 <- mkInteger 4 + -- the ith-queen is in the ith-row. + -- qi is the column of the ith-queen + assert =<< mkAnd =<< T.sequence + [ mkLe _1 q1, mkLe q1 _4 -- 1 <= q1 <= 4 + , mkLe _1 q2, mkLe q2 _4 + , mkLe _1 q3, mkLe q3 _4 + , mkLe _1 q4, mkLe q4 _4 + ] + -- different columns + assert =<< mkDistinct [q1,q2,q3,q4] + -- avoid diagonal attacks + assert =<< mkNot =<< mkOr =<< T.sequence + [ diagonal 1 q1 q2 -- diagonal line of attack between q1 and q2 + , diagonal 2 q1 q3 + , diagonal 3 q1 q4 + , diagonal 1 q2 q3 + , diagonal 2 q2 q4 + , diagonal 1 q3 q4 + ] + -- check and get solution + fmap snd $ withModel $ \m -> + catMaybes <$> mapM (evalInt m) [q1,q2,q3,q4] + where mkAbs x = do + _0 <- mkInteger 0 + join $ mkIte <$> mkLe _0 x <*> pure x <*> mkUnaryMinus x + diagonal d c c' = + join $ mkEq <$> (mkAbs =<< mkSub [c',c]) <*> (mkInteger d) + +In order to run this SMT script: + + main :: IO () + main = evalZ3With Nothing opts script >>= \mbSol -> + case mbSol of + Nothing -> error "No solution found." + Just sol -> putStr "Solution: " >> print sol + where opts = opt "MODEL" True +? opt "MODEL_COMPLETION" True + diff --git a/Z3/Base.hs b/Z3/Base.hs deleted file mode 100644 --- a/Z3/Base.hs +++ /dev/null @@ -1,1960 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE TupleSections #-} - --- | --- Module : Z3.Base --- Copyright : (c) Iago Abal, 2012-2014 --- (c) David Castro, 2012-2013 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro --- --- Low-level bindings to Z3 API. --- --- There is (mostly) a one-to-one correspondence with Z3 C API, thus see --- --- for further details. --- --- Note that these bindings still focus on the old Z3 3.x API, and will not --- handle reference counting for you if you decide to use Z3 4.x API functions. --- Mixing both API is known to cause some segmentation faults! --- --- Supporting Z3 4.x API (and removing support for 3.x) is planned for --- the 0.4 version of these bindings. - -{- HACKING - -Add here the IO-based wrapper for a new Z3 API function: - -* Take a look to a few others API functions and follow the same coding style. - * 2-space wide indentation, no tabs. - * No trailing spaces, please. - * ... -* Place the API function in the right section, according to the Z3's API documentation. -* Annotate the API function with a short but concise haddock comment. - * Look at the Z3 API documentation for inspiration. -* Add the API function to the module export list, (only) if needed. - -This should be straightforward for most cases using [MARSHALLING HELPERS]. --} - -module Z3.Base ( - - -- * Types - Config - , Context - , Symbol - , AST - , Sort - , FuncDecl - , App - , Pattern - , Model - , FuncInterp - , FuncEntry - , Params - , Solver - - -- ** Satisfiability result - , Result(..) - - -- * Configuration - , mkConfig - , delConfig - , withConfig - , setParamValue - - -- * Context - , mkContext - , delContext - , withContext - , contextToString - , showContext - - -- * Symbols - , mkIntSymbol - , mkStringSymbol - - -- * Sorts - , mkUninterpretedSort - , mkBoolSort - , mkIntSort - , mkRealSort - , mkBvSort - , mkArraySort - , mkTupleSort - - -- * Constants and Applications - , mkFuncDecl - , mkApp - , mkConst - , mkTrue - , mkFalse - , mkEq - , mkNot - , mkIte - , mkIff - , mkImplies - , mkXor - , mkAnd - , mkOr - , mkDistinct - , mkAdd - , mkMul - , mkSub - , mkUnaryMinus - , mkDiv - , mkMod - , mkRem - , mkLt - , mkLe - , mkGt - , mkGe - , mkInt2Real - , mkReal2Int - , mkIsInt - - -- * Bit-vectors - , mkBvnot - , mkBvredand - , mkBvredor - , mkBvand - , mkBvor - , mkBvxor - , mkBvnand - , mkBvnor - , mkBvxnor - , mkBvneg - , mkBvadd - , mkBvsub - , mkBvmul - , mkBvudiv - , mkBvsdiv - , mkBvurem - , mkBvsrem - , mkBvsmod - , mkBvult - , mkBvslt - , mkBvule - , mkBvsle - , mkBvuge - , mkBvsge - , mkBvugt - , mkBvsgt - , mkConcat - , mkExtract - , mkSignExt - , mkZeroExt - , mkRepeat - , mkBvshl - , mkBvlshr - , mkBvashr - , mkRotateLeft - , mkRotateRight - , mkExtRotateLeft - , mkExtRotateRight - , mkInt2bv - , mkBv2int - , mkBvnegNoOverflow - , mkBvaddNoOverflow - , mkBvaddNoUnderflow - , mkBvsubNoOverflow - , mkBvsubNoUnderflow - , mkBvmulNoOverflow - , mkBvmulNoUnderflow - , mkBvsdivNoOverflow - - -- * Arrays - , mkSelect - , mkStore - , mkConstArray - , mkMap - , mkArrayDefault - - -- * Numerals - , mkNumeral - , mkInt - , mkReal - - -- * Quantifiers - , mkPattern - , mkBound - , mkForall - , mkExists - , mkForallConst - , mkExistsConst - - -- * Accessors - , getBvSortSize - , getSort - , getBool - , getInt - , getReal - , toApp - - -- * Models - , FuncModel (..) - , eval - , evalT - , evalFunc - , evalArray - , getFuncInterp - , isAsArray - , getAsArrayFuncDecl - , funcInterpGetNumEntries - , funcInterpGetEntry - , funcInterpGetElse - , funcInterpGetArity - , funcEntryGetValue - , funcEntryGetNumArgs - , funcEntryGetArg - , modelToString - , showModel - - -- * Constraints - , assertCnstr - , check - , checkAndGetModel - , getModel - , delModel - , push - , pop - - -- * Parameters - , mkParams - , paramsSetBool - , paramsSetUInt - , paramsSetDouble - , paramsSetSymbol - , paramsToString - - -- * Solvers - -- /EXPERIMENTAL/ support for solvers, - -- very fragile and likely to cause crashes!!! - -- - -- Yet, there are people using it, so you may want to give it a try. - , Logic(..) - , mkSolver - , mkSimpleSolver - , mkSolverForLogic - , solverSetParams - , solverPush - , solverPop - , solverReset - , solverGetNumScopes - , solverAssertCnstr - , solverAssertAndTrack - , solverCheck - , solverGetModel - , solverCheckAndGetModel - , solverGetReasonUnknown - , solverToString - - -- * String Conversion - , ASTPrintMode(..) - , setASTPrintMode - , astToString - , patternToString - , sortToString - , funcDeclToString - , benchmarkToSMTLibString - - -- * Miscellaneous - , Version(..) - , getVersion - - -- * Error Handling - , Z3Error(..) - , Z3ErrorCode(..) - ) where - -import Z3.Base.C - -import Control.Applicative ( (<$>), (<*) ) -import Control.Exception ( Exception, bracket, throw ) -import Control.Monad ( when ) -import Data.Int -import Data.Ratio ( Ratio, numerator, denominator, (%) ) -import Data.Traversable ( Traversable ) -import qualified Data.Traversable as T -import Data.Typeable ( Typeable ) -import Data.Word -import Foreign hiding ( toBool, newForeignPtr ) -import Foreign.C - ( CDouble, CInt, CUInt, CLLong, CULLong, CString - , peekCString - , withCString ) -import Foreign.Concurrent - ---------------------------------------------------------------------- --- Types - --- | A Z3 /configuration object/. -newtype Config = Config { unConfig :: Ptr Z3_config } - deriving Eq - --- | A Z3 /logical context/. -newtype Context = Context { unContext :: Ptr Z3_context } - deriving Eq - --- | A Z3 /symbol/. --- --- Used to name types, constants and functions. -newtype Symbol = Symbol { unSymbol :: Ptr Z3_symbol } - deriving (Eq, Ord, Show, Storable) - --- | A Z3 /AST node/. --- --- This is the data-structure used in Z3 to represent terms, formulas and types. -newtype AST = AST { unAST :: Ptr Z3_ast } - deriving (Eq, Ord, Show, Storable, Typeable) - --- | A kind of AST representing /types/. -newtype Sort = Sort { unSort :: Ptr Z3_sort } - deriving (Eq, Ord, Show, Storable) - --- | A kind of AST representing function symbols. -newtype FuncDecl = FuncDecl { unFuncDecl :: Ptr Z3_func_decl } - deriving (Eq, Ord, Show, Storable, Typeable) - --- | A kind of AST representing constant and function declarations. -newtype App = App { unApp :: Ptr Z3_app } - deriving (Eq, Ord, Show, Storable) - --- | A kind of AST representing pattern and multi-patterns to --- guide quantifier instantiation. -newtype Pattern = Pattern { unPattern :: Ptr Z3_pattern } - deriving (Eq, Ord, Show, Storable) - --- | A model for the constraints asserted into the logical context. -newtype Model = Model { unModel :: Ptr Z3_model } - deriving Eq - --- | An interpretation of a function in a model. -newtype FuncInterp = FuncInterp { unFuncInterp :: Ptr Z3_func_interp } - deriving Eq - --- | Representation of the value of a 'Z3_func_interp' at a particular point. -newtype FuncEntry = FuncEntry { unFuncEntry :: Ptr Z3_func_entry } - deriving Eq - --- | A Z3 parameter set. --- --- Starting at Z3 4.0, parameter sets are used to configure many components --- such as: simplifiers, tactics, solvers, etc. -newtype Params = Params { unParams :: Ptr Z3_params } - deriving Eq - --- | A Z3 solver engine. --- --- A(n) (incremental) solver, possibly specialized by a particular tactic --- or logic. -newtype Solver = Solver { _unSolver :: ForeignPtr Z3_solver } - deriving Eq - --- | Result of a satisfiability check. --- --- This corresponds to the /z3_lbool/ type in the C API. -data Result - = Sat - | Unsat - | Undef - deriving (Eq, Ord, Read, Show) - ---------------------------------------------------------------------- --- Configuration - --- | Create a configuration. -mkConfig :: IO Config -mkConfig = Config <$> z3_mk_config - --- | Delete a configuration. -delConfig :: Config -> IO () -delConfig = z3_del_config . unConfig - --- | Run a computation using a temporally created configuration. --- --- Note that the configuration object can be thrown away once --- it has been used to create the Z3 'Context'. -withConfig :: (Config -> IO a) -> IO a -withConfig = bracket mkConfig delConfig - --- | Set a configuration parameter. -setParamValue :: Config -> String -> String -> IO () -setParamValue cfg s1 s2 = - withCString s1 $ \cs1 -> - withCString s2 $ \cs2 -> - z3_set_param_value (unConfig cfg) cs1 cs2 - ---------------------------------------------------------------------- --- Context - --- | Create a context using the given configuration. -mkContext :: Config -> IO Context -mkContext cfg = do - ctxPtr <- z3_mk_context (unConfig cfg) - z3_set_error_handler ctxPtr nullFunPtr - return $ Context ctxPtr - --- | Delete the given logical context. -delContext :: Context -> IO () -delContext = z3_del_context . unContext - --- | Run a computation using a temporally created context. -withContext :: Config -> (Context -> IO a) -> IO a -withContext cfg = bracket (mkContext cfg) delContext - --- | Convert the given logical context into a string. -contextToString :: Context -> IO String -contextToString = liftFun0 z3_context_to_string - --- | Alias for 'contextToString'. -showContext :: Context -> IO String -showContext = contextToString -{-# DEPRECATED showContext "Use contextToString instead." #-} - ---------------------------------------------------------------------- --- Symbols - --- | Create a Z3 symbol using an integer. --- --- @mkIntSymbol c i@ /requires/ @0 <= i < 2^30@ -mkIntSymbol :: Integral int => Context -> int -> IO Symbol -mkIntSymbol c i - | 0 <= i && i <= 2^(30::Int)-1 - = marshal z3_mk_int_symbol c $ h2c i - | otherwise - = error "Z3.Base.mkIntSymbol: invalid range" - -{-# SPECIALIZE mkIntSymbol :: Context -> Int -> IO Symbol #-} -{-# SPECIALIZE mkIntSymbol :: Context -> Integer -> IO Symbol #-} - --- | Create a Z3 symbol using a string. -mkStringSymbol :: Context -> String -> IO Symbol -mkStringSymbol = liftFun1 z3_mk_string_symbol - ---------------------------------------------------------------------- --- Sorts - --- | Create a free (uninterpreted) type using the given name (symbol). --- --- Two free types are considered the same iff the have the same name. -mkUninterpretedSort :: Context -> Symbol -> IO Sort -mkUninterpretedSort = liftFun1 z3_mk_uninterpreted_sort - --- | Create the /boolean/ type. --- --- This type is used to create propositional variables and predicates. -mkBoolSort :: Context -> IO Sort -mkBoolSort = liftFun0 z3_mk_bool_sort - --- | Create an /integer/ type. --- --- This is the type of arbitrary precision integers. --- A machine integer can be represented using bit-vectors, see 'mkBvSort'. -mkIntSort :: Context -> IO Sort -mkIntSort = liftFun0 z3_mk_int_sort - --- | Create a /real/ type. --- --- This type is not a floating point number. --- Z3 does not have support for floating point numbers yet. -mkRealSort :: Context -> IO Sort -mkRealSort = liftFun0 z3_mk_real_sort - --- | Create a bit-vector type of the given size. --- --- This type can also be seen as a machine integer. --- --- @mkBvSort c sz@ /requires/ @sz >= 0@ -mkBvSort :: Context -> Int -> IO Sort -mkBvSort = liftFun1 z3_mk_bv_sort - --- TODO: Z3_mk_finite_domain_sort - --- | Create an array type --- --- We usually represent the array type as: [domain -> range]. --- Arrays are usually used to model the heap/memory in software verification. -mkArraySort :: Context -> Sort -> Sort -> IO Sort -mkArraySort = liftFun2 z3_mk_array_sort - --- | Create a tuple type --- --- A tuple with n fields has a constructor and n projections. --- This function will also declare the constructor and projection functions. -mkTupleSort :: Context -- ^ Context - -> Symbol -- ^ Name of the sort - -> [(Symbol, Sort)] -- ^ Name and sort of each field - -> IO (Sort, FuncDecl, [FuncDecl]) -- ^ Resulting sort, and function - -- declarations for the - -- constructor and projections. -mkTupleSort c sym symSorts = checkError c $ - h2c sym $ \symPtr -> - marshalArrayLen syms $ \ n symsPtr -> - marshalArray sorts $ \ sortsPtr -> - alloca $ \ outConstrPtr -> - allocaArray n $ \ outProjsPtr -> do - sort <- z3_mk_tuple_sort (unContext c) symPtr - (fromIntegral n) symsPtr sortsPtr - outConstrPtr outProjsPtr - outConstr <- peek outConstrPtr - outProjs <- peekArray n outProjsPtr - return (Sort sort, FuncDecl outConstr, map FuncDecl outProjs) - where (syms, sorts) = unzip symSorts - --- TODO Sorts: from Z3_mk_enumeration_sort on - ---------------------------------------------------------------------- --- Constants and Applications - --- | Declare a constant or function. -mkFuncDecl :: Context -- ^ Logical context. - -> Symbol -- ^ Name of the function (or constant). - -> [Sort] -- ^ Function domain (empty for constants). - -> Sort -- ^ Return sort of the function. - -> IO FuncDecl -mkFuncDecl ctx smb dom rng = - marshal z3_mk_func_decl ctx $ \f -> - h2c smb $ \ptrSym -> - marshalArrayLen dom $ \domNum domArr -> - h2c rng $ \ptrRange -> - f ptrSym domNum domArr ptrRange - --- | Create a constant or function application. -mkApp :: Context -> FuncDecl -> [AST] -> IO AST -mkApp ctx fd args = marshal z3_mk_app ctx $ \f -> - h2c fd $ \fdPtr -> - marshalArrayLen args $ \argsNum argsArr -> - f fdPtr argsNum argsArr - --- | Declare and create a constant. --- --- This is a shorthand for: --- @do xd <- mkFunDecl c x [] s; mkApp c xd []@ -mkConst :: Context -> Symbol -> Sort -> IO AST -mkConst = liftFun2 z3_mk_const - --- TODO Constants and Applications: Z3_mk_fresh_func_decl --- TODO Constants and Applications: Z3_mk_fresh_const - --- | Create an AST node representing /true/. -mkTrue :: Context -> IO AST -mkTrue = liftFun0 z3_mk_true - --- | Create an AST node representing /false/. -mkFalse :: Context -> IO AST -mkFalse = liftFun0 z3_mk_false - --- | Create an AST node representing /l = r/. -mkEq :: Context -> AST -> AST -> IO AST -mkEq = liftFun2 z3_mk_eq - --- | The distinct construct is used for declaring the arguments pairwise --- distinct. --- --- That is, @and [ args!!i /= args!!j | i <- [0..length(args)-1], j <- [i+1..length(args)-1] ]@ -mkDistinct :: Context -> [AST] -> IO AST -mkDistinct = - liftAstN "Z3.Base.mkDistinct: empty list of expressions" z3_mk_distinct - --- | Create an AST node representing /not(a)/. -mkNot :: Context -> AST -> IO AST -mkNot = liftFun1 z3_mk_not - --- | Create an AST node representing an if-then-else: /ite(t1, t2, t3)/. -mkIte :: Context -> AST -> AST -> AST -> IO AST -mkIte = liftFun3 z3_mk_ite - --- | Create an AST node representing /t1 iff t2/. -mkIff :: Context -> AST -> AST -> IO AST -mkIff = liftFun2 z3_mk_iff - --- | Create an AST node representing /t1 implies t2/. -mkImplies :: Context -> AST -> AST -> IO AST -mkImplies = liftFun2 z3_mk_implies - --- | Create an AST node representing /t1 xor t2/. -mkXor :: Context -> AST -> AST -> IO AST -mkXor = liftFun2 z3_mk_xor - --- | Create an AST node representing args[0] and ... and args[num_args-1]. -mkAnd :: Context -> [AST] -> IO AST -mkAnd = liftAstN "Z3.Base.mkAnd: empty list of expressions" z3_mk_and - --- | Create an AST node representing args[0] or ... or args[num_args-1]. -mkOr :: Context -> [AST] -> IO AST -mkOr = liftAstN "Z3.Base.mkOr: empty list of expressions" z3_mk_or - --- | Create an AST node representing args[0] + ... + args[num_args-1]. -mkAdd :: Context -> [AST] -> IO AST -mkAdd = liftAstN "Z3.Base.mkAdd: empty list of expressions" z3_mk_add - --- | Create an AST node representing args[0] * ... * args[num_args-1]. -mkMul :: Context -> [AST] -> IO AST -mkMul = liftAstN "Z3.Base.mkMul: empty list of expressions" z3_mk_mul - --- | Create an AST node representing args[0] - ... - args[num_args - 1]. -mkSub :: Context -> [AST] -> IO AST -mkSub = liftAstN "Z3.Base.mkSub: empty list of expressions" z3_mk_sub - --- | Create an AST node representing -arg. -mkUnaryMinus :: Context -> AST -> IO AST -mkUnaryMinus = liftFun1 z3_mk_unary_minus - --- | Create an AST node representing arg1 div arg2. -mkDiv :: Context -> AST -> AST -> IO AST -mkDiv = liftFun2 z3_mk_div - --- | Create an AST node representing arg1 mod arg2. -mkMod :: Context -> AST -> AST -> IO AST -mkMod = liftFun2 z3_mk_mod - --- | Create an AST node representing arg1 rem arg2. -mkRem :: Context -> AST -> AST -> IO AST -mkRem = liftFun2 z3_mk_rem - --- | Create less than. -mkLt :: Context -> AST -> AST -> IO AST -mkLt = liftFun2 z3_mk_lt - --- | Create less than or equal to. -mkLe :: Context -> AST -> AST -> IO AST -mkLe = liftFun2 z3_mk_le - --- | Create greater than. -mkGt :: Context -> AST -> AST -> IO AST -mkGt = liftFun2 z3_mk_gt - --- | Create greater than or equal to. -mkGe :: Context -> AST -> AST -> IO AST -mkGe = liftFun2 z3_mk_ge - --- | Coerce an integer to a real. -mkInt2Real :: Context -> AST -> IO AST -mkInt2Real = liftFun1 z3_mk_int2real - --- | Coerce a real to an integer. -mkReal2Int :: Context -> AST -> IO AST -mkReal2Int = liftFun1 z3_mk_real2int - --- | Check if a real number is an integer. -mkIsInt :: Context -> AST -> IO AST -mkIsInt = liftFun1 z3_mk_is_int - ---------------------------------------------------------------------- --- Bit-vectors - --- | Bitwise negation. -mkBvnot :: Context -> AST -> IO AST -mkBvnot = liftFun1 z3_mk_bvnot - --- | Take conjunction of bits in vector, return vector of length 1. -mkBvredand :: Context -> AST -> IO AST -mkBvredand = liftFun1 z3_mk_bvredand - --- | Take disjunction of bits in vector, return vector of length 1. -mkBvredor :: Context -> AST -> IO AST -mkBvredor = liftFun1 z3_mk_bvredor - --- | Bitwise and. -mkBvand :: Context -> AST -> AST -> IO AST -mkBvand = liftFun2 z3_mk_bvand - --- | Bitwise or. -mkBvor :: Context -> AST -> AST -> IO AST -mkBvor = liftFun2 z3_mk_bvor - --- | Bitwise exclusive-or. -mkBvxor :: Context -> AST -> AST -> IO AST -mkBvxor = liftFun2 z3_mk_bvxor - --- | Bitwise nand. -mkBvnand :: Context -> AST -> AST -> IO AST -mkBvnand = liftFun2 z3_mk_bvnand - --- | Bitwise nor. -mkBvnor :: Context -> AST -> AST -> IO AST -mkBvnor = liftFun2 z3_mk_bvnor - --- | Bitwise xnor. -mkBvxnor :: Context -> AST -> AST -> IO AST -mkBvxnor = liftFun2 z3_mk_bvxnor - --- | Standard two's complement unary minus. -mkBvneg :: Context -> AST -> IO AST -mkBvneg = liftFun1 z3_mk_bvneg - --- | Standard two's complement addition. -mkBvadd :: Context -> AST -> AST -> IO AST -mkBvadd = liftFun2 z3_mk_bvadd - --- | Standard two's complement subtraction. -mkBvsub :: Context -> AST -> AST -> IO AST -mkBvsub = liftFun2 z3_mk_bvsub - --- | Standard two's complement multiplication. -mkBvmul :: Context -> AST -> AST -> IO AST -mkBvmul = liftFun2 z3_mk_bvmul - --- | Unsigned division. -mkBvudiv :: Context -> AST -> AST -> IO AST -mkBvudiv = liftFun2 z3_mk_bvudiv - --- | Two's complement signed division. -mkBvsdiv :: Context -> AST -> AST -> IO AST -mkBvsdiv = liftFun2 z3_mk_bvsdiv - --- | Unsigned remainder. -mkBvurem :: Context -> AST -> AST -> IO AST -mkBvurem = liftFun2 z3_mk_bvurem - --- | Two's complement signed remainder (sign follows dividend). -mkBvsrem :: Context -> AST -> AST -> IO AST -mkBvsrem = liftFun2 z3_mk_bvsrem - --- | Two's complement signed remainder (sign follows divisor). -mkBvsmod :: Context -> AST -> AST -> IO AST -mkBvsmod = liftFun2 z3_mk_bvsmod - --- | Unsigned less than. -mkBvult :: Context -> AST -> AST -> IO AST -mkBvult = liftFun2 z3_mk_bvult - --- | Two's complement signed less than. -mkBvslt :: Context -> AST -> AST -> IO AST -mkBvslt = liftFun2 z3_mk_bvslt - --- | Unsigned less than or equal to. -mkBvule :: Context -> AST -> AST -> IO AST -mkBvule = liftFun2 z3_mk_bvule - --- | Two's complement signed less than or equal to. -mkBvsle :: Context -> AST -> AST -> IO AST -mkBvsle = liftFun2 z3_mk_bvsle - --- | Unsigned greater than or equal to. -mkBvuge :: Context -> AST -> AST -> IO AST -mkBvuge = liftFun2 z3_mk_bvuge - --- | Two's complement signed greater than or equal to. -mkBvsge :: Context -> AST -> AST -> IO AST -mkBvsge = liftFun2 z3_mk_bvsge - --- | Unsigned greater than. -mkBvugt :: Context -> AST -> AST -> IO AST -mkBvugt = liftFun2 z3_mk_bvugt - --- | Two's complement signed greater than. -mkBvsgt :: Context -> AST -> AST -> IO AST -mkBvsgt = liftFun2 z3_mk_bvsgt - --- | Concatenate the given bit-vectors. -mkConcat :: Context -> AST -> AST -> IO AST -mkConcat = liftFun2 z3_mk_concat - --- | Extract the bits high down to low from a bitvector of size m to yield a new --- bitvector of size /n/, where /n = high - low + 1/. -mkExtract :: Context -> Int -> Int -> AST -> IO AST -mkExtract = liftFun3 z3_mk_extract - --- | Sign-extend of the given bit-vector to the (signed) equivalent bitvector --- of size /m+i/, where /m/ is the size of the given bit-vector. -mkSignExt :: Context -> Int -> AST -> IO AST -mkSignExt = liftFun2 z3_mk_sign_ext - --- | Extend the given bit-vector with zeros to the (unsigned) equivalent --- bitvector of size /m+i/, where /m/ is the size of the given bit-vector. -mkZeroExt :: Context -> Int -> AST -> IO AST -mkZeroExt = liftFun2 z3_mk_zero_ext - --- | Repeat the given bit-vector up length /i/. -mkRepeat :: Context -> Int -> AST -> IO AST -mkRepeat = liftFun2 z3_mk_repeat - --- | Shift left. -mkBvshl :: Context -> AST -> AST -> IO AST -mkBvshl = liftFun2 z3_mk_bvshl - --- | Logical shift right. -mkBvlshr :: Context -> AST -> AST -> IO AST -mkBvlshr = liftFun2 z3_mk_bvlshr - --- | Arithmetic shift right. -mkBvashr :: Context -> AST -> AST -> IO AST -mkBvashr = liftFun2 z3_mk_bvashr - --- | Rotate bits of /t1/ to the left /i/ times. -mkRotateLeft :: Context -> Int -> AST -> IO AST -mkRotateLeft = liftFun2 z3_mk_rotate_left - --- | Rotate bits of /t1/ to the right /i/ times. -mkRotateRight :: Context -> Int -> AST -> IO AST -mkRotateRight = liftFun2 z3_mk_rotate_right - --- | Rotate bits of /t1/ to the left /t2/ times. -mkExtRotateLeft :: Context -> AST -> AST -> IO AST -mkExtRotateLeft = liftFun2 z3_mk_ext_rotate_left - --- | Rotate bits of /t1/ to the right /t2/ times. -mkExtRotateRight :: Context -> AST -> AST -> IO AST -mkExtRotateRight = liftFun2 z3_mk_ext_rotate_right - --- | Create an /n/ bit bit-vector from the integer argument /t1/. -mkInt2bv :: Context -> Int -> AST -> IO AST -mkInt2bv = liftFun2 z3_mk_int2bv - --- | Create an integer from the bit-vector argument /t1/. --- --- If /is_signed/ is false, then the bit-vector /t1/ is treated as unsigned. --- So the result is non-negative and in the range [0..2^/N/-1], --- where /N/ are the number of bits in /t1/. --- If /is_signed/ is true, /t1/ is treated as a signed bit-vector. -mkBv2int :: Context -> AST -> Bool -> IO AST -mkBv2int = liftFun2 z3_mk_bv2int - --- | Create a predicate that checks that the bit-wise addition of /t1/ and /t2/ --- does not overflow. -mkBvaddNoOverflow :: Context -> AST -> AST -> Bool -> IO AST -mkBvaddNoOverflow = liftFun3 z3_mk_bvadd_no_overflow - --- | Create a predicate that checks that the bit-wise signed addition of /t1/ --- and /t2/ does not underflow. -mkBvaddNoUnderflow :: Context -> AST -> AST -> IO AST -mkBvaddNoUnderflow = liftFun2 z3_mk_bvadd_no_underflow - --- | Create a predicate that checks that the bit-wise signed subtraction of /t1/ --- and /t2/ does not overflow. -mkBvsubNoOverflow :: Context -> AST -> AST -> IO AST -mkBvsubNoOverflow = liftFun2 z3_mk_bvsub_no_overflow - --- | Create a predicate that checks that the bit-wise subtraction of /t1/ and --- /t2/ does not underflow. -mkBvsubNoUnderflow :: Context -> AST -> AST -> IO AST -mkBvsubNoUnderflow = liftFun2 z3_mk_bvsub_no_underflow - --- | Create a predicate that checks that the bit-wise signed division of /t1/ --- and /t2/ does not overflow. -mkBvsdivNoOverflow :: Context -> AST -> AST -> IO AST -mkBvsdivNoOverflow = liftFun2 z3_mk_bvsdiv_no_overflow - --- | Check that bit-wise negation does not overflow when /t1/ is interpreted as --- a signed bit-vector. -mkBvnegNoOverflow :: Context -> AST -> IO AST -mkBvnegNoOverflow = liftFun1 z3_mk_bvneg_no_overflow - --- | Create a predicate that checks that the bit-wise multiplication of /t1/ and --- /t2/ does not overflow. -mkBvmulNoOverflow :: Context -> AST -> AST -> Bool -> IO AST -mkBvmulNoOverflow = liftFun3 z3_mk_bvmul_no_overflow - --- | Create a predicate that checks that the bit-wise signed multiplication of --- /t1/ and /t2/ does not underflow. -mkBvmulNoUnderflow :: Context -> AST -> AST -> IO AST -mkBvmulNoUnderflow = liftFun2 z3_mk_bvmul_no_underflow - ---------------------------------------------------------------------- --- Arrays - --- | Array read. The argument a is the array and i is the index of the array --- that gets read. -mkSelect :: Context - -> AST -- ^ Array. - -> AST -- ^ Index of the array to read. - -> IO AST -mkSelect = liftFun2 z3_mk_select - --- | Array update. --- --- The result of this function is an array that is equal to the input array --- (with respect to select) on all indices except for i, where it maps to v. --- --- The semantics of this function is given by the theory of arrays described --- in the SMT-LIB standard. See for more details. -mkStore :: Context - -> AST -- ^ Array. - -> AST -- ^ Index /i/ of the array. - -> AST -- ^ New value for /i/. - -> IO AST -mkStore = liftFun3 z3_mk_store - --- | Create the constant array. --- --- The resulting term is an array, such that a select on an arbitrary index --- produces the value /v/. -mkConstArray :: Context - -> Sort -- ^ Domain sort of the array. - -> AST -- ^ Value /v/ that the array maps to. - -> IO AST -mkConstArray = liftFun2 z3_mk_const_array - --- | Map a function /f/ on the the argument arrays. --- --- The /n/ nodes args must be of array sorts [domain -> range_i]. --- The function declaration /f/ must have type range_1 .. range_n -> range. --- The sort of the result is [domain -> range]. -mkMap :: Context - -> FuncDecl -- ^ Function /f/. - -> [AST] -- ^ List of arrays. - -> IO AST -mkMap ctx fun args = marshal z3_mk_map ctx $ \f -> - h2c fun $ \funPtr -> - marshalArrayLen args $ \argsNum argsArr -> - f funPtr argsNum argsArr - --- | Access the array default value. --- --- Produces the default range value, for arrays that can be represented as --- finite maps with a default range value. -mkArrayDefault :: Context - -> AST -- ^ Array. - -> IO AST -mkArrayDefault = liftFun1 z3_mk_array_default - --- TODO: Sets - ---------------------------------------------------------------------- --- Numerals - --- | Create a numeral of a given sort. -mkNumeral :: Context -> String -> Sort -> IO AST -mkNumeral = liftFun2 z3_mk_numeral - -------------------------------------------------- --- Numerals / Integers - --- | Create a numeral of sort /int/. -mkInt :: Integral a => Context -> a -> IO AST -mkInt c n = mkIntSort c >>= mkNumeral c n_str - where n_str = show $ toInteger n - -{-# INLINE mkIntZ3 #-} -mkIntZ3 :: Context -> Int32 -> Sort -> IO AST -mkIntZ3 c n s = marshal z3_mk_int c $ h2c s . withIntegral n - -{-# INLINE mkUnsignedIntZ3 #-} -mkUnsignedIntZ3 :: Context -> Word32 -> Sort -> IO AST -mkUnsignedIntZ3 c n s = marshal z3_mk_unsigned_int c $ - h2c s . withIntegral n - -{-# INLINE mkInt64Z3 #-} -mkInt64Z3 :: Context -> Int64 -> Sort -> IO AST -mkInt64Z3 = liftFun2 z3_mk_int64 - -{-# INLINE mkUnsignedInt64Z3 #-} -mkUnsignedInt64Z3 :: Context -> Word64 -> Sort -> IO AST -mkUnsignedInt64Z3 = liftFun2 z3_mk_unsigned_int64 - -{-# RULES "mkInt/mkInt_IntZ3" mkInt = mkInt_IntZ3 #-} -mkInt_IntZ3 :: Context -> Int32 -> IO AST -mkInt_IntZ3 c n = mkIntSort c >>= mkIntZ3 c n - -{-# RULES "mkInt/mkInt_UnsignedIntZ3" mkInt = mkInt_UnsignedIntZ3 #-} -mkInt_UnsignedIntZ3 :: Context -> Word32 -> IO AST -mkInt_UnsignedIntZ3 c n = mkIntSort c >>= mkUnsignedIntZ3 c n - -{-# RULES "mkInt/mkInt_Int64Z3" mkInt = mkInt_Int64Z3 #-} -mkInt_Int64Z3 :: Context -> Int64 -> IO AST -mkInt_Int64Z3 c n = mkIntSort c >>= mkInt64Z3 c n - -{-# RULES "mkInt/mkInt_UnsignedInt64Z3" mkInt = mkInt_UnsignedInt64Z3 #-} -mkInt_UnsignedInt64Z3 :: Context -> Word64 -> IO AST -mkInt_UnsignedInt64Z3 c n = mkIntSort c >>= mkUnsignedInt64Z3 c n - -------------------------------------------------- --- Numerals / Reals - --- | Create a numeral of sort /real/. -mkReal :: Real r => Context -> r -> IO AST -mkReal c n = mkRealSort c >>= mkNumeral c n_str - where r = toRational n - r_n = toInteger $ numerator r - r_d = toInteger $ denominator r - n_str = show r_n ++ " / " ++ show r_d - -{-# RULES "mkReal/mkRealZ3" mkReal = mkRealZ3 #-} -mkRealZ3 :: Context -> Ratio Int32 -> IO AST -mkRealZ3 c r = checkError c $ c2h c =<< z3_mk_real (unContext c) n d - where n = (fromIntegral $ numerator r) :: CInt - d = (fromIntegral $ denominator r) :: CInt - -{-# RULES "mkReal/mkReal_IntZ3" mkReal = mkReal_IntZ3 #-} -mkReal_IntZ3 :: Context -> Int32 -> IO AST -mkReal_IntZ3 c n = mkRealSort c >>= mkIntZ3 c n - -{-# RULES "mkReal/mkReal_UnsignedIntZ3" mkReal = mkReal_UnsignedIntZ3 #-} -mkReal_UnsignedIntZ3 :: Context -> Word32 -> IO AST -mkReal_UnsignedIntZ3 c n = mkRealSort c >>= mkUnsignedIntZ3 c n - -{-# RULES "mkReal/mkReal_Int64Z3" mkReal = mkReal_Int64Z3 #-} -mkReal_Int64Z3 :: Context -> Int64 -> IO AST -mkReal_Int64Z3 c n = mkRealSort c >>= mkInt64Z3 c n - -{-# RULES "mkReal/mkReal_UnsignedInt64Z3" mkReal = mkReal_UnsignedInt64Z3 #-} -mkReal_UnsignedInt64Z3 :: Context -> Word64 -> IO AST -mkReal_UnsignedInt64Z3 c n = mkRealSort c >>= mkUnsignedInt64Z3 c n - ---------------------------------------------------------------------- --- Quantifiers - --- | Create a pattern for quantifier instantiation. --- --- Z3 uses pattern matching to instantiate quantifiers. --- If a pattern is not provided for a quantifier, then Z3 will automatically --- compute a set of patterns for it. However, for optimal performance, --- the user should provide the patterns. --- --- Patterns comprise a list of terms. --- The list should be non-empty. --- If the list comprises of more than one term, it is a called a multi-pattern. --- --- In general, one can pass in a list of (multi-)patterns in the quantifier --- constructor. -mkPattern :: Context - -> [AST] -- ^ Terms. - -> IO Pattern -mkPattern _ [] = error "Z3.Base.mkPattern: empty list of expressions" -mkPattern c es = marshal z3_mk_pattern c $ marshalArrayLen es - --- | Create a bound variable. --- --- Bound variables are indexed by de-Bruijn indices. --- --- See -mkBound :: Context - -> Int -- ^ de-Bruijn index. - -> Sort - -> IO AST -mkBound c i s - | i >= 0 = liftFun2 z3_mk_bound c i s - | otherwise = error "Z3.Base.mkBound: negative de-Bruijn index" - -type MkZ3Quantifier = Ptr Z3_context -> CUInt - -> CUInt -> Ptr (Ptr Z3_pattern) - -> CUInt -> Ptr (Ptr Z3_sort) -> Ptr (Ptr Z3_symbol) - -> Ptr Z3_ast - -> IO (Ptr Z3_ast) - --- TODO: Allow the user to specify the quantifier weight! -marshalMkQ :: MkZ3Quantifier - -> Context - -> [Pattern] - -> [Symbol] - -> [Sort] - -> AST - -> IO AST -marshalMkQ z3_mk_Q ctx pats x s body = marshal z3_mk_Q ctx $ \f -> - marshalArrayLen pats $ \n patsArr -> - marshalArray x $ \xArr -> - marshalArray s $ \sArr -> - h2c body $ \bodyPtr -> - f 0 n patsArr len sArr xArr bodyPtr - where len - | l == 0 = error "Z3.Base.mkQuantifier:\ - \ quantifier with 0 bound variables" - | l /= length x = error "Z3.Base.mkQuantifier:\ - \ different number of symbols and sorts" - | otherwise = fromIntegral l - where l = length s - --- | Create a forall formula. --- --- The bound variables are de-Bruijn indices created using 'mkBound'. --- --- Z3 applies the convention that the last element in /xs/ refers to the --- variable with index 0, the second to last element of /xs/ refers to the --- variable with index 1, etc. -mkForall :: Context - -> [Pattern] -- ^ Instantiation patterns (see 'mkPattern'). - -> [Symbol] -- ^ Bound (quantified) variables /xs/. - -> [Sort] -- ^ Sorts of the bound variables. - -> AST -- ^ Body of the quantifier. - -> IO AST -mkForall = marshalMkQ z3_mk_forall - --- | Create an exists formula. --- --- Similar to 'mkForall'. -mkExists :: Context -> [Pattern] -> [Symbol] -> [Sort] -> AST -> IO AST -mkExists = marshalMkQ z3_mk_exists - -type MkZ3QuantifierConst = Ptr Z3_context - -> CUInt - -> CUInt - -> Ptr (Ptr Z3_app) - -> CUInt - -> Ptr (Ptr Z3_pattern) - -> Ptr Z3_ast - -> IO (Ptr Z3_ast) - -marshalMkQConst :: MkZ3QuantifierConst - -> Context - -> [Pattern] - -> [App] - -> AST - -> IO AST -marshalMkQConst z3_mk_Q_const ctx pats apps body = - marshal z3_mk_Q_const ctx $ \f -> - marshalArrayLen pats $ \patsNum patsArr -> - marshalArray apps $ \appsArr -> - h2c body $ \bodyPtr -> - f 0 len appsArr patsNum patsArr bodyPtr - where len - | l == 0 = error "Z3.Base.mkQuantifierConst:\ - \ quantifier with 0 bound variables" - | otherwise = fromIntegral l - where l = length apps --- TODO: Allow the user to specify the quantifier weight! - --- | Create a universal quantifier using a list of constants that will form the --- set of bound variables. -mkForallConst :: Context - -> [Pattern] -- ^ Instantiation patterns (see 'mkPattern'). - -> [App] -- ^ Constants to be abstracted into bound variables. - -> AST -- ^ Quantifier body. - -> IO AST -mkForallConst = marshalMkQConst z3_mk_forall_const - --- | Create a existential quantifier using a list of constants that will form --- the set of bound variables. -mkExistsConst :: Context - -> [Pattern] -- ^ Instantiation patterns (see 'mkPattern'). - -> [App] -- ^ Constants to be abstracted into bound variables. - -> AST -- ^ Quantifier body. - -> IO AST -mkExistsConst = marshalMkQConst z3_mk_exists_const - ---------------------------------------------------------------------- --- Accessors - --- | Return the size of the given bit-vector sort. -getBvSortSize :: Context -> Sort -> IO Int -getBvSortSize = liftFun1 z3_get_bv_sort_size - --- | Return the sort of an AST node. -getSort :: Context -> AST -> IO Sort -getSort = liftFun1 z3_get_sort - --- | Cast a 'Z3_lbool' from Z3.Base.C to @Bool@. -castLBool :: Z3_lbool -> Maybe Bool -castLBool lb - | lb == z3_l_true = Just True - | lb == z3_l_false = Just False - | lb == z3_l_undef = Nothing - | otherwise = error "Z3.Base.castLBool: illegal `Z3_lbool' value" - --- | Return Z3_L_TRUE if a is true, Z3_L_FALSE if it is false, and Z3_L_UNDEF --- otherwise. -getBool :: Context -> AST -> IO (Maybe Bool) -getBool c a = checkError c $ - castLBool <$> z3_get_bool_value (unContext c) (unAST a) - --- | Return numeral value, as a string of a numeric constant term. -getNumeralString :: Context -> AST -> IO String -getNumeralString = liftFun1 z3_get_numeral_string - --- | Return 'Z3Int' value -getInt :: Context -> AST -> IO Integer -getInt c a = read <$> getNumeralString c a - --- | Return 'Z3Real' value -getReal :: Context -> AST -> IO Rational -getReal c a = parse <$> getNumeralString c a - where parse :: String -> Rational - parse s - | [(i, sj)] <- reads s = i % parseDen (dropWhile (== ' ') sj) - | otherwise = error "Z3.Base.getReal: no parse" - - parseDen :: String -> Integer - parseDen "" = 1 - parseDen ('/':sj) = read sj - parseDen _ = error "Z3.Base.getReal: no parse" - - --- | Convert an ast into an APP_AST. This is just type casting. -toApp :: Context -> AST -> IO App -toApp = liftFun1 z3_to_app - --- TODO Modifiers - ---------------------------------------------------------------------- --- Models - --- | Evaluate an AST node in the given model. --- --- The evaluation may fail for the following reasons: --- --- * /t/ contains a quantifier. --- * the model m is partial. --- * /t/ is type incorrect. -eval :: Context - -> Model -- ^ Model /m/. - -> AST -- ^ Expression to evaluate /t/. - -> IO (Maybe AST) -eval ctx m a = - alloca $ \aptr2 -> - checkError ctx $ z3_eval ctxPtr (unModel m) (unAST a) aptr2 >>= peekAST aptr2 . toBool - where peekAST :: Ptr (Ptr Z3_ast) -> Bool -> IO (Maybe AST) - peekAST _p False = return Nothing - peekAST p True = Just . AST <$> peek p - - ctxPtr = unContext ctx - --- | Evaluate a /collection/ of AST nodes in the given model. -evalT :: Traversable t => Context -> Model -> t AST -> IO (Maybe (t AST)) -evalT c m = fmap T.sequence . T.mapM (eval c m) - --- | The interpretation of a function. -data FuncModel = FuncModel - { interpMap :: [([AST], AST)] - -- ^ Mapping from arguments to values. - , interpElse :: AST - -- ^ Default value. - } - --- | Evaluate a function declaration to a list of argument/value pairs. -evalFunc :: Context -> Model -> FuncDecl -> IO (Maybe FuncModel) -evalFunc ctx m fDecl = - do interpMb <- getFuncInterp ctx m fDecl - case interpMb of - Nothing -> return Nothing - Just interp -> - do funcMap <- getMapFromInterp ctx interp - elsePart <- funcInterpGetElse ctx interp - return (Just $ FuncModel funcMap elsePart) - --- | Evaluate an array as a function, if possible. -evalArray :: Context -> Model -> AST -> IO (Maybe FuncModel) -evalArray ctx model array = - do -- The array must first be evaluated normally, to get it into - -- 'as-array' form, which is required to acquire the FuncDecl. - evaldArrayMb <- eval ctx model array - case evaldArrayMb of - Nothing -> return Nothing - Just evaldArray -> - do canConvert <- isAsArray ctx evaldArray - if canConvert - then - do arrayDecl <- getAsArrayFuncDecl ctx evaldArray - evalFunc ctx model arrayDecl - else return Nothing - - --- | Return the function declaration f associated with a (_ as_array f) node. -getAsArrayFuncDecl :: Context -> AST -> IO FuncDecl -getAsArrayFuncDecl = liftFun1 z3_get_as_array_func_decl - --- | The (_ as-array f) AST node is a construct for assigning interpretations --- for arrays in Z3. It is the array such that forall indices i we have that --- (select (_ as-array f) i) is equal to (f i). This procedure returns Z3_TRUE --- if the a is an as-array AST node. -isAsArray :: Context -> AST -> IO Bool -isAsArray = liftFun1 z3_is_as_array - - -getMapFromInterp :: Context -> FuncInterp -> IO [([AST], AST)] -getMapFromInterp ctx interp = - do n <- funcInterpGetNumEntries ctx interp - entries <- mapM (funcInterpGetEntry ctx interp) [0..n-1] - mapM (getEntry ctx) entries - -getEntry :: Context -> FuncEntry -> IO ([AST], AST) -getEntry ctx entry = - do val <- funcEntryGetValue ctx entry - args <- getEntryArgs ctx entry - return (args, val) - -getEntryArgs :: Context -> FuncEntry -> IO [AST] -getEntryArgs ctx entry = - do n <- funcEntryGetNumArgs ctx entry - mapM (funcEntryGetArg ctx entry) [0..n-1] - --- | Return the interpretation of the function f in the model m. --- Return NULL, if the model does not assign an interpretation for f. --- That should be interpreted as: the f does not matter. -getFuncInterp :: Context -> Model -> FuncDecl -> IO (Maybe FuncInterp) -getFuncInterp ctx m fd = marshal z3_model_get_func_interp ctx $ \f -> - h2c m $ \mPtr -> - h2c fd $ \fdPtr -> - f mPtr fdPtr - --- | Return the number of entries in the given function interpretation. -funcInterpGetNumEntries :: Context -> FuncInterp -> IO Int -funcInterpGetNumEntries = liftFun1 z3_func_interp_get_num_entries - --- | Return a _point_ of the given function intepretation. --- It represents the value of f in a particular point. -funcInterpGetEntry :: Context -> FuncInterp -> Int -> IO FuncEntry -funcInterpGetEntry = liftFun2 z3_func_interp_get_entry - --- | Return the 'else' value of the given function interpretation. -funcInterpGetElse :: Context -> FuncInterp -> IO AST -funcInterpGetElse = liftFun1 z3_func_interp_get_else - --- | Return the arity (number of arguments) of the given function --- interpretation. -funcInterpGetArity :: Context -> FuncInterp -> IO Int -funcInterpGetArity = liftFun1 z3_func_interp_get_arity - --- | Return the value of this point. -funcEntryGetValue :: Context -> FuncEntry -> IO AST -funcEntryGetValue = liftFun1 z3_func_entry_get_value - --- | Return the number of arguments in a Z3_func_entry object. -funcEntryGetNumArgs :: Context -> FuncEntry -> IO Int -funcEntryGetNumArgs = liftFun1 z3_func_entry_get_num_args - --- | Return an argument of a Z3_func_entry object. -funcEntryGetArg :: Context -> FuncEntry -> Int -> IO AST -funcEntryGetArg = liftFun2 z3_func_entry_get_arg - --- | Convert the given model into a string. -modelToString :: Context -> Model -> IO String -modelToString = liftFun1 z3_model_to_string - --- | Alias for 'modelToString'. -showModel :: Context -> Model -> IO String -showModel = modelToString -{-# DEPRECATED showModel "Use modelToString instead." #-} - ---------------------------------------------------------------------- --- Constraints - --- | Create a backtracking point. -push :: Context -> IO () -push = liftFun0 z3_push - --- | Backtrack /n/ backtracking points. -pop :: Context -> Int -> IO () -pop = liftFun1 z3_pop - --- TODO Constraints: Z3_get_num_scopes - --- TODO Constraints: Z3_persist_ast - --- | Assert a constraing into the logical context. -assertCnstr :: Context -> AST -> IO () -assertCnstr = liftFun1 z3_assert_cnstr - --- | Check whether the given logical context is consistent or not. -getModel :: Context -> IO (Result, Maybe Model) -getModel c = - alloca $ \mptr -> - checkError c (z3_check_and_get_model (unContext c) mptr) >>= \lb -> - (toResult lb,) <$> peekModel mptr - where peekModel :: Ptr (Ptr Z3_model) -> IO (Maybe Model) - peekModel p | p == nullPtr = return Nothing - | otherwise = mkModel <$> peek p - mkModel :: Ptr Z3_model -> Maybe Model - mkModel = fmap Model . ptrToMaybe -{-# DEPRECATED getModel "Use checkAndGetModel instead." #-} - --- | Check whether the given logical context is consistent or not. --- --- If the logical context is not unsatisfiable and model construction is --- enabled (via 'mkConfig'), then a model is returned. The caller is --- responsible for deleting the model using the function 'delModel'. -checkAndGetModel :: Context -> IO (Result, Maybe Model) -checkAndGetModel = getModel - --- | Delete a model object. -delModel :: Context -> Model -> IO () -delModel = liftFun1 z3_del_model - --- | Check whether the given logical context is consistent or not. -check :: Context -> IO Result -check ctx = checkError ctx $ toResult <$> z3_check (unContext ctx) - --- TODO Constraints: Z3_check_assumptions --- TODO Constraints: Z3_get_implied_equalities - --- TODO From section 'Constraints' on. - ---------------------------------------------------------------------- --- Parameters - -{-# WARNING mkParams - , paramsSetBool - , paramsSetUInt - , paramsSetDouble - , paramsSetSymbol - , paramsToString - "New Z3 API support is still incomplete and fragile: \ - \you may experience segmentation faults!" - #-} - -mkParams :: Context -> IO Params -mkParams = liftFun0 z3_mk_params - -paramsSetBool :: Context -> Params -> Symbol -> Bool -> IO () -paramsSetBool = liftFun3 z3_params_set_bool - -paramsSetUInt :: Context -> Params -> Symbol -> Int -> IO () -paramsSetUInt = liftFun3 z3_params_set_uint - -paramsSetDouble :: Context -> Params -> Symbol -> Double -> IO () -paramsSetDouble = liftFun3 z3_params_set_double - -paramsSetSymbol :: Context -> Params -> Symbol -> Symbol -> IO () -paramsSetSymbol = liftFun3 z3_params_set_symbol - -paramsToString :: Context -> Params -> IO String -paramsToString = liftFun1 z3_params_to_string - ---------------------------------------------------------------------- --- Solvers - -{-# WARNING Logic - , mkSolver - , mkSimpleSolver - , mkSolverForLogic - , solverSetParams - , solverPush - , solverPop - , solverReset - , solverGetNumScopes - , solverAssertCnstr - , solverAssertAndTrack - , solverCheck - , solverCheckAndGetModel - , solverGetReasonUnknown - "New Z3 API support is still incomplete and fragile: \ - \you may experience segmentation faults!" - #-} - --- | Solvers available in Z3. --- --- These are described at --- --- /WARNING/: Support for solvers is fragile, you may experience segmentation --- faults! -data Logic - = AUFLIA - -- ^ Closed formulas over the theory of linear integer arithmetic - -- and arrays extended with free sort and function symbols but - -- restricted to arrays with integer indices and values. - - | AUFLIRA - -- ^ Closed linear formulas with free sort and function symbols over - -- one- and two-dimentional arrays of integer index and real - -- value. - - | AUFNIRA - -- ^ Closed formulas with free function and predicate symbols over a - -- theory of arrays of arrays of integer index and real value. - - | LRA - -- ^ Closed linear formulas in linear real arithmetic. - - | QF_ABV - -- ^ Closed quantifier-free formulas over the theory of bitvectors - -- and bitvector arrays. - - | QF_AUFBV - -- ^ Closed quantifier-free formulas over the theory of bitvectors - -- and bitvector arrays extended with free sort and function - -- symbols. - - | QF_AUFLIA - -- ^ Closed quantifier-free linear formulas over the theory of - -- integer arrays extended with free sort and function symbols. - - | QF_AX - -- ^ Closed quantifier-free formulas over the theory of arrays with - -- extensionality. - - | QF_BV - -- ^ Closed quantifier-free formulas over the theory of fixed-size - -- bitvectors. - - | QF_IDL - -- ^ Difference Logic over the integers. In essence, Boolean - -- combinations of inequations of the form x - y < b where x and y - -- are integer variables and b is an integer constant. - - | QF_LIA - -- ^ Unquantified linear integer arithmetic. In essence, Boolean - -- combinations of inequations between linear polynomials over - -- integer variables. - - | QF_LRA - -- ^ Unquantified linear real arithmetic. In essence, Boolean - -- combinations of inequations between linear polynomials over - -- real variables. - - | QF_NIA - -- ^ Quantifier-free integer arithmetic. - - | QF_NRA - -- ^ Quantifier-free real arithmetic. - - | QF_RDL - -- ^ Difference Logic over the reals. In essence, Boolean - -- combinations of inequations of the form x - y < b where x and y - -- are real variables and b is a rational constant. - - | QF_UF - -- ^ Unquantified formulas built over a signature of uninterpreted - -- (i.e., free) sort and function symbols. - - | QF_UFBV - -- ^ Unquantified formulas over bitvectors with uninterpreted sort - -- function and symbols. - - | QF_UFIDL - -- ^ Difference Logic over the integers (in essence) but with - -- uninterpreted sort and function symbols. - - | QF_UFLIA - -- ^ Unquantified linear integer arithmetic with uninterpreted sort - -- and function symbols. - - | QF_UFLRA - -- ^ Unquantified linear real arithmetic with uninterpreted sort and - -- function symbols. - - | QF_UFNRA - -- ^ Unquantified non-linear real arithmetic with uninterpreted sort - -- and function symbols. - - | UFLRA - -- ^ Linear real arithmetic with uninterpreted sort and function - -- symbols. - - | UFNIA - -- ^ Non-linear integer arithmetic with uninterpreted sort and - -- function symbols. - -instance Show Logic where - show AUFLIA = "AUFLIA" - show AUFLIRA = "AUFLIRA" - show AUFNIRA = "AUFNIRA" - show LRA = "LRA" - show QF_ABV = "QF_ABV" - show QF_AUFBV = "QF_AUFBV" - show QF_AUFLIA = "QF_AUFLIA" - show QF_AX = "QF_AX" - show QF_BV = "QF_BV" - show QF_IDL = "QF_IDL" - show QF_LIA = "QF_LIA" - show QF_LRA = "QF_LRA" - show QF_NIA = "QF_NIA" - show QF_NRA = "QF_NRA" - show QF_RDL = "QF_RDL" - show QF_UF = "QF_UF" - show QF_UFBV = "QF_UFBV" - show QF_UFIDL = "QF_UFIDL" - show QF_UFLIA = "QF_UFLIA" - show QF_UFLRA = "QF_UFLRA" - show QF_UFNRA = "QF_UFNRA" - show UFLRA = "UFLRA" - show UFNIA = "UFNIA" - -mkSolverForeign :: Context -> Ptr Z3_solver -> IO Solver -mkSolverForeign c ptr = - do z3_solver_inc_ref cPtr ptr - Solver <$> newForeignPtr ptr (z3_solver_dec_ref cPtr ptr) - where cPtr = unContext c - -mkSolver :: Context -> IO Solver -mkSolver = liftFun0 z3_mk_solver - -mkSimpleSolver :: Context -> IO Solver -mkSimpleSolver = liftFun0 z3_mk_simple_solver - -mkSolverForLogic :: Context -> Logic -> IO Solver -mkSolverForLogic c logic = - do sym <- mkStringSymbol c (show logic) - checkError c $ - mkSolverForeign c =<< z3_mk_solver_for_logic (unContext c) (unSymbol sym) - -solverSetParams :: Context -> Solver -> Params -> IO () -solverSetParams = liftFun2 z3_solver_set_params - -solverPush :: Context -> Solver -> IO () -solverPush = liftFun1 z3_solver_push - -solverPop :: Context -> Solver -> Int -> IO () -solverPop = liftFun2 z3_solver_pop - -solverReset :: Context -> Solver -> IO () -solverReset = liftFun1 z3_solver_reset - --- | Number of backtracking points. -solverGetNumScopes :: Context -> Solver -> IO Int -solverGetNumScopes = liftFun1 z3_solver_get_num_scopes - -solverAssertCnstr :: Context -> Solver -> AST -> IO () -solverAssertCnstr = liftFun2 z3_solver_assert - -solverAssertAndTrack :: Context -> Solver -> AST -> AST -> IO () -solverAssertAndTrack = liftFun3 z3_solver_assert_and_track - --- | Check whether the assertions in a given solver are consistent or not. -solverCheck :: Context -> Solver -> IO Result -solverCheck ctx solver = marshal z3_solver_check ctx $ withSolverPtr solver - --- Retrieve the model for the last 'Z3_solver_check'. --- --- The error handler is invoked if a model is not available because --- the commands above were not invoked for the given solver, --- or if the result was 'Unsat'. -solverGetModel :: Context -> Solver -> IO Model -solverGetModel ctx solver = marshal z3_solver_get_model ctx $ \f -> - h2c solver $ \solverPtr -> - f solverPtr - -solverCheckAndGetModel :: Context -> Solver -> IO (Result, Maybe Model) -solverCheckAndGetModel ctx solver = - do res <- solverCheck ctx solver - mbModel <- case res of - Unsat -> return Nothing - _ -> Just <$> solverGetModel ctx solver - return (res, mbModel) - -solverGetReasonUnknown :: Context -> Solver -> IO String -solverGetReasonUnknown = liftFun1 z3_solver_get_reason_unknown - --- | Convert the given solver into a string. -solverToString :: Context -> Solver -> IO String -solverToString = liftFun1 z3_solver_to_string - ---------------------------------------------------------------------- --- String Conversion - --- | Pretty-printing mode for converting ASTs to strings. The mode --- can be one of the following: --- --- * Z3_PRINT_SMTLIB_FULL: Print AST nodes in SMTLIB verbose format. --- --- * Z3_PRINT_LOW_LEVEL: Print AST nodes using a low-level format. --- --- * Z3_PRINT_SMTLIB_COMPLIANT: Print AST nodes in SMTLIB 1.x --- compliant format. --- --- * Z3_PRINT_SMTLIB2_COMPLIANT: Print AST nodes in SMTLIB 2.x --- compliant format. -data ASTPrintMode - = Z3_PRINT_SMTLIB_FULL - | Z3_PRINT_LOW_LEVEL - | Z3_PRINT_SMTLIB_COMPLIANT - | Z3_PRINT_SMTLIB2_COMPLIANT - --- | Set the pretty-printing mode for converting ASTs to strings. -setASTPrintMode :: Context -> ASTPrintMode -> IO () -setASTPrintMode ctx Z3_PRINT_SMTLIB_FULL = - checkError ctx $ z3_set_ast_print_mode (unContext ctx) z3_print_smtlib_full -setASTPrintMode ctx Z3_PRINT_LOW_LEVEL = - checkError ctx $ z3_set_ast_print_mode (unContext ctx) z3_print_low_level -setASTPrintMode ctx Z3_PRINT_SMTLIB_COMPLIANT = - checkError ctx $ z3_set_ast_print_mode (unContext ctx) z3_print_smtlib_compliant -setASTPrintMode ctx Z3_PRINT_SMTLIB2_COMPLIANT = - checkError ctx $ z3_set_ast_print_mode (unContext ctx) z3_print_smtlib2_compliant - --- | Convert an AST to a string. -astToString :: Context -> AST -> IO String -astToString = liftFun1 z3_ast_to_string - --- | Convert a pattern to a string. -patternToString :: Context -> Pattern -> IO String -patternToString = liftFun1 z3_pattern_to_string - --- | Convert a sort to a string. -sortToString :: Context -> Sort -> IO String -sortToString = liftFun1 z3_sort_to_string - --- | Convert a FuncDecl to a string. -funcDeclToString :: Context -> FuncDecl -> IO String -funcDeclToString = liftFun1 z3_func_decl_to_string - --- | Convert the given benchmark into SMT-LIB formatted string. --- --- The output format can be configured via 'setASTPrintMode'. -benchmarkToSMTLibString :: Context - -> String -- ^ name - -> String -- ^ logic - -> String -- ^ status - -> String -- ^ attributes - -> [AST] -- ^ assumptions - -> AST -- ^ formula - -> IO String -benchmarkToSMTLibString ctx name logic status attr assump form = - marshal z3_benchmark_to_smtlib_string ctx $ \f -> - withCString name $ \namePtr -> - withCString logic $ \logicPtr -> - withCString status $ \statusPtr -> - withCString attr $ \attrPtr -> - marshalArrayLen assump $ \assumpNum assumpArr -> - h2c form $ \formPtr -> - f namePtr logicPtr statusPtr attrPtr assumpNum assumpArr formPtr - ---------------------------------------------------------------------- --- Error handling - --- | Z3 exceptions. -data Z3Error = Z3Error - { errCode :: Z3ErrorCode - , errMsg :: String - } - deriving Typeable - -instance Show Z3Error where - show (Z3Error _ s) = s - -data Z3ErrorCode = SortError | IOB | InvalidArg | ParserError | NoParser - | InvalidPattern | MemoutFail | FileAccessError | InternalFatal - | InvalidUsage | DecRefError | Z3Exception - deriving (Show, Typeable) - -toZ3Error :: Z3_error_code -> Z3ErrorCode -toZ3Error e - | e == z3_sort_error = SortError - | e == z3_iob = IOB - | e == z3_invalid_arg = InvalidArg - | e == z3_parser_error = ParserError - | e == z3_no_parser = NoParser - | e == z3_invalid_pattern = InvalidPattern - | e == z3_memout_fail = MemoutFail - | e == z3_file_access_error = FileAccessError - | e == z3_internal_fatal = InternalFatal - | e == z3_invalid_usage = InvalidUsage - | e == z3_dec_ref_error = DecRefError - | e == z3_exception = Z3Exception - | otherwise = error "Z3.Base.toZ3Error: illegal `Z3_error_code' value" - -instance Exception Z3Error - --- | Throws a z3 error -z3Error :: Z3ErrorCode -> String -> IO () -z3Error cd = throw . Z3Error cd - --- | Throw an exception if a Z3 error happened -checkError :: Context -> IO a -> IO a -checkError c m = m <* (z3_get_error_code (unContext c) >>= throwZ3Exn) - where throwZ3Exn i = when (i /= z3_ok) $ getErrStr i >>= z3Error (toZ3Error i) - getErrStr i = peekCString =<< z3_get_error_msg_ex (unContext c) i - ---------------------------------------------------------------------- --- Miscellaneous - -data Version - = Version { - z3Major :: !Int - , z3Minor :: !Int - , z3Build :: !Int - , z3Revision :: !Int - } - deriving (Eq,Ord) - -instance Show Version where - show (Version major minor build _) = - show major ++ "." ++ show minor ++ "." ++ show build - --- | Return Z3 version number information. -getVersion :: IO Version -getVersion = - alloca $ \ptrMinor -> - alloca $ \ptrMajor -> - alloca $ \ptrBuild -> - alloca $ \ptrRevision -> do - z3_get_version ptrMinor ptrMajor ptrBuild ptrRevision - minor <- fromIntegral <$> peek ptrMinor - major <- fromIntegral <$> peek ptrMajor - build <- fromIntegral <$> peek ptrBuild - revision <- fromIntegral <$> peek ptrRevision - return $ Version minor major build revision - ---------------------------------------------------------------------- --- Marshalling - -{- MARSHALLING HELPERS - -We try to get rid of most of the marshalling boilerplate which, by the way, -is going to be essential for transitioning to Z3 4 API. - -Most API functions can be lifted using 'liftFun'{0-3} helpers. Otherwise try -using 'marshal'. Worst case scenario, write the marshalling code yourself. - --} - -withSolverPtr :: Solver -> (Ptr Z3_solver -> IO a) -> IO a -withSolverPtr (Solver fptr) = withForeignPtr fptr - -withIntegral :: (Integral a, Integral b) => a -> (b -> r) -> r -withIntegral x f = f (fromIntegral x) - -marshalArray :: (Marshal h c, Storable c) => [h] -> (Ptr c -> IO a) -> IO a -marshalArray hs f = hs2cs hs $ \cs -> withArray cs f - -marshalArrayLen :: (Marshal h c, Storable c, Integral i) => - [h] -> (i -> Ptr c -> IO a) -> IO a -marshalArrayLen hs f = - hs2cs hs $ \cs -> withArrayLen cs $ \n -> f (fromIntegral n) - -liftAstN :: String - -> (Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast)) - -> Context -> [AST] -> IO AST -liftAstN s _ _ [] = error s -liftAstN _ f c es = marshal f c $ marshalArrayLen es -{-# INLINE liftAstN #-} - -class Marshal h c where - c2h :: Context -> c -> IO h - h2c :: h -> (c -> IO r) -> IO r - -hs2cs :: Marshal h c => [h] -> ([c] -> IO r) -> IO r -hs2cs [] f = f [] -hs2cs (h:hs) f = - h2c h $ \c -> - hs2cs hs $ \cs -> f (c:cs) - -instance Marshal h (Ptr x) => Marshal (Maybe h) (Ptr x) where - c2h c = T.mapM (c2h c) . ptrToMaybe - h2c Nothing f = f nullPtr - h2c (Just x) f = h2c x f - -instance Marshal () () where - c2h _ = return - h2c x f = f x - -instance Marshal Bool Z3_bool where - c2h _ = return . toBool - h2c b f = f (unBool b) - -instance Marshal Result Z3_lbool where - c2h _ = return . toResult - h2c = error "Marshal Result Z3_lbool => h2c not implemented" - -instance Integral h => Marshal h CInt where - c2h _ = return . fromIntegral - h2c i f = f (fromIntegral i) - -instance Integral h => Marshal h CUInt where - c2h _ = return . fromIntegral - h2c i f = f (fromIntegral i) - -instance Integral h => Marshal h CLLong where - c2h _ = return . fromIntegral - h2c i f = f (fromIntegral i) - -instance Integral h => Marshal h CULLong where - c2h _ = return . fromIntegral - h2c i f = f (fromIntegral i) - -instance Marshal Double CDouble where - c2h _ = return . realToFrac - h2c d f = f (realToFrac d) - -instance Marshal String CString where - c2h _ = peekCString - h2c = withCString - -instance Marshal App (Ptr Z3_app) where - c2h _ = return . App - h2c a f = f (unApp a) - -instance Marshal Params (Ptr Z3_params) where - c2h _ = return . Params - h2c p f = f (unParams p) - -instance Marshal Symbol (Ptr Z3_symbol) where - c2h _ = return . Symbol - h2c s f = f (unSymbol s) - -instance Marshal AST (Ptr Z3_ast) where - c2h _ = return . AST - h2c a f = f (unAST a) - -instance Marshal Sort (Ptr Z3_sort) where - c2h _ = return . Sort - h2c a f = f (unSort a) - -instance Marshal FuncDecl (Ptr Z3_func_decl) where - c2h _ = return . FuncDecl - h2c a f = f (unFuncDecl a) - -instance Marshal FuncEntry (Ptr Z3_func_entry) where - c2h _ = return . FuncEntry - h2c e f = f (unFuncEntry e) - -instance Marshal FuncInterp (Ptr Z3_func_interp) where - c2h _ = return . FuncInterp - h2c a f = f (unFuncInterp a) - -instance Marshal Model (Ptr Z3_model) where - c2h _ = return . Model - h2c m f = f (unModel m) - -instance Marshal Pattern (Ptr Z3_pattern) where - c2h _ = return . Pattern - h2c a f = f (unPattern a) - -instance Marshal Solver (Ptr Z3_solver) where - c2h = mkSolverForeign - h2c = withSolverPtr - -marshal :: Marshal rh rc => (Ptr Z3_context -> t) -> - Context -> (t -> IO rc) -> IO rh -marshal f c cont = checkError c $ cont (f (unContext c)) >>= c2h c - -liftFun0 :: Marshal rh rc => (Ptr Z3_context -> IO rc) -> - Context -> IO rh -liftFun0 f c = checkError c $ c2h c =<< f (unContext c) -{-# INLINE liftFun0 #-} - -liftFun1 :: (Marshal ah ac, Marshal rh rc) => - (Ptr Z3_context -> ac -> IO rc) -> - Context -> ah -> IO rh -liftFun1 f c x = checkError c $ h2c x $ \a -> - c2h c =<< f (unContext c) a -{-# INLINE liftFun1 #-} - -liftFun2 :: (Marshal ah ac, Marshal bh bc, Marshal rh rc) => - (Ptr Z3_context -> ac -> bc -> IO rc) -> - Context -> ah -> bh -> IO rh -liftFun2 f c x y = checkError c $ h2c x $ \a -> h2c y $ \b -> - c2h c =<< f (unContext c) a b -{-# INLINE liftFun2 #-} - -liftFun3 :: (Marshal ah ac, Marshal bh bc, Marshal ch cc, Marshal rh rc) => - (Ptr Z3_context -> ac -> bc -> cc -> IO rc) -> - Context -> ah -> bh -> ch -> IO rh -liftFun3 f c x y z = checkError c $ - h2c x $ \x1 -> h2c y $ \y1 -> h2c z $ \z1 -> - c2h c =<< f (unContext c) x1 y1 z1 -{-# INLINE liftFun3 #-} - ---------------------------------------------------------------------- --- Utils - --- | Convert 'Z3_lbool' from Z3.Base.C to 'Result' -toResult :: Z3_lbool -> Result -toResult lb - | lb == z3_l_true = Sat - | lb == z3_l_false = Unsat - | lb == z3_l_undef = Undef - | otherwise = error "Z3.Base.toResult: illegal `Z3_lbool' value" - --- | Convert 'Z3_bool' to 'Bool'. --- --- 'Foreign.toBool' should be OK but this is more convenient. -toBool :: Z3_bool -> Bool -toBool b - | b == z3_true = True - | b == z3_false = False - | otherwise = error "Z3.Base.toBool: illegal `Z3_bool' value" - --- | Convert 'Bool' to 'Z3_bool'. -unBool :: Bool -> Z3_bool -unBool True = z3_true -unBool False = z3_false - --- | Wraps a non-null pointer with 'Just', or else returns 'Nothing'. -ptrToMaybe :: Ptr a -> Maybe (Ptr a) -ptrToMaybe ptr | ptr == nullPtr = Nothing - | otherwise = Just ptr - diff --git a/Z3/Base/C.hsc b/Z3/Base/C.hsc deleted file mode 100644 --- a/Z3/Base/C.hsc +++ /dev/null @@ -1,947 +0,0 @@ -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE ForeignFunctionInterface #-} - --- | --- Module : Z3.Base.C --- Copyright : (c) Iago Abal, 2012-2014 --- (c) David Castro, 2012-2013 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro --- --- Z3 API foreign imports. - -{- HACKING - -Add here the foreign import to support a new API function: - -* Take a look to a few others foreign imports and follow the same coding style. - * 2-space wide indentation, no tabs. - * No trailing spaces, please. - * ... -* Place the foreign import in the right section, according to the Z3's API documentation. -* Include a reference to the function's API documentation. --} - -module Z3.Base.C where - -import Foreign -import Foreign.C.Types -import Foreign.C.String - -#include - - ---------------------------------------------------------------------- --- * Types - -data Z3_config - -data Z3_context - -data Z3_symbol - -data Z3_ast - -data Z3_sort - -data Z3_func_decl - -data Z3_app - -data Z3_pattern - -data Z3_model - -data Z3_func_interp - -data Z3_func_entry - -data Z3_solver - -data Z3_params - --- | Reference: -newtype Z3_lbool = Z3_lbool CInt - deriving Eq - -z3_l_true, z3_l_false, z3_l_undef :: Z3_lbool -z3_l_true = Z3_lbool (#const Z3_L_TRUE) -z3_l_false = Z3_lbool (#const Z3_L_FALSE) -z3_l_undef = Z3_lbool (#const Z3_L_UNDEF) - --- | Reference: -newtype Z3_bool = Z3_bool CInt - deriving Eq - --- | Reference: -type Z3_error_handler = Ptr Z3_context -> Z3_error_code -> IO () - -z3_true, z3_false :: Z3_bool --- | Reference: -z3_true = Z3_bool(#const Z3_TRUE) --- | Reference: -z3_false = Z3_bool(#const Z3_FALSE) - --- | Reference: -type Z3_string = CString - --- | Reference: -type Z3_ast_print_mode = CInt -z3_print_smtlib_full :: Z3_ast_print_mode -z3_print_smtlib_full = #const Z3_PRINT_SMTLIB_FULL -z3_print_low_level :: Z3_ast_print_mode -z3_print_low_level = #const Z3_PRINT_LOW_LEVEL -z3_print_smtlib_compliant :: Z3_ast_print_mode -z3_print_smtlib_compliant = #const Z3_PRINT_SMTLIB_COMPLIANT -z3_print_smtlib2_compliant :: Z3_ast_print_mode -z3_print_smtlib2_compliant = #const Z3_PRINT_SMTLIB2_COMPLIANT - --- | Reference: -type Z3_error_code = CInt -#{enum Z3_error_code, - , z3_ok = Z3_OK - , z3_sort_error = Z3_SORT_ERROR - , z3_iob = Z3_IOB - , z3_invalid_arg = Z3_INVALID_ARG - , z3_parser_error = Z3_PARSER_ERROR - , z3_no_parser = Z3_NO_PARSER - , z3_invalid_pattern = Z3_INVALID_PATTERN - , z3_memout_fail = Z3_MEMOUT_FAIL - , z3_file_access_error = Z3_FILE_ACCESS_ERROR - , z3_internal_fatal = Z3_INTERNAL_FATAL - , z3_invalid_usage = Z3_INVALID_USAGE - , z3_dec_ref_error = Z3_DEC_REF_ERROR - , z3_exception = Z3_EXCEPTION - } - ---------------------------------------------------------------------- --- * Create configuration - --- | Reference: -foreign import ccall unsafe "Z3_mk_config" - z3_mk_config :: IO (Ptr Z3_config) - --- | Reference: -foreign import ccall unsafe "Z3_del_config" - z3_del_config :: Ptr Z3_config -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_set_param_value" - z3_set_param_value :: Ptr Z3_config -> Z3_string -> Z3_string -> IO () - - ---------------------------------------------------------------------- --- * Create context - --- | Reference: -foreign import ccall unsafe "Z3_mk_context" - z3_mk_context :: Ptr Z3_config -> IO (Ptr Z3_context) - --- | Reference: -foreign import ccall unsafe "Z3_del_context" - z3_del_context :: Ptr Z3_context -> IO () - ---------------------------------------------------------------------- --- * Symbols - --- | Reference: -foreign import ccall unsafe "Z3_mk_int_symbol" - z3_mk_int_symbol :: Ptr Z3_context -> CInt -> IO (Ptr Z3_symbol) - --- | Reference: -foreign import ccall unsafe "Z3_mk_string_symbol" - z3_mk_string_symbol :: Ptr Z3_context -> Z3_string -> IO (Ptr Z3_symbol) - ---------------------------------------------------------------------- --- * Sorts - --- TODO Sorts: Z3_is_eq_sort - --- | Reference: -foreign import ccall unsafe "Z3_mk_uninterpreted_sort" - z3_mk_uninterpreted_sort :: Ptr Z3_context -> Ptr Z3_symbol -> IO (Ptr Z3_sort) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bool_sort" - z3_mk_bool_sort :: Ptr Z3_context -> IO (Ptr Z3_sort) - --- | Reference: -foreign import ccall unsafe "Z3_mk_int_sort" - z3_mk_int_sort :: Ptr Z3_context -> IO (Ptr Z3_sort) - --- | Reference: -foreign import ccall unsafe "Z3_mk_real_sort" - z3_mk_real_sort :: Ptr Z3_context -> IO (Ptr Z3_sort) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bv_sort" - z3_mk_bv_sort :: Ptr Z3_context -> CUInt -> IO (Ptr Z3_sort) - --- | Reference: -foreign import ccall unsafe "Z3_mk_array_sort" - z3_mk_array_sort :: Ptr Z3_context -> Ptr Z3_sort -> Ptr Z3_sort -> IO (Ptr Z3_sort) - --- | Reference: -foreign import ccall unsafe "Z3_mk_tuple_sort" - z3_mk_tuple_sort :: Ptr Z3_context - -> Ptr Z3_symbol - -> CUInt - -> Ptr (Ptr Z3_symbol) - -> Ptr (Ptr Z3_sort) - -> Ptr (Ptr Z3_func_decl) - -> Ptr (Ptr Z3_func_decl) - -> IO (Ptr Z3_sort) - --- TODO Sorts: from Z3_mk_array_sort on - - ---------------------------------------------------------------------- --- * Constants and Applications - --- | Reference: -foreign import ccall unsafe "Z3_mk_func_decl" - z3_mk_func_decl :: Ptr Z3_context - -> Ptr Z3_symbol - -> CUInt - -> Ptr (Ptr Z3_sort) - -> Ptr Z3_sort - -> IO (Ptr Z3_func_decl) - --- | Reference: -foreign import ccall unsafe "Z3_mk_app" - z3_mk_app :: Ptr Z3_context - -> Ptr Z3_func_decl - -> CUInt - -> Ptr (Ptr Z3_ast) - -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_const" - z3_mk_const :: Ptr Z3_context -> Ptr Z3_symbol -> Ptr Z3_sort -> IO (Ptr Z3_ast) - --- TODO Constants and Applications: Z3_mk_fresh_func_decl --- TODO Constants and Applications: Z3_mk_fresh_const - ---------------------------------------------------------------------- --- * Propositional Logic and Equality - --- | Reference: -foreign import ccall unsafe "Z3_mk_true" - z3_mk_true :: Ptr Z3_context -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_false" - z3_mk_false :: Ptr Z3_context -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_eq" - z3_mk_eq :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_distinct" - z3_mk_distinct :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_not" - z3_mk_not :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_ite" - z3_mk_ite :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_iff" - z3_mk_iff :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_implies" - z3_mk_implies :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_xor" - z3_mk_xor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_and" - z3_mk_and :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_or" - z3_mk_or :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) - ---------------------------------------------------------------------- --- * Arithmetic: Integers and Reals - --- | Reference: -foreign import ccall unsafe "Z3_mk_add" - z3_mk_add :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_mul" - z3_mk_mul :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_sub" - z3_mk_sub :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_unary_minus" - z3_mk_unary_minus :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_div" - z3_mk_div :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_mod" - z3_mk_mod :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_rem" - z3_mk_rem :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_lt" - z3_mk_lt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_le" - z3_mk_le :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_gt" - z3_mk_gt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_ge" - z3_mk_ge :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_int2real" - z3_mk_int2real :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_real2int" - z3_mk_real2int :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_is_int" - z3_mk_is_int :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - ---------------------------------------------------------------------- --- * Bit-vectors - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvnot" - z3_mk_bvnot :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvredand" - z3_mk_bvredand :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvredor" - z3_mk_bvredor :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvand" - z3_mk_bvand :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvor" - z3_mk_bvor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvxor" - z3_mk_bvxor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvnand" - z3_mk_bvnand :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvnor" - z3_mk_bvnor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvxnor" - z3_mk_bvxnor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvadd" - z3_mk_bvadd :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsub" - z3_mk_bvsub :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvmul" - z3_mk_bvmul :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvudiv" - z3_mk_bvudiv :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsdiv" - z3_mk_bvsdiv :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvurem" - z3_mk_bvurem :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsrem" - z3_mk_bvsrem :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsmod" - z3_mk_bvsmod :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvult" - z3_mk_bvult :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvslt" - z3_mk_bvslt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvule" - z3_mk_bvule :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsle" - z3_mk_bvsle :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvuge" - z3_mk_bvuge :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsge" - z3_mk_bvsge :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvugt" - z3_mk_bvugt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsgt" - z3_mk_bvsgt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_concat" - z3_mk_concat :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_extract" - z3_mk_extract :: Ptr Z3_context -> CUInt -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_sign_ext" - z3_mk_sign_ext :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_zero_ext" - z3_mk_zero_ext :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_repeat" - z3_mk_repeat :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvshl" - z3_mk_bvshl :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvlshr" - z3_mk_bvlshr :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvashr" - z3_mk_bvashr :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_rotate_left" - z3_mk_rotate_left :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_rotate_right" - z3_mk_rotate_right :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_ext_rotate_left" - z3_mk_ext_rotate_left :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_ext_rotate_right" - z3_mk_ext_rotate_right :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_int2bv" - z3_mk_int2bv :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bv2int" - z3_mk_bv2int :: Ptr Z3_context -> Ptr Z3_ast -> Z3_bool -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvadd_no_overflow" - z3_mk_bvadd_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> Z3_bool -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvadd_no_underflow" - z3_mk_bvadd_no_underflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsub_no_overflow" - z3_mk_bvsub_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsub_no_underflow" - z3_mk_bvsub_no_underflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvsdiv_no_overflow" - z3_mk_bvsdiv_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvneg_no_overflow" - z3_mk_bvneg_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvmul_no_overflow" - z3_mk_bvmul_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> Z3_bool -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bvmul_no_underflow" - z3_mk_bvmul_no_underflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --------------------------------------------------------------------------------- --- * Arrays - --- | Reference: -foreign import ccall unsafe "Z3_mk_select" - z3_mk_select :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_store" - z3_mk_store :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_const_array" - z3_mk_const_array :: Ptr Z3_context -> Ptr Z3_sort -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_map" - z3_mk_map :: Ptr Z3_context -> Ptr Z3_func_decl -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_array_default" - z3_mk_array_default :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) - --- TODO Sets - ---------------------------------------------------------------------- --- * Numerals - --- | Reference: -foreign import ccall unsafe "Z3_mk_numeral" - z3_mk_numeral :: Ptr Z3_context -> Z3_string -> Ptr Z3_sort -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_real" - z3_mk_real :: Ptr Z3_context -> CInt -> CInt -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_int" - z3_mk_int :: Ptr Z3_context -> CInt -> Ptr Z3_sort -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_unsigned_int" - z3_mk_unsigned_int :: Ptr Z3_context -> CUInt -> Ptr Z3_sort -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_int64" - z3_mk_int64 :: Ptr Z3_context -> CLLong -> Ptr Z3_sort -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_unsigned_int64" - z3_mk_unsigned_int64 :: Ptr Z3_context -> CULLong -> Ptr Z3_sort -> IO (Ptr Z3_ast) - ---------------------------------------------------------------------- --- * Quantifiers - --- | Reference: -foreign import ccall unsafe "Z3_mk_pattern" - z3_mk_pattern :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_pattern) - --- | Reference: -foreign import ccall unsafe "Z3_mk_bound" - z3_mk_bound :: Ptr Z3_context -> CUInt -> Ptr Z3_sort -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_forall" - z3_mk_forall :: Ptr Z3_context -> CUInt - -> CUInt -> Ptr (Ptr Z3_pattern) - -> CUInt -> Ptr (Ptr Z3_sort) -> Ptr (Ptr Z3_symbol) - -> Ptr Z3_ast - -> IO (Ptr Z3_ast) - --- | Referece: -foreign import ccall unsafe "Z3_mk_exists" - z3_mk_exists :: Ptr Z3_context -> CUInt - -> CUInt -> Ptr (Ptr Z3_pattern) - -> CUInt -> Ptr (Ptr Z3_sort) -> Ptr (Ptr Z3_symbol) - -> Ptr Z3_ast - -> IO (Ptr Z3_ast) - --- TODO: Z3_mk_quantifier, Z3_mk_quantifier_ex - --- | Reference -foreign import ccall unsafe "Z3_mk_forall_const" - z3_mk_forall_const :: Ptr Z3_context - -> CUInt - -> CUInt - -> Ptr (Ptr Z3_app) - -> CUInt - -> Ptr (Ptr Z3_pattern) - -> Ptr Z3_ast - -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_mk_exists_const" - z3_mk_exists_const :: Ptr Z3_context - -> CUInt - -> CUInt - -> Ptr (Ptr Z3_app) - -> CUInt - -> Ptr (Ptr Z3_pattern) - -> Ptr Z3_ast - -> IO (Ptr Z3_ast) - --- TODO: Z3_mk_quantifier_const, Z3_mk_quantifier_const_ex - ---------------------------------------------------------------------- --- * Accessors - --- | Reference: -foreign import ccall unsafe "Z3_get_bv_sort_size" - z3_get_bv_sort_size :: Ptr Z3_context -> Ptr Z3_sort -> IO CUInt - --- | Reference: -foreign import ccall unsafe "Z3_get_sort" - z3_get_sort :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_sort) - --- | Reference: -foreign import ccall unsafe "Z3_get_bool_value" - z3_get_bool_value :: Ptr Z3_context -> Ptr Z3_ast -> IO Z3_lbool - --- | Reference: -foreign import ccall unsafe "Z3_get_numeral_string" - z3_get_numeral_string :: Ptr Z3_context -> Ptr Z3_ast -> IO Z3_string - --- | Reference: -foreign import ccall unsafe "Z3_to_app" - z3_to_app :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_app) - --- TODO Modifiers - ---------------------------------------------------------------------- --- * Models - --- | Reference: -foreign import ccall unsafe "Z3_eval" - z3_eval :: Ptr Z3_context - -> Ptr Z3_model - -> Ptr Z3_ast - -> Ptr (Ptr Z3_ast) - -> IO Z3_bool - --- | Reference: -foreign import ccall unsafe "Z3_is_as_array" - z3_is_as_array :: Ptr Z3_context - -> Ptr Z3_ast - -> IO Z3_bool - --- | Reference: -foreign import ccall unsafe "Z3_get_as_array_func_decl" - z3_get_as_array_func_decl :: Ptr Z3_context - -> Ptr Z3_ast - -> IO (Ptr Z3_func_decl) - --- | Reference: -foreign import ccall unsafe "Z3_model_get_func_interp" - z3_model_get_func_interp :: Ptr Z3_context - -> Ptr Z3_model - -> Ptr Z3_func_decl - -> IO (Ptr Z3_func_interp) - --- | Reference: -foreign import ccall unsafe "Z3_func_interp_get_num_entries" - z3_func_interp_get_num_entries :: Ptr Z3_context - -> Ptr Z3_func_interp - -> IO CUInt - --- | Reference: -foreign import ccall unsafe "Z3_func_interp_get_entry" - z3_func_interp_get_entry :: Ptr Z3_context - -> Ptr Z3_func_interp - -> CUInt - -> IO (Ptr Z3_func_entry) - --- | Reference: -foreign import ccall unsafe "Z3_func_interp_get_else" - z3_func_interp_get_else :: Ptr Z3_context - -> Ptr Z3_func_interp - -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_func_interp_get_arity" - z3_func_interp_get_arity :: Ptr Z3_context - -> Ptr Z3_func_interp - -> IO CUInt - --- | Reference: -foreign import ccall unsafe "Z3_func_entry_get_value" - z3_func_entry_get_value :: Ptr Z3_context - -> Ptr Z3_func_entry - -> IO (Ptr Z3_ast) - --- | Reference: -foreign import ccall unsafe "Z3_func_entry_get_num_args" - z3_func_entry_get_num_args :: Ptr Z3_context - -> Ptr Z3_func_entry - -> IO CUInt - --- | Reference: -foreign import ccall unsafe "Z3_func_entry_get_arg" - z3_func_entry_get_arg :: Ptr Z3_context - -> Ptr Z3_func_entry - -> CUInt - -> IO (Ptr Z3_ast) - ---------------------------------------------------------------------- --- * Constraints - --- | Reference: -foreign import ccall unsafe "Z3_push" - z3_push :: Ptr Z3_context -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_pop" - z3_pop :: Ptr Z3_context -> CUInt -> IO () - --- TODO Constraints: Z3_get_num_scopes --- TODO Constraints: Z3_persist_ast - --- | Reference: -foreign import ccall unsafe "Z3_assert_cnstr" - z3_assert_cnstr :: Ptr Z3_context -> Ptr Z3_ast -> IO () - --- | Reference : -foreign import ccall unsafe "Z3_check_and_get_model" - z3_check_and_get_model :: Ptr Z3_context -> Ptr (Ptr Z3_model) -> IO Z3_lbool - --- | Reference: -foreign import ccall unsafe "Z3_check" - z3_check :: Ptr Z3_context -> IO Z3_lbool - --- TODO Constraints: Z3_check_assumptions --- TODO Constraints: Z3_get_implied_equalities - --- | Reference: -foreign import ccall unsafe "Z3_del_model" - z3_del_model :: Ptr Z3_context -> Ptr Z3_model -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_model_to_string" - z3_model_to_string :: Ptr Z3_context -> Ptr Z3_model -> IO CString - --- | Reference: -foreign import ccall unsafe "Z3_context_to_string" - z3_context_to_string :: Ptr Z3_context -> IO CString - --- TODO From section 'Constraints' on. - - ---------------------------------------------------------------------- --- * Parameters - --- | Reference: -foreign import ccall unsafe "Z3_mk_params" - z3_mk_params :: Ptr Z3_context -> IO (Ptr Z3_params) - --- | Reference: -foreign import ccall unsafe "Z3_params_inc_ref" - z3_params_inc_ref :: Ptr Z3_context -> Ptr Z3_params -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_params_dec_ref" - z3_params_dec_ref :: Ptr Z3_context -> Ptr Z3_params -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_params_set_bool" - z3_params_set_bool :: Ptr Z3_context -> Ptr Z3_params -> Ptr Z3_symbol -> - Z3_bool -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_params_set_uint" - z3_params_set_uint :: Ptr Z3_context -> Ptr Z3_params -> Ptr Z3_symbol -> - CUInt -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_params_set_double" - z3_params_set_double :: Ptr Z3_context -> Ptr Z3_params -> Ptr Z3_symbol -> - CDouble -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_params_set_symbol" - z3_params_set_symbol :: Ptr Z3_context -> Ptr Z3_params -> Ptr Z3_symbol -> - Ptr Z3_symbol -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_params_to_string" - z3_params_to_string :: Ptr Z3_context -> Ptr Z3_params -> IO Z3_string - ---------------------------------------------------------------------- --- * Solvers - --- | Reference: -foreign import ccall unsafe "Z3_mk_solver" - z3_mk_solver :: Ptr Z3_context -> IO (Ptr Z3_solver) - --- | Reference: -foreign import ccall unsafe "Z3_mk_simple_solver" - z3_mk_simple_solver :: Ptr Z3_context -> IO (Ptr Z3_solver) - --- | Reference: -foreign import ccall unsafe "Z3_mk_solver_for_logic" - z3_mk_solver_for_logic :: Ptr Z3_context -> Ptr Z3_symbol -> IO (Ptr Z3_solver) - --- | Reference: -foreign import ccall unsafe "Z3_solver_set_params" - z3_solver_set_params :: Ptr Z3_context -> Ptr Z3_solver -> Ptr Z3_params -> - IO () - --- | Reference: -foreign import ccall unsafe "Z3_solver_inc_ref" - z3_solver_inc_ref :: Ptr Z3_context -> Ptr Z3_solver -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_solver_dec_ref" - z3_solver_dec_ref :: Ptr Z3_context -> Ptr Z3_solver -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_solver_push" - z3_solver_push :: Ptr Z3_context -> Ptr Z3_solver -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_solver_pop" - z3_solver_pop :: Ptr Z3_context -> Ptr Z3_solver -> CUInt -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_solver_get_num_scopes" - z3_solver_get_num_scopes :: Ptr Z3_context -> Ptr Z3_solver -> IO CUInt - --- | Reference: -foreign import ccall unsafe "Z3_solver_reset" - z3_solver_reset :: Ptr Z3_context -> Ptr Z3_solver -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_solver_assert" - z3_solver_assert :: Ptr Z3_context -> Ptr Z3_solver -> Ptr Z3_ast -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_solver_assert_and_track" - z3_solver_assert_and_track :: Ptr Z3_context -> Ptr Z3_solver -> - Ptr Z3_ast -> Ptr Z3_ast -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_solver_check" - z3_solver_check :: Ptr Z3_context -> Ptr Z3_solver -> IO Z3_lbool - --- | Reference: -foreign import ccall unsafe "Z3_solver_get_model" - z3_solver_get_model :: Ptr Z3_context -> Ptr Z3_solver -> IO (Ptr Z3_model) - --- | Reference: -foreign import ccall unsafe "Z3_solver_get_reason_unknown" - z3_solver_get_reason_unknown :: Ptr Z3_context -> Ptr Z3_solver -> - IO Z3_string - --- | Reference: -foreign import ccall unsafe "Z3_solver_to_string" - z3_solver_to_string :: Ptr Z3_context -> Ptr Z3_solver -> IO Z3_string - ---------------------------------------------------------------------- --- * String Conversion - --- | Reference: -foreign import ccall unsafe "Z3_set_ast_print_mode" - z3_set_ast_print_mode :: Ptr Z3_context -> Z3_ast_print_mode -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_ast_to_string" - z3_ast_to_string :: Ptr Z3_context -> Ptr Z3_ast -> IO Z3_string - --- | Reference: -foreign import ccall unsafe "Z3_pattern_to_string" - z3_pattern_to_string :: Ptr Z3_context -> Ptr Z3_pattern -> IO Z3_string - --- | Reference: -foreign import ccall unsafe "Z3_sort_to_string" - z3_sort_to_string :: Ptr Z3_context -> Ptr Z3_sort -> IO Z3_string - --- | Reference: -foreign import ccall unsafe "Z3_func_decl_to_string" - z3_func_decl_to_string :: Ptr Z3_context -> Ptr Z3_func_decl -> IO Z3_string - --- | Reference: -foreign import ccall unsafe "Z3_benchmark_to_smtlib_string" - z3_benchmark_to_smtlib_string :: Ptr Z3_context - -> Z3_string -- ^ name - -> Z3_string -- ^ logic - -> Z3_string -- ^ status - -> Z3_string -- ^ attributes - -> CUInt -- ^ assumptions# - -> Ptr (Ptr Z3_ast) -- ^ assumptions - -> Ptr Z3_ast -- ^ formula - -> IO Z3_string - ---------------------------------------------------------------------- --- * Error Handling - --- | Reference: -foreign import ccall unsafe "Z3_get_error_code" - z3_get_error_code :: Ptr Z3_context -> IO Z3_error_code - --- | Reference: -foreign import ccall unsafe "Z3_set_error_handler" - z3_set_error_handler :: Ptr Z3_context -> FunPtr Z3_error_handler -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_set_error" - z3_set_error :: Ptr Z3_context -> Z3_error_code -> IO () - --- | Reference: -foreign import ccall unsafe "Z3_get_error_msg" - z3_get_error_msg :: Z3_error_code -> IO Z3_string - --- | Reference: -foreign import ccall unsafe "Z3_get_error_msg_ex" - z3_get_error_msg_ex :: Ptr Z3_context -> Z3_error_code -> IO Z3_string - ---------------------------------------------------------------------- --- * Miscellaneous - --- | Reference: -foreign import ccall unsafe "Z3_get_version" - z3_get_version :: Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO () diff --git a/Z3/Lang.hs b/Z3/Lang.hs deleted file mode 100644 --- a/Z3/Lang.hs +++ /dev/null @@ -1,24 +0,0 @@ - --- | --- Module : Z3.Lang --- Copyright : (c) Iago Abal, 2012 --- (c) David Castro, 2012 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro --- Stability : experimental - -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} - -- Imports deprecated modules, but it is a depcrecated module itself. - -module Z3.Lang - {-# DEPRECATED - "The Z3.Lang interface will be moved to a dedicated package." - #-} - ( module Z3.Lang.Prelude - , module Z3.Lang.Nat - ) where - - -import Z3.Lang.Prelude -import Z3.Lang.Nat diff --git a/Z3/Lang/Exprs.hs b/Z3/Lang/Exprs.hs deleted file mode 100644 --- a/Z3/Lang/Exprs.hs +++ /dev/null @@ -1,236 +0,0 @@ -{-# OPTIONS_GHC -funbox-strict-fields #-} - -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TypeFamilies #-} - --- | --- Module : Z3.Lang.Exprs --- Copyright : (c) Iago Abal, 2012 --- (c) David Castro, 2012 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro --- Stability : experimental - -module Z3.Lang.Exprs ( - -- * Types - Compilable(..) - , IsTy(..) - , IsFun(..) - , Castable(..) - - -- ** Numeric types - , IsNum - , IsInt - , IsReal - - -- * Abstract syntax - , Uniq - , Layout - , Expr (..) - , Pattern (..) - , Quantifier(..) - , QExpr(..) - , FunApp (..) - , BoolBinOp (..) - , BoolMultiOp (..) - , CRingOp (..) - , IntOp (..) - , RealOp (..) - , CmpOpE (..) - , CmpOpI (..) - - -- * Type checking - , typecheck - , TCM - , TCC - , ok - , withHypo - , newTCC - , evalTCM - ) where - -import {-# SOURCE #-} Z3.Lang.Monad ( Z3 ) -import Z3.Lang.TY -import qualified Z3.Base as Base - -import Control.Monad.RWS -import Data.Typeable ( Typeable ) - ----------------------------------------------------------------------- --- Types - --- | Compilable /things/. -class Compilable t where - compile :: t -> Z3 Base.AST - --- | Types for expressions. -class (Eq a, Show a, Typeable a, Compilable (Expr a)) => IsTy a where - -- | Type invariant. - -- Introduced when creating a variable. - typeInv :: Expr a -> Expr Bool - - -- | Typecheck an expression. - tc :: Expr a -> TCM () - - -- | Create a sort of the underlying Z3 type. - mkSort :: TY a -> Z3 Base.Sort - - -- | Create a value of the . - mkLiteral :: a -> Z3 Base.AST - - -- | Value extractor - getValue :: Base.AST -> Z3 a - - --- | Function types. -class IsFun a where - domain :: TY a -> Z3 [Base.Sort] - range :: TY a -> Z3 Base.Sort - ------------------------------------------------------------- --- Numeric types --- --- Future Work: We would like to instance 'IsInt' with 'Int32' to provide --- support for reasoning about 32-bit integer arithmetic with overflow. --- It would be also interesting (but perhaps more tricky) to support --- floating point arithmetic by creating an instance of 'IsReal' for --- 'Double'. - --- | Numeric types. -class (IsTy a, Num a) => IsNum a where - --- | Typeclass for Haskell Z3 numbers of /int/ sort in Z3. -class (IsNum a, Integral a) => IsInt a where - --- | Typeclass for Haskell Z3 numbers of /real/ sort in Z3. -class (IsNum a, Fractional a, Real a) => IsReal a where - ------------------------------------------------------------- --- Abstract syntax - --- | Unique identifiers. -type Uniq = Int - --- | Quantifier layout level. -type Layout = Int - --- | Expressions. -data Expr :: * -> * where - -- | Literals - Lit :: IsTy a => a -> Expr a - -- | Constants - Const :: !Uniq -> Base.AST -> Expr a - -- | Tag, for converting from HOAS to de-Bruijn - Tag :: !Layout -> Expr a - -- | Logical negation - Not :: Expr Bool -> Expr Bool - -- | Binary boolean expressions - BoolBin :: BoolBinOp -> Expr Bool -> Expr Bool -> Expr Bool - -- | Variadic boolean expressions - BoolMulti :: BoolMultiOp -> [Expr Bool] -> Expr Bool - -- | Quantified formula - Quant :: QExpr t => Quantifier -> t -> Expr Bool - -- | Arithmetic negation - Neg :: IsNum a => Expr a -> Expr a - -- | Arithmetic expressions for commutative rings - CRingArith :: IsNum a => CRingOp -> [Expr a] -> Expr a - -- | Integer arithmetic - IntArith :: IsInt a => IntOp -> Expr a -> Expr a -> Expr a - -- | Real arithmetic - RealArith :: IsReal a => RealOp -> Expr a -> Expr a -> Expr a - -- | Equality testing. - CmpE :: IsTy a => CmpOpE -> [Expr a] -> Expr Bool - -- | Ordering comparisons. - CmpI :: IsNum a => CmpOpI -> Expr a -> Expr a -> Expr Bool - -- | if-then-else expressions - Ite :: IsTy a => Expr Bool -> Expr a -> Expr a -> Expr a - -- | Application - App :: IsTy a => FunApp a -> Expr a - -- | Casting between compatible types - Cast :: (IsTy a, IsTy b, Castable a b) => Expr a -> Expr b - --- | Quantifiable expressions. -class QExpr t where - compileQuant :: Quantifier -> [Base.Symbol] -> [Base.Sort] -> t -> Z3 Base.AST - --- | Convertible types. -class (IsTy a, IsTy b) => Castable a b where - compileCast :: TY (a,b) -> Base.AST -> Z3 Base.AST - - --- | Quantifier pattern. -data Pattern where - Pat :: IsTy a => Expr a -> Pattern - --- | Quantifiers -data Quantifier = ForAll | Exists - deriving (Eq, Show) - --- | Z3 function -data FunApp :: * -> * where - -- | Function declaration - FuncDecl :: IsFun a => Base.FuncDecl -> FunApp a - -- | Partial application - PApp :: IsTy a => FunApp (a -> b) -> Expr a -> FunApp b - --- | Boolean binary operations. -data BoolBinOp = Xor | Implies | Iff - deriving (Eq,Show) - --- | Boolean variadic operations. -data BoolMultiOp = And | Or - deriving (Eq,Show) - --- | Commutative ring operations. -data CRingOp = Add | Mul | Sub - deriving (Eq,Show) - --- | Operations for sort /int/. -data IntOp = Quot | Mod | Rem - deriving (Eq,Show) - --- | Operations for sort /real/. -data RealOp = Div - deriving (Eq,Show) - --- | Equality testing. -data CmpOpE = Eq | Distinct - deriving (Eq, Show, Typeable) - --- | Ordering comparisons. -data CmpOpI = Le | Lt | Ge | Gt - deriving (Eq, Show, Typeable) - ----------------------------------------------------------------------- --- Typecheck monad - -newtype TCM a = TCM { unTCM :: RWS Context [TCC] () a } - deriving Monad - -type TCC = Expr Bool - -type Context = [Expr Bool] - -ok :: TCM () -ok = return () - -withHypo :: Expr Bool -> TCM a -> TCM a -withHypo h = TCM . local (h:) . unTCM - -newTCC :: [Expr Bool] -> TCM () -newTCC tccs = TCM $ do - hs <- ask - tell $ map (mkTCC hs) tccs - where mkTCC [] = id - mkTCC hs = BoolBin Implies (BoolMulti And hs) - -evalTCM :: TCM a -> (a,[TCC]) -evalTCM m = evalRWS (unTCM m) [] () - -typecheck :: IsTy a => Expr a -> [Expr Bool] -typecheck e = snd $ evalTCM (tc e) diff --git a/Z3/Lang/Lg2.hs b/Z3/Lang/Lg2.hs deleted file mode 100644 --- a/Z3/Lang/Lg2.hs +++ /dev/null @@ -1,45 +0,0 @@ - -{-# LANGUAGE ScopedTypeVariables #-} - --- | --- Module : Z3.Lang.Lg2 --- Copyright : (c) Iago Abal, 2012 --- (c) David Castro, 2012 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro - -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} - -- Imports deprecated modules, but it is a depcrecated module itself. - -module Z3.Lang.Lg2 - {-# DEPRECATED - "The Z3.Lang interface will be moved to a dedicated package." - #-} - ( declareLg2 ) - where - -import Z3.Lang.Prelude - --- | Ceiling logarithm base two. --- Axiomatization of the /lg2/ function. --- Most likely Z3 is going to diverge if you use /lg2/ to specify a satisfiable --- problem since it cannot construct a recursive definition for /lg2/, but it --- should work fine for unsatisfiable instances. -declareLg2 :: IsInt a => Z3 (Expr a -> Expr a) -declareLg2 = do - lg2::Expr a -> Expr a <- fun1 - -- invariants - assert $ forall $ \x -> (x >* 0 ==> lg2 x >=* 0) `instanceWhen` [Pat $ lg2 x] - assert $ forall $ \x -> (x >* 0 ==> lg2 x <* x) `instanceWhen` [Pat $ lg2 x] - assert $ forall $ \x -> - x >* 0 ==> (lg2 (x+1) ==* lg2 x ||* lg2 (x+1) ==* 1 + lg2 x) - -- base cases - assert $ lg2 1 ==* 0 - assert $ lg2 2 ==* 1 - -- recursive definition - assert $ forall (\x -> lg2 (2*x) ==* 1 + lg2 x) - assert $ forall (\x -> lg2 (2*x+1) ==* lg2 (x+1)) - -- and that's it! - return lg2 - diff --git a/Z3/Lang/Monad.hs b/Z3/Lang/Monad.hs deleted file mode 100644 --- a/Z3/Lang/Monad.hs +++ /dev/null @@ -1,210 +0,0 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE ScopedTypeVariables #-} - -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} - -- This is just to avoid warnings because we import fragile new Z3 API stuff - -- from Z3.Base - --- | --- Module : Z3.Lang.Monad --- Copyright : (c) Iago Abal, 2012 --- (c) David Castro, 2012 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro --- Stability : experimental - --- TODO Discuss integration of pretty-printing functions from Z3.Monad -module Z3.Lang.Monad ( - -- * Z3 Monad - Z3 - , Z3State(..) - , evalZ3 - , Args(..) - , stdArgs - , Logic(..) - , module Z3.Opts - , evalZ3With - , fresh - , deBruijnIx - , newQLayout - - -- ** Lifted Z3.Base functions - , getValue - , mkSort - , mkLiteral - , mkBoolBin - , mkBoolMulti - , mkQuant - , mkEq - , mkCmp - , mkCRingArith - , mkIntArith - , mkRealArith - - -- * Satisfiability result - , Base.Result - - ) where - -import Z3.Lang.Exprs - -import qualified Z3.Base as Base -import qualified Z3.Monad as MonadZ3 -import Z3.Monad ( MonadZ3(..), Logic(..) ) -import Z3.Opts - -import Control.Applicative ( Applicative ) -import Control.Monad.State -import Data.Maybe ( fromMaybe ) -import qualified Data.Traversable as T - ---------------------------------------------------------------------- --- The Z3 Monad - --- | Z3 monad. -newtype Z3 a = Z3 (StateT Z3State IO a) - deriving (Functor, Applicative, Monad, MonadIO, MonadState Z3State) - -instance MonadZ3 Z3 where - getSolver = Z3 $ gets solver - getContext = Z3 $ gets context - --- | Internal state of Z3 monad. -data Z3State - = Z3State { uniqVal :: !Uniq - , context :: Base.Context - , solver :: Maybe Base.Solver - , qLayout :: !Layout - } - --- | Eval a Z3 script. -evalZ3 :: Z3 a -> IO a -evalZ3 = evalZ3With stdArgs - --- | Eval a Z3 script. -evalZ3With :: Args -> Z3 a -> IO a -evalZ3With args (Z3 s) = - Base.withConfig $ \cfg -> do - setArgs cfg args - Base.withContext cfg $ \ctx -> - do mbSolver <- T.mapM (Base.mkSolverForLogic ctx) $ logic args - evalStateT s Z3State { uniqVal = 0 - , context = ctx - , solver = mbSolver - , qLayout = 0 - } - --- | Fresh symbol name. -fresh :: Z3 Uniq -fresh = do - st <- get - let i = uniqVal st - put st { uniqVal = i + 1 } - return i - -------------------------------------------------- --- Arguments - -{-# WARNING logic - "New Z3 API support is still incomplete and fragile: \ - \you may experience segmentation faults!" - #-} - -data Args - = Args { - logic :: Maybe Logic - -- ^ the logic to use; see - , softTimeout :: Maybe Int - -- ^ soft timeout (in milliseconds) - , options :: Opts - -- ^ Z3 options - } - -stdArgs :: Args -stdArgs - = Args { - logic = Nothing - , softTimeout = Nothing - , options = stdOpts +? opt "MODEL" True - +? opt "MODEL_COMPLETION" True - } - -setArgs :: Base.Config -> Args -> IO () -setArgs cfg args = do - Base.setParamValue cfg "SOFT_TIMEOUT" soft_timeout_val - setOpts cfg $ options args - where soft_timeout_val = show $ fromMaybe 0 $ softTimeout args - -------------------------------------------------- --- HOAX-deBruijn conversion - -getQLayout :: Z3 Layout -getQLayout = gets qLayout - -deBruijnIx :: Layout -> Z3 Int -deBruijnIx k = do lyt <- getQLayout; return $ lyt-k-1 - -newQLayout :: (Expr a -> Z3 b) -> Z3 b -newQLayout f = do - lyt <- getQLayout - incQLayout - x <- f (Tag lyt) - decQLayout - return x - where incQLayout = modify (\st@Z3State{qLayout} -> st{ qLayout = qLayout+1 }) - decQLayout = modify (\st@Z3State{qLayout} -> st{ qLayout = qLayout-1 }) - ---------------------------------------------------------------------- --- Lifted Base functions - -mkBoolBin :: BoolBinOp -> Base.AST -> Base.AST -> Z3 Base.AST -mkBoolBin Xor = MonadZ3.mkXor -mkBoolBin Implies = MonadZ3.mkImplies -mkBoolBin Iff = MonadZ3.mkIff - -mkBoolMulti :: BoolMultiOp -> [Base.AST] -> Z3 Base.AST -mkBoolMulti And = MonadZ3.mkAnd -mkBoolMulti Or = MonadZ3.mkOr - -mkQuant :: Quantifier - -> [Base.Pattern] - -> [Base.Symbol] -> [Base.Sort] - -> Base.AST -> Z3 Base.AST -mkQuant ForAll = MonadZ3.mkForall -mkQuant Exists = MonadZ3.mkExists - -mkEq :: CmpOpE -> [Base.AST] -> Z3 Base.AST -mkEq Distinct = MonadZ3.mkDistinct -mkEq Eq = doMkEq - where doMkEq [e1,e2] - = MonadZ3.mkEq e1 e2 - doMkEq es - | length es < 2 = error "Z3.Lang.Monad.mkEq:\ - \ Invalid number of parameters." - | otherwise = join $ liftM (mkBoolMulti And) doEqs - where doEqs = mapM (uncurry $ MonadZ3.mkEq) pairs - pairs = init $ zip es $ tail $ cycle es - -mkCmp :: CmpOpI -> Base.AST -> Base.AST -> Z3 Base.AST -mkCmp Le = MonadZ3.mkLe -mkCmp Lt = MonadZ3.mkLt -mkCmp Ge = MonadZ3.mkGe -mkCmp Gt = MonadZ3.mkGt - -mkCRingArith :: CRingOp -> [Base.AST] -> Z3 Base.AST -mkCRingArith Add = MonadZ3.mkAdd -mkCRingArith Mul = MonadZ3.mkMul -mkCRingArith Sub = MonadZ3.mkSub - -mkIntArith :: IntOp -> Base.AST -> Base.AST -> Z3 Base.AST -mkIntArith Quot = MonadZ3.mkDiv -mkIntArith Mod = MonadZ3.mkMod -mkIntArith Rem = MonadZ3.mkRem - -mkRealArith :: RealOp -> Base.AST -> Base.AST -> Z3 Base.AST -mkRealArith Div = MonadZ3.mkDiv - diff --git a/Z3/Lang/Monad.hs-boot b/Z3/Lang/Monad.hs-boot deleted file mode 100644 --- a/Z3/Lang/Monad.hs-boot +++ /dev/null @@ -1,10 +0,0 @@ - -module Z3.Lang.Monad - ( Z3 ) - where - -import Control.Monad.State ( StateT ) - -data Z3State - -newtype Z3 a = Z3 (StateT Z3State IO a) diff --git a/Z3/Lang/Nat.hs b/Z3/Lang/Nat.hs deleted file mode 100644 --- a/Z3/Lang/Nat.hs +++ /dev/null @@ -1,138 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} - -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} - -- Imports deprecated modules, but it is a depcrecated module itself. - --- | --- Module : Z3.Lang.Nat --- Copyright : (c) Iago Abal, 2012 --- (c) David Castro, 2012 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro - -module Z3.Lang.Nat - {-# DEPRECATED - "The Z3.Lang interface will be moved to a dedicated package." - #-} - ( Nat ) - where - -import Z3.Monad hiding ( Z3, mkEq, Pattern, evalZ3, evalZ3With ) -import Z3.Lang.Exprs -import Z3.Lang.Monad -import Z3.Lang.Prelude -import Z3.Lang.TY - -import Control.Applicative ( (<$>) ) -import Data.Typeable - --- | This type allows to reason about natural numbers. --- --- Naturals are just integers plus a @(>= 0)@ invariant, and we ensure that --- this invariant is always preserved by transparently adding new assertions --- to the context. --- --- Note that arithmetic on naturals must result in natural numbers, otherwise --- the problem becomes /unsatisfiable/. -newtype Nat = Nat { unNat :: Integer } - deriving (Eq,Ord,Enum,Real,Typeable) - -instance Show Nat where - show = show . unNat - -instance Num Nat where - Nat n + Nat m = Nat $ n + m - Nat n - Nat m - | n >= m = Nat $ n-m - | otherwise = error "Cannot subtract" - Nat n * Nat m = Nat $ n * m - abs = id - signum = Nat . signum . unNat - negate 0 = 0 - negate _ = error "Cannot negate a natural number" - fromInteger n | n >= 0 = Nat n - | otherwise = error "Not a natural number" - -instance Integral Nat where - quotRem (Nat n) (Nat m) = (Nat q,Nat r) - where (q,r) = quotRem n m - toInteger = unNat - -instance Compilable (Expr Nat) where - compile = compileNat - -instance IsTy Nat where - typeInv e = e >=* 0 - tc = tcNat - - mkSort _ = mkIntSort - mkLiteral = mkInt . unNat - getValue v = Nat <$> getInt v - - -instance IsNum Nat where -instance IsInt Nat where - -tcNat :: Expr Nat -> TCM () -tcNat (Lit _) = ok -tcNat (Const _ _) = ok -tcNat (Tag _) = ok -tcNat (Neg e) = do - newTCC [e ==* 0] - tcNat e -tcNat (CRingArith Sub es) = do - newTCC $ zipWith (>=*) (scanl1 (-) es) (tail es) - mapM_ tcNat es -tcNat (CRingArith _op es) = mapM_ tcNat es -tcNat (IntArith _op e1 e2) = do - newTCC [e2 /=* 0] - tcNat e1 - tcNat e2 -tcNat (Ite eb e1 e2) = do - tc eb - withHypo eb $ tcNat e1 - withHypo (Not eb) $ tcNat e2 -tcNat (App _) = ok -tcNat (Cast e) = tc e -tcNat _ = error "Z3.Lang.Nat.tcNat: Panic!\ - \ Impossible constructor in pattern matching!" - -compileNat :: Expr Nat -> Z3 AST -compileNat (Lit a) - = mkLiteral (unNat a) -compileNat (Const _ u) - = return u -compileNat (Tag lyt) - = do ix <- deBruijnIx lyt - srt <- mkSort (TY :: TY Nat) - mkBound ix srt -compileNat (Neg e) - = mkUnaryMinus =<< compileNat e -compileNat (CRingArith op es) - = mkCRingArith op =<< mapM compileNat es -compileNat (IntArith op e1 e2) - = do e1' <- compileNat e1 - e2' <- compileNat e2 - mkIntArith op e1' e2' -compileNat (Ite eb e1 e2) - = do eb' <- compile eb - e1' <- compileNat e1 - e2' <- compileNat e2 - mkIte eb' e1' e2' -compileNat (App e) - = compile e -compileNat (Cast (e :: Expr a)) - = compile e >>= compileCast (TY :: TY (a, Nat)) -compileNat _ - = error "Z3.Lang.Nat.compileNat: Panic!\ - \ Impossible constructor in pattern matching!" - -instance Castable Nat Integer where - compileCast _ = return - diff --git a/Z3/Lang/Pow2.hs b/Z3/Lang/Pow2.hs deleted file mode 100644 --- a/Z3/Lang/Pow2.hs +++ /dev/null @@ -1,48 +0,0 @@ - -{-# LANGUAGE ScopedTypeVariables #-} - --- | --- Module : Z3.Lang.Pow --- Copyright : (c) Iago Abal, 2012 --- (c) David Castro, 2012 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro - -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} - -- Imports deprecated modules, but it is a depcrecated module itself. - --- TODO generalize for x^y -module Z3.Lang.Pow2 - {-# DEPRECATED - "The Z3.Lang interface will be moved to a dedicated package." - #-} - ( declarePow2 ) - where - -import Z3.Lang.Prelude - --- | Raise to the power of 2. --- Axiomatization of the /2^n/ function. --- Most likely Z3 is going to diverge if you use /2^n/ to specify a satisfiable --- problem, since it cannot construct a recursive definition for /2^n/, but it --- should work fine for unsatisfiable instances. -declarePow2 :: IsInt a => Z3 (Expr a -> Expr a) -declarePow2 = do - pow2::Expr a -> Expr a <- fun1 - -- invariants - assert $ forall $ \x -> (x <* 0 ==> pow2 x ==* 0) - `instanceWhen` [Pat $ pow2 x] - assert $ forall $ \x -> (x >=* 0 ==> pow2 x >* 0) - `instanceWhen` [Pat $ pow2 x] - assert $ forall $ \x -> (x >=* 0 ==> pow2 x >* x) - `instanceWhen` [Pat $ pow2 x] - -- base cases - assert $ pow2 0 ==* 1 - assert $ pow2 1 ==* 2 - -- recursive definition - assert $ forall $ \x -> (x >* 1 ==> pow2 x ==* 2 * pow2 (x-1)) - `instanceWhen` [Pat $ pow2 x] - -- and that's it! - return pow2 - diff --git a/Z3/Lang/Prelude.hs b/Z3/Lang/Prelude.hs deleted file mode 100644 --- a/Z3/Lang/Prelude.hs +++ /dev/null @@ -1,723 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE IncoherentInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverlappingInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE UndecidableInstances #-} - --- | --- Module : Z3.Lang.Prelude --- Copyright : (c) Iago Abal, 2012-2013 --- (c) David Castro, 2012-2013 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro --- Stability : experimental - --- TODO: Pretty-printing of expressions - -module Z3.Lang.Prelude - {-# DEPRECATED - "The Z3.Lang interface will be moved to a dedicated package." - #-} - ( -- * Z3 script - Z3 - , Base.Result - , evalZ3 - , Args(..) - , stdArgs - , Logic(..) - , evalZ3With - - -- ** Commands - , var - , namedVar - , fun1, fun2, fun3, fun4, fun5 - , assert - , let_ - , check - , showContext - , exprToString - , push, pop - , getVersion - - -- ** Models - , Model - , checkModel - , checkModelWith - , checkModelWithResult - , showModel - , eval, evalT - - -- * Expressions - , Expr - , Pattern(..) - , IsTy - , IsNum - , IsInt - , IsReal - , Castable - , literal - , true - , false - , not_ - , and_, (&&*) - , or_, (||*) - , distinct - , xor - , implies, (==>) - , iff, (<=>) - , forall - , exists - , instanceWhen - , (//), (%*), (%%) - , divides - , (==*), (/=*) - , (<=*), (<*) - , (>=*), (>*) - , min_, max_ - , ite - , cast - - ) where - --- import Z3.Base ( AST ) -import qualified Z3.Base as Base -import Z3.Monad hiding ( Z3, mkEq, Pattern, Model, evalZ3, evalZ3With, eval, evalT, showModel ) -import qualified Z3.Monad as MonadZ3 -import Z3.Lang.Exprs -import Z3.Lang.Monad -import Z3.Lang.TY - -import Control.Applicative ( Applicative, (<$>) ) -import Control.Monad.Reader ( ReaderT, ask, runReaderT ) -import Control.Monad.Trans ( lift ) -import Data.Traversable ( Traversable ) -import qualified Data.Traversable as T -#if __GLASGOW_HASKELL__ < 704 -import Data.Typeable ( Typeable1(..), typeOf ) -import Unsafe.Coerce ( unsafeCoerce ) -#else -import Data.Typeable ( Typeable1(..) ) -#endif - ---------------------------------------------------------------------- --- Utils - --- | Compile while introducing TCCs into the script. --- -compileWithTCC :: IsTy a => Expr a -> Z3 Base.AST -compileWithTCC e = do - assertCnstr =<< compile (and_ $ typecheck e) - compile e - ---------------------------------------------------------------------- --- Commands - -createVar :: forall a. IsTy a => Uniq -> Symbol -> Z3 (Expr a) -createVar u sym = do - srt <- mkSort (TY :: TY a) - cnst <- mkConst sym srt - let e = Const u cnst - assert $ typeInv e - return e - --- | Declare skolem variables. -var :: IsTy a => Z3 (Expr a) -var = do - u <- fresh - createVar u =<< mkIntSymbol u - --- | Declare skolem variables with a user specified name. -namedVar :: IsTy a => String -> Z3 (Expr a) -namedVar name = do - u <- fresh - createVar u =<< mkStringSymbol (name ++ '/' : show u) - --- | Declare uninterpreted function of arity 1. -fun1 :: (IsTy a, IsTy b) => Z3 (Expr a -> Expr b) -fun1 = do - (fd :: FunApp (a -> b)) <- funDecl - let f e = App $ PApp fd e - assert $ forall $ \a -> typeInv (f a) - return f - --- | Declare uninterpreted function of arity 2. -fun2 :: (IsTy a, IsTy b, IsTy c) => Z3 (Expr a -> Expr b -> Expr c) -fun2 = do - (fd :: FunApp (a -> b -> c)) <- funDecl - let f e1 e2 = App $ PApp (PApp fd e1) e2 - assert $ forall $ \a b -> typeInv (f a b) - return f - - --- | Declare uninterpreted function of arity 3. -fun3 :: (IsTy a, IsTy b, IsTy c, IsTy d) - => Z3 (Expr a -> Expr b -> Expr c -> Expr d) -fun3 = do - (fd :: FunApp (a -> b -> c -> d)) <- funDecl - let f e1 e2 e3 = App $ PApp (PApp (PApp fd e1) e2) e3 - assert $ forall $ \a b c -> typeInv (f a b c) - return f - --- | Declare uninterpreted function of arity 4. -fun4 :: (IsTy a, IsTy b, IsTy c, IsTy d, IsTy e) - => Z3 (Expr a -> Expr b -> Expr c -> Expr d -> Expr e) -fun4 = do - (fd :: FunApp (a -> b -> c -> d -> e)) <- funDecl - let f e1 e2 e3 e4 = App $ PApp (PApp (PApp (PApp fd e1) e2) e3) e4 - assert $ forall $ \a b c d -> typeInv (f a b c d) - return f - --- | Declare uninterpreted function of arity 5. -fun5 :: (IsTy a, IsTy b, IsTy c, IsTy d, IsTy e, IsTy f) - => Z3 (Expr a -> Expr b -> Expr c -> Expr d -> Expr e -> Expr f) -fun5 = do - (fd :: FunApp (a -> b -> c -> d -> e -> f)) <- funDecl - let f e1 e2 e3 e4 e5 = App $ PApp (PApp (PApp (PApp (PApp fd e1) e2) e3) e4) e5 - assert $ forall $ \a b c d e -> typeInv (f a b c d e) - return f - --- | Declare uninterpreted function -funDecl :: forall a. IsFun a => Z3 (FunApp a) -funDecl = do - u <- fresh - smb <- mkIntSymbol u - dom <- domain (TY :: TY a) - rng <- range (TY :: TY a) - fd <- mkFuncDecl smb dom rng - return (FuncDecl fd) - --- | Make assertion in current context. -assert :: Expr Bool -> Z3 () -assert (Lit True) = return () -assert e = compileWithTCC e >>= assertCnstr - --- | Introduce an auxiliary declaration to name a given expression. --- --- If you really want sharing use this instead of Haskell's /let/. -let_ :: IsTy a => Expr a -> Z3 (Expr a) -let_ e@(Lit _) = return e -let_ e@(Const _ _) = return e -let_ e = do - aux <- var - assert (aux ==* e) - return aux - --- | Convert an Expr to a string. -exprToString :: Compilable (Expr a) => Expr a -> Z3 String -exprToString e = - compile e >>= astToString - ----------------------------------------------------------------------- --- Models - --- | A computation derived from a model. -newtype Model a = Model { unModel :: ReaderT Base.Model Z3 a } - deriving (Applicative,Functor,Monad) - --- | Check satisfiability and evaluate a model if some exists. -checkModel :: Model a -> Z3 (Maybe a) -checkModel = checkModelWith (const id) -{-# INLINE checkModel #-} - --- | Check satisfiability and evaluate a model if some exists. -checkModelWith :: (Result -> Maybe a -> b) -> Model a -> Z3 b -checkModelWith f m = uncurry f <$> checkModelWithResult m -{-# INLINE checkModelWith #-} - --- | Check satisfiability and evaluate a model if some exists, also --- returning a 'Result' to the reason for any failure. -checkModelWithResult :: Model a -> Z3 (Result, Maybe a) -checkModelWithResult m = MonadZ3.withModel $ runReaderT (unModel m) - --- | Show Z3's internal model. -showModel :: Model String -showModel = Model $ ask >>= lift . MonadZ3.showModel - --- | Evaluate an expression within a model. -eval :: forall a. IsTy a => Expr a -> Model a -eval e = Model $ do - a <- lift $ compileWithTCC e - lift . fixResult a =<< ask - where fixResult :: Base.AST -> Base.Model -> Z3 a - fixResult a m = peek =<< MonadZ3.eval m a - - peek :: Maybe Base.AST -> Z3 a - peek (Just a) = getValue a - peek Nothing = error "Z3.Lang.Prelude.eval: quantified expression or partial model!" - --- | Evaluate a collection of expressions within a model. -evalT :: (IsTy a,Traversable t) => t (Expr a) -> Model (t a) -evalT = T.traverse eval - ----------------------------------------------------------------------- --- Expressions - -deriving instance Typeable1 Expr - --- In GHC 7.4 Eq and Show are no longer superclasses of Num -#if __GLASGOW_HASKELL__ < 704 -deriving instance Show (FunApp a) -deriving instance Show (Expr a) - -instance Eq (Expr a) where - _e1 == _e2 = error "Z3.Lang.Expr: equality not supported" -#endif - -instance IsNum a => Num (Expr a) where - (CRingArith Add as) + (CRingArith Add bs) = CRingArith Add (as ++ bs) - (CRingArith Add as) + b = CRingArith Add (b:as) - a + (CRingArith Add bs) = CRingArith Add (a:bs) - a + b = CRingArith Add [a,b] - (CRingArith Mul as) * (CRingArith Mul bs) = CRingArith Mul (as ++ bs) - (CRingArith Mul as) * b = CRingArith Mul (b:as) - a * (CRingArith Mul bs) = CRingArith Mul (a:bs) - a * b = CRingArith Mul [a,b] - (CRingArith Sub as) - b = CRingArith Sub (as ++ [b]) - a - b = CRingArith Sub [a,b] - negate (CRingArith Sub [a,b]) = CRingArith Sub [b,a] - negate t = Neg t - abs e = ite (e >=* 0) e (-e) - signum e = ite (e >* 0) 1 (ite (e ==* 0) 0 (-1)) - fromInteger = literal . fromInteger - -instance IsReal a => Fractional (Expr a) where - (/) = RealArith Div - fromRational = literal . fromRational - -infixl 7 //, %*, %% -infix 4 ==*, /=*, <*, <=*, >=*, >* -infixr 3 &&*, ||*, `xor` -infixr 2 `implies`, `iff`, ==>, <=> - --- | /literal/ constructor. -literal :: IsTy a => a -> Expr a -literal = Lit - --- | Boolean literals. -true, false :: Expr Bool -true = Lit True -false = Lit False - --- | Boolean negation -not_ :: Expr Bool -> Expr Bool -not_ = Not - --- | Boolean binary /xor/. -xor :: Expr Bool -> Expr Bool -> Expr Bool -xor = BoolBin Xor - --- | Boolean implication -implies :: Expr Bool -> Expr Bool -> Expr Bool -p `implies` (BoolBin Implies q r) - = (p &&* q) `implies` r -p `implies` q = BoolBin Implies p q - --- | An alias for 'implies'. -(==>) :: Expr Bool -> Expr Bool -> Expr Bool -(==>) = implies - --- | Boolean /if and only if/. -iff :: Expr Bool -> Expr Bool -> Expr Bool -iff = BoolBin Iff - --- | An alias for 'iff'. -(<=>) :: Expr Bool -> Expr Bool -> Expr Bool -(<=>) = iff - --- | Boolean variadic /and/. -and_ :: [Expr Bool] -> Expr Bool -and_ [] = true -and_ bs = BoolMulti And bs - --- | Boolean variadic /or/. -or_ :: [Expr Bool] -> Expr Bool -or_ [] = false -or_ bs = BoolMulti Or bs - --- | Boolean variadic /distinct/. -distinct :: IsTy a => [Expr a] -> Expr Bool -distinct [] = true -distinct bs = CmpE Distinct bs - --- | Boolean binary /and/. -(&&*) :: Expr Bool -> Expr Bool -> Expr Bool -(BoolMulti And ps) &&* (BoolMulti And qs) = and_ (ps ++ qs) -(BoolMulti And ps) &&* q = and_ (q:ps) -p &&* (BoolMulti And qs) = and_ (p:qs) -p &&* q = and_ [p,q] - --- | Boolean binary /or/. -(||*) :: Expr Bool -> Expr Bool -> Expr Bool -(BoolMulti Or ps) ||* (BoolMulti Or qs) = or_ (ps ++ qs) -(BoolMulti Or ps) ||* q = or_ (q:ps) -p ||* (BoolMulti Or qs) = or_ (p:qs) -p ||* q = or_ [p,q] - --- | Universally quantified formula. -forall :: QExpr t => t -> Expr Bool -forall f = Quant ForAll f - --- | Existentially quantified formula. -exists :: QExpr t => t -> Expr Bool -exists f = Quant Exists f - --- | Pattern-based instantiation. -instanceWhen :: Expr Bool -> [Pattern] -> QBody -instanceWhen = QBody - --- | Casting between compatible types --- - -cast :: (IsTy a, IsTy b, Castable a b) => Expr a -> Expr b -cast = Cast - -instance Castable Integer Rational where - compileCast _ = mkInt2Real - -instance Castable Rational Integer where - compileCast _ = mkReal2Int - - --- | Integer division. -(//) :: IsInt a => Expr a -> Expr a -> Expr a -(//) = IntArith Quot - --- | Integer modulo. -(%*) :: IsInt a => Expr a -> Expr a -> Expr a -(%*) = IntArith Mod - --- | Integer remainder. -(%%) :: IsInt a => Expr a -> Expr a -> Expr a -(%%) = IntArith Rem - --- | @k `divides` n == n %* k ==* 0@ -divides :: IsInt a => Expr a -> Expr a -> Expr Bool -k `divides` n = n %* k ==* 0 -{-# INLINE divides #-} - --- | Equals. -(==*) :: IsTy a => Expr a -> Expr a -> Expr Bool -e1 ==* e2 = CmpE Eq [e1,e2] - --- | Not equals. -(/=*) :: IsTy a => Expr a -> Expr a -> Expr Bool -e1 /=* e2 = CmpE Distinct [e1,e2] - --- | Less or equals than. -(<=*) :: IsNum a => Expr a -> Expr a -> Expr Bool -(<=*) = CmpI Le - --- | Less than. -(<*) :: IsNum a => Expr a -> Expr a -> Expr Bool -(<*) = CmpI Lt - --- | Greater or equals than. -(>=*) :: IsNum a => Expr a -> Expr a -> Expr Bool -(>=*) = CmpI Ge - --- | Greater than. -(>*) :: IsNum a => Expr a -> Expr a -> Expr Bool -(>*) = CmpI Gt - --- | Minimum. -min_ :: IsNum a => Expr a -> Expr a -> Expr a -min_ x y = ite (x <=* y) x y - --- | Maximum. -max_ :: IsNum a => Expr a -> Expr a -> Expr a -max_ x y = ite (x >=* y) x y - --- | /if-then-else/. -ite :: IsTy a => Expr Bool -> Expr a -> Expr a -> Expr a -ite = Ite - ----------------------------------------------------------------------- --- Booleans - -instance Compilable (Expr Bool) where - compile = compileBool - -instance IsTy Bool where - typeInv = const true - tc = tcBool - - mkSort _ = mkBoolSort - getValue v = maybe False id <$> getBool v - mkLiteral True = mkTrue - mkLiteral False = mkFalse - -tcBool :: Expr Bool -> TCM () -tcBool (Lit _) = ok -tcBool (Const _ _) = ok -tcBool (Tag _) = ok -tcBool (Not b) = tcBool b -tcBool (BoolBin Implies e1 e2) = do - tcBool e1 - withHypo e1 $ tcBool e2 -tcBool (BoolBin _op e1 e2) = do - tcBool e1 - tcBool e2 -tcBool (BoolMulti _op es) = mapM_ tcBool es -tcBool (Quant _q _f) = ok -tcBool (CmpE _op es) = do - mapM_ tc es -tcBool (CmpI _op e1 e2) = do - tc e1 - tc e2 -tcBool (Ite eb e1 e2) = do - tcBool eb - withHypo eb $ tcBool e1 - withHypo (Not eb) $ tcBool e2 -tcBool (App _app) = ok -tcBool (Cast e) = tc e -tcBool _ - = error "Z3.Lang.Prelude.tcBool: Panic! Impossible constructor in pattern matching!" - -compileBool :: Expr Bool -> Z3 AST -compileBool (Lit a) - = mkLiteral a -compileBool (Const _ u) - = return u -compileBool (Tag lyt) - = do ix <- deBruijnIx lyt - srt <- mkSort (TY :: TY Bool) - mkBound ix srt -compileBool (Not b) - = do b' <- compileBool b - mkNot b' -compileBool (BoolBin op e1 e2) - = do e1' <- compileBool e1 - e2' <- compileBool e2 - mkBoolBin op e1' e2' -compileBool (BoolMulti op es) - = do es' <- mapM compileBool es - mkBoolMulti op es' -compileBool (Quant q f) - = compileQuant q [] [] f -compileBool (CmpE op es) - = do es' <- mapM compile es - mkEq op es' -compileBool (CmpI op e1 e2) - = do e1' <- compile e1 - e2' <- compile e2 - mkCmp op e1' e2' -compileBool (Ite b e1 e2) - = do b' <- compileBool b - e1' <- compileBool e1 - e2' <- compileBool e2 - mkIte b' e1' e2' -compileBool (App e) - = compile e -compileBool (Cast (e :: Expr a)) - = compile e >>= compileCast (TY :: TY (a, Bool)) -compileBool _ - = error "Z3.Lang.Prelude.compileBool: Panic! Impossible constructor in pattern matching!" - -withSortedSymbol :: IsTy a => TY a -> (Base.Symbol -> Base.Sort -> Z3 b) -> Z3 b -withSortedSymbol t f = do - u <- fresh - sx <- mkIntSymbol u - srt <- mkSort t - f sx srt - -instance IsTy a => QExpr (Expr a -> Expr Bool) where - compileQuant q smbs srts f = do - withSortedSymbol (TY :: TY a) $ \sx srt -> - newQLayout $ \x -> do - body <- compileBool $ mkBody q x - mkQuant q [] (sx:smbs) (srt:srts) body - where mkBody ForAll x = let b = f x in and_ (typeInv x:typecheck b) ==> b - mkBody Exists x = let b = f x in and_ (b:typeInv x:typecheck b) - -data QBody = QBody (Expr Bool) [Pattern] - -instance IsTy a => QExpr (Expr a -> QBody) where - compileQuant q smbs srts f = do - withSortedSymbol (TY :: TY a) $ \sx srt -> - newQLayout $ \x -> do - let QBody body pats = mapFst (mkBody q x) (f x) - astbody <- compileBool body - pat_lst <- mkPat pats - mkQuant q pat_lst (sx:smbs) (srt:srts) astbody - where mkBody ForAll x b = and_ (typeInv x:typecheck b) ==> b - mkBody Exists x b = and_ (b:typeInv x:typecheck b) - mkPat [] = return [] - mkPat lst = mapM compile lst >>= \args -> (:[]) <$> mkPattern args - mapFst mf (QBody a b) = QBody (mf a) b - -instance (IsTy a, QExpr t) => QExpr (Expr a -> t) where - compileQuant q smbs srts f = - withSortedSymbol (TY :: TY a) $ \sx srt -> - newQLayout $ \x -> - compileQuant q (sx:smbs) (srt:srts) (f x) - ----------------------------------------------------------------------- --- Integers - -instance Compilable (Expr Integer) where - compile = compileInteger - -instance IsTy Integer where - typeInv = const true - tc = tcInteger - - mkSort _ = mkIntSort - getValue = getInt - mkLiteral = mkInt - -instance IsNum Integer where -instance IsInt Integer where - -tcInteger :: Expr Integer -> TCM () -tcInteger (Lit _) = ok -tcInteger (Const _ _) = ok -tcInteger (Tag _) = ok -tcInteger (Neg e) = tcInteger e -tcInteger (CRingArith _op es) = mapM_ tcInteger es -tcInteger (IntArith _op e1 e2) = do - newTCC [e2 /=* 0] - tcInteger e1 - tcInteger e2 -tcInteger (Ite eb e1 e2) = do - tc eb - withHypo eb $ tcInteger e1 - withHypo (Not eb) $ tcInteger e2 -tcInteger (App _) = ok -tcInteger (Cast e) = tc e -tcInteger _ - = error "Z3.Lang.Prelude.tcInteger: Panic! Impossible constructor in pattern matching!" - -compileInteger :: Expr Integer -> Z3 AST -compileInteger (Lit a) - = mkLiteral a -compileInteger (Const _ u) - = return u -compileInteger (Tag lyt) - = do ix <- deBruijnIx lyt - srt <- mkSort (TY :: TY Integer) - mkBound ix srt -compileInteger (Neg e) - = mkUnaryMinus =<< compileInteger e -compileInteger (CRingArith op es) - = mkCRingArith op =<< mapM compileInteger es -compileInteger (IntArith op e1 e2) - = do e1' <- compileInteger e1 - e2' <- compileInteger e2 - mkIntArith op e1' e2' -compileInteger (Ite eb e1 e2) - = do eb' <- compile eb - e1' <- compileInteger e1 - e2' <- compileInteger e2 - mkIte eb' e1' e2' -compileInteger (App e) - = compile e -compileInteger (Cast (e :: Expr a)) - = compile e >>= compileCast (TY :: TY (a, Integer)) -compileInteger _ - = error "Z3.Lang.Prelude.compileInteger: Panic! Impossible constructor in pattern matching!" - ----------------------------------------------------------------------- --- Rationals - -instance Compilable (Expr Rational) where - compile = compileRational - -instance IsTy Rational where - typeInv = const true - tc = tcRational - - mkSort _ = mkRealSort - getValue = getReal - mkLiteral = mkReal - -instance IsNum Rational where -instance IsReal Rational where - -tcRational :: Expr Rational -> TCM () -tcRational (Lit _) = ok -tcRational (Const _ _) = ok -tcRational (Tag _) = ok -tcRational (Neg e) = tcRational e -tcRational (CRingArith _op es) = mapM_ tcRational es -tcRational (RealArith Div e1 e2) = do - newTCC [e2 /=* 0] - tcRational e1 - tcRational e2 -tcRational (Ite eb e1 e2) = do - tc eb - withHypo eb $ tcRational e1 - withHypo (Not eb) $ tcRational e2 -tcRational (App _) = ok -tcRational (Cast e) = tc e -tcRational _ - = error "Z3.Lang.Prelude.tcRational: Panic! Impossible constructor in pattern matching!" - -compileRational :: Expr Rational -> Z3 AST -compileRational (Lit a) - = mkLiteral a -compileRational (Const _ u) - = return u -compileRational (Tag lyt) - = do ix <- deBruijnIx lyt - srt <- mkSort (TY :: TY Rational) - mkBound ix srt -compileRational (Neg e) - = mkUnaryMinus =<< compileRational e -compileRational (CRingArith op es) - = mkCRingArith op =<< mapM compileRational es -compileRational (RealArith op@Div e1 e2) - = do e1' <- compileRational e1 - e2' <- compileRational e2 - mkRealArith op e1' e2' -compileRational (Ite eb e1 e2) - = do eb' <- compile eb - e1' <- compileRational e1 - e2' <- compileRational e2 - mkIte eb' e1' e2' -compileRational (App e) - = compile e -compileRational (Cast (e :: Expr a)) - = compile e >>= compileCast (TY :: TY (a, Rational)) -compileRational _ - = error "Z3.Lang.Prelude.compileRational: Panic! Impossible constructor in pattern matching!" - ----------------------------------------------------------------------- --- Functions - -instance (IsTy a, IsTy b) => IsFun (a -> b) where - domain _ = (: []) <$> mkSort (TY :: TY a) - range _ = mkSort (TY :: TY b) -instance (IsTy a, IsFun (b -> c)) => IsFun (a -> b -> c) where - domain _ = do - srt <- mkSort (TY :: TY a) - lst <- domain (TY :: TY (b -> c)) - return (srt : lst) - range _ = range (TY :: TY (b -> c)) - -instance IsTy a => Compilable (FunApp a) where - compile = app2AST - -app2AST :: IsTy a => FunApp a -> Z3 Base.AST -app2AST f = doApp2AST f [] - where doApp2AST :: FunApp t -> [Base.AST] -> Z3 Base.AST - doApp2AST (FuncDecl fd) acc = mkApp fd acc - doApp2AST (PApp e1 e2) acc = compile e2 >>= doApp2AST e1 . (: acc) - ----------------------------------------------------------------------- --- Patterns - -instance Compilable Pattern where - compile (Pat e) = compile e - diff --git a/Z3/Lang/TY.hs b/Z3/Lang/TY.hs deleted file mode 100644 --- a/Z3/Lang/TY.hs +++ /dev/null @@ -1,22 +0,0 @@ - -{-# LANGUAGE DeriveDataTypeable #-} - --- | --- Module : Z3.Lang.TY --- Copyright : (c) Iago Abal, 2012 --- (c) David Castro, 2012 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro - -module Z3.Lang.TY where - - -import Data.Data ( Data, Typeable ) - - --- | An alternative to 'undefined' to fake type parameters. --- --- Example: @TY :: TY Integer@ instead of @undefined :: Integer@ -data TY a = TY - deriving (Data,Typeable) diff --git a/Z3/Monad.hs b/Z3/Monad.hs deleted file mode 100644 --- a/Z3/Monad.hs +++ /dev/null @@ -1,1212 +0,0 @@ - -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} - -- This is just to avoid warnings because we import fragile new Z3 API stuff - -- from Z3.Base - --- TODO: Error handling - --- | --- Module : Z3.Monad --- Copyright : (c) Iago Abal, 2013 --- (c) David Castro, 2013 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro --- --- A simple monadic wrapper for 'Z3.Base'. - -module Z3.Monad - ( -- * Z3 monad - MonadZ3(..) - , Z3 - , module Z3.Opts - , Logic(..) - , evalZ3 - , evalZ3With - -- ** Z3 enviroments - , Z3Env - , newEnv - , delEnv - , evalZ3WithEnv - - -- * Types - , Symbol - , AST - , Sort - , FuncDecl - , App - , Pattern - , Model - , Base.Context - , FuncInterp - , FuncEntry - , FuncModel(..) - , Base.Solver - - -- ** Satisfiability result - , Result(..) - - -- * Context - , contextToString - , showContext - - -- * Symbols - , mkIntSymbol - , mkStringSymbol - - -- * Sorts - , mkUninterpretedSort - , mkBoolSort - , mkIntSort - , mkRealSort - , mkBvSort - , mkArraySort - , mkTupleSort - - -- * Constants and Applications - , mkFuncDecl - , mkApp - , mkConst - , mkTrue - , mkFalse - , mkEq - , mkNot - , mkIte - , mkIff - , mkImplies - , mkXor - , mkAnd - , mkOr - , mkDistinct - , mkAdd - , mkMul - , mkSub - , mkUnaryMinus - , mkDiv - , mkMod - , mkRem - , mkLt - , mkLe - , mkGt - , mkGe - , mkInt2Real - , mkReal2Int - , mkIsInt - - -- * Bit-vectors - , mkBvnot - , mkBvredand - , mkBvredor - , mkBvand - , mkBvor - , mkBvxor - , mkBvnand - , mkBvnor - , mkBvxnor - , mkBvneg - , mkBvadd - , mkBvsub - , mkBvmul - , mkBvudiv - , mkBvsdiv - , mkBvurem - , mkBvsrem - , mkBvsmod - , mkBvult - , mkBvslt - , mkBvule - , mkBvsle - , mkBvuge - , mkBvsge - , mkBvugt - , mkBvsgt - , mkConcat - , mkExtract - , mkSignExt - , mkZeroExt - , mkRepeat - , mkBvshl - , mkBvlshr - , mkBvashr - , mkRotateLeft - , mkRotateRight - , mkExtRotateLeft - , mkExtRotateRight - , mkInt2bv - , mkBv2int - , mkBvnegNoOverflow - , mkBvaddNoOverflow - , mkBvaddNoUnderflow - , mkBvsubNoOverflow - , mkBvsubNoUnderflow - , mkBvmulNoOverflow - , mkBvmulNoUnderflow - , mkBvsdivNoOverflow - - -- * Arrays - , mkSelect - , mkStore - , mkConstArray - , mkMap - , mkArrayDefault - - -- * Numerals - , mkNumeral - , mkInt - , mkReal - - -- * Quantifiers - , mkPattern - , mkBound - , mkForall - , mkExists - , mkForallConst - , mkExistsConst - - -- * Accessors - , getBvSortSize - , getBool - , getInt - , getReal - , toApp - - -- * Models - , eval - , evalT - , evalFunc - , evalArray - , getFuncInterp - , isAsArray - , getAsArrayFuncDecl - , funcInterpGetNumEntries - , funcInterpGetEntry - , funcInterpGetElse - , funcInterpGetArity - , funcEntryGetValue - , funcEntryGetNumArgs - , funcEntryGetArg - , modelToString - , showModel - - -- * Constraints - , assertCnstr - , check - , getModel - , delModel - , withModel - , push - , pop - , local - , reset - , getNumScopes - - -- * String Conversion - , ASTPrintMode(..) - , setASTPrintMode - , astToString - , patternToString - , sortToString - , funcDeclToString - , solverToString - , benchmarkToSMTLibString - - -- * Miscellaneous - , Version(..) - , getVersion - ) - where - -import Z3.Opts -import Z3.Base - ( Symbol - , AST - , Sort - , FuncDecl - , App - , Pattern - , Model - , FuncInterp - , FuncEntry - , FuncModel(..) - , Result(..) - , Logic(..) - , ASTPrintMode(..) - , Version(..) - ) -import qualified Z3.Base as Base - -import Control.Applicative ( Applicative ) -import qualified Control.Exception as E -import Control.Monad ( void ) -import Control.Monad.Reader ( ReaderT, runReaderT, asks ) -import Control.Monad.Trans ( MonadIO, liftIO ) -import Data.Traversable ( Traversable ) -import qualified Data.Traversable as T - ---------------------------------------------------------------------- --- The Z3 monad-class - -class (Monad m, MonadIO m) => MonadZ3 m where - getSolver :: m (Maybe Base.Solver) - getContext :: m Base.Context - -------------------------------------------------- --- Lifting - -liftScalar :: MonadZ3 z3 => (Base.Context -> IO b) -> z3 b -liftScalar f = liftIO . f =<< getContext - -liftFun1 :: MonadZ3 z3 => (Base.Context -> a -> IO b) -> a -> z3 b -liftFun1 f a = getContext >>= \ctx -> liftIO (f ctx a) - -liftFun2 :: MonadZ3 z3 => (Base.Context -> a -> b -> IO c) -> a -> b -> z3 c -liftFun2 f a b = getContext >>= \ctx -> liftIO (f ctx a b) - -liftFun3 :: MonadZ3 z3 => (Base.Context -> a -> b -> c -> IO d) - -> a -> b -> c -> z3 d -liftFun3 f a b c = getContext >>= \ctx -> liftIO (f ctx a b c) - -liftFun4 :: MonadZ3 z3 => (Base.Context -> a -> b -> c -> d -> IO e) - -> a -> b -> c -> d -> z3 e -liftFun4 f a b c d = getContext >>= \ctx -> liftIO (f ctx a b c d) - -liftFun6 :: MonadZ3 z3 => - (Base.Context -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> IO b) - -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> z3 b -liftFun6 f x1 x2 x3 x4 x5 x6 = - getContext >>= \ctx -> liftIO (f ctx x1 x2 x3 x4 x5 x6) - -liftSolver0 :: MonadZ3 z3 => - (Base.Context -> Base.Solver -> IO b) - -> (Base.Context -> IO b) - -> z3 b -liftSolver0 f_s f_no_s = - do ctx <- getContext - liftIO . maybe (f_no_s ctx) (f_s ctx) =<< getSolver - -liftSolver1 :: MonadZ3 z3 => - (Base.Context -> Base.Solver -> a -> IO b) - -> (Base.Context -> a -> IO b) - -> a -> z3 b -liftSolver1 f_s f_no_s a = - do ctx <- getContext - liftIO . maybe (f_no_s ctx a) (\s -> f_s ctx s a) =<< getSolver - -------------------------------------------------- --- A simple Z3 monad. - -newtype Z3 a = Z3 { _unZ3 :: ReaderT Z3Env IO a } - deriving (Functor, Applicative, Monad, MonadIO) - --- | Z3 environment. -data Z3Env - = Z3Env { - envSolver :: Maybe Base.Solver - , envContext :: Base.Context - } - -instance MonadZ3 Z3 where - getSolver = Z3 $ asks envSolver - getContext = Z3 $ asks envContext - --- | Eval a Z3 script. -evalZ3With :: Maybe Logic -> Opts -> Z3 a -> IO a -evalZ3With mbLogic opts (Z3 s) = - E.bracket (newEnv mbLogic opts) delEnv $ runReaderT s - --- | Eval a Z3 script with default configuration options. -evalZ3 :: Z3 a -> IO a -evalZ3 = evalZ3With Nothing stdOpts - --- | Create a new Z3 environment. --- --- Until we move to Z3 API 4.0 you need to manually freed this --- environment using 'delEnv'. -newEnv :: Maybe Logic -> Opts -> IO Z3Env -newEnv mbLogic opts = - Base.withConfig $ \cfg -> do - setOpts cfg opts - ctx <- Base.mkContext cfg - mbSolver <- T.mapM (Base.mkSolverForLogic ctx) mbLogic - return $ Z3Env mbSolver ctx - --- | Free a Z3 environment. -delEnv :: Z3Env -> IO () -delEnv = Base.delContext . envContext - --- | Eval a Z3 script with a given environment. --- --- Environments may facilitate running many queries under the same --- logical context. --- --- Note that an environment may change after each query. --- If you want to preserve the same environment then use 'local', as in --- @evalZ3WithEnv /env/ (local /query/)@. -evalZ3WithEnv :: Z3 a - -> Z3Env - -> IO a -evalZ3WithEnv (Z3 s) = runReaderT s - ---------------------------------------------------------------------- --- Contexts - --- | Convert Z3's logical context into a string. -contextToString :: MonadZ3 z3 => z3 String -contextToString = liftScalar Base.contextToString - --- | Alias for 'contextToString'. -showContext :: MonadZ3 z3 => z3 String -showContext = contextToString - ---------------------------------------------------------------------- --- Symbols - --- | Create a Z3 symbol using an integer. -mkIntSymbol :: (MonadZ3 z3, Integral i) => i -> z3 Symbol -mkIntSymbol = liftFun1 Base.mkIntSymbol - --- | Create a Z3 symbol using a string. --- --- Reference: -mkStringSymbol :: MonadZ3 z3 => String -> z3 Symbol -mkStringSymbol = liftFun1 Base.mkStringSymbol - ---------------------------------------------------------------------- --- Sorts - --- | Create a free (uninterpreted) type using the given name (symbol). --- --- Reference: -mkUninterpretedSort :: MonadZ3 z3 => Symbol -> z3 Sort -mkUninterpretedSort = liftFun1 Base.mkUninterpretedSort - --- | Create the /boolean/ type. --- --- Reference: -mkBoolSort :: MonadZ3 z3 => z3 Sort -mkBoolSort = liftScalar Base.mkBoolSort - --- | Create the /integer/ type. --- --- Reference: -mkIntSort :: MonadZ3 z3 => z3 Sort -mkIntSort = liftScalar Base.mkIntSort - --- | Create the /real/ type. --- --- Reference: -mkRealSort :: MonadZ3 z3 => z3 Sort -mkRealSort = liftScalar Base.mkRealSort - --- | Create a bit-vector type of the given size. --- --- This type can also be seen as a machine integer. --- --- Reference: -mkBvSort :: MonadZ3 z3 => Int -> z3 Sort -mkBvSort = liftFun1 Base.mkBvSort - --- | Create an array type --- --- Reference: --- -mkArraySort :: MonadZ3 z3 => Sort -> Sort -> z3 Sort -mkArraySort = liftFun2 Base.mkArraySort - --- | Create a tuple type --- --- Reference: -mkTupleSort :: MonadZ3 z3 - => Symbol -- ^ Name of the sort - -> [(Symbol, Sort)] -- ^ Name and sort of each field - -> z3 (Sort, FuncDecl, [FuncDecl]) -- ^ Resulting sort, and function - -- declarations for the - -- constructor and projections. -mkTupleSort = liftFun2 Base.mkTupleSort - ---------------------------------------------------------------------- --- Constants and Applications - --- | A Z3 function -mkFuncDecl :: MonadZ3 z3 => Symbol -> [Sort] -> Sort -> z3 FuncDecl -mkFuncDecl = liftFun3 Base.mkFuncDecl - --- | Create a constant or function application. --- --- Reference: -mkApp :: MonadZ3 z3 => FuncDecl -> [AST] -> z3 AST -mkApp = liftFun2 Base.mkApp - --- | Declare and create a constant. --- --- Reference: -mkConst :: MonadZ3 z3 => Symbol -> Sort -> z3 AST -mkConst = liftFun2 Base.mkConst - --- | Create an AST node representing /true/. --- --- Reference: -mkTrue :: MonadZ3 z3 => z3 AST -mkTrue = liftScalar Base.mkTrue - --- | Create an AST node representing /false/. --- --- Reference: -mkFalse :: MonadZ3 z3 => z3 AST -mkFalse = liftScalar Base.mkFalse - --- | Create an AST node representing /l = r/. --- --- Reference: -mkEq :: MonadZ3 z3 => AST -> AST -> z3 AST -mkEq = liftFun2 Base.mkEq - --- | The distinct construct is used for declaring the arguments pairwise --- distinct. --- --- Reference: -mkDistinct :: MonadZ3 z3 => [AST] -> z3 AST -mkDistinct = liftFun1 Base.mkDistinct - --- | Create an AST node representing /not(a)/. --- --- Reference: -mkNot :: MonadZ3 z3 => AST -> z3 AST -mkNot = liftFun1 Base.mkNot - --- | Create an AST node representing an if-then-else: /ite(t1, t2, t3)/. --- --- Reference: -mkIte :: MonadZ3 z3 => AST -> AST -> AST -> z3 AST -mkIte = liftFun3 Base.mkIte - --- | Create an AST node representing /t1 iff t2/. --- --- Reference: -mkIff :: MonadZ3 z3 => AST -> AST -> z3 AST -mkIff = liftFun2 Base.mkIff - --- | Create an AST node representing /t1 implies t2/. --- --- Reference: -mkImplies :: MonadZ3 z3 => AST -> AST -> z3 AST -mkImplies = liftFun2 Base.mkImplies - --- | Create an AST node representing /t1 xor t2/. --- --- Reference: -mkXor :: MonadZ3 z3 => AST -> AST -> z3 AST -mkXor = liftFun2 Base.mkXor - --- | Create an AST node representing args[0] and ... and args[num_args-1]. --- --- Reference: -mkAnd :: MonadZ3 z3 => [AST] -> z3 AST -mkAnd = liftFun1 Base.mkAnd - --- | Create an AST node representing args[0] or ... or args[num_args-1]. --- --- Reference: -mkOr :: MonadZ3 z3 => [AST] -> z3 AST -mkOr = liftFun1 Base.mkOr - --- | Create an AST node representing args[0] + ... + args[num_args-1]. --- --- Reference: -mkAdd :: MonadZ3 z3 => [AST] -> z3 AST -mkAdd = liftFun1 Base.mkAdd - --- | Create an AST node representing args[0] * ... * args[num_args-1]. --- --- Reference: -mkMul :: MonadZ3 z3 => [AST] -> z3 AST -mkMul = liftFun1 Base.mkMul - --- | Create an AST node representing args[0] - ... - args[num_args - 1]. --- --- Reference: -mkSub :: MonadZ3 z3 => [AST] -> z3 AST -mkSub = liftFun1 Base.mkSub - --- | Create an AST node representing -arg. --- --- Reference: -mkUnaryMinus :: MonadZ3 z3 => AST -> z3 AST -mkUnaryMinus = liftFun1 Base.mkUnaryMinus - --- | Create an AST node representing arg1 div arg2. --- --- Reference: -mkDiv :: MonadZ3 z3 => AST -> AST -> z3 AST -mkDiv = liftFun2 Base.mkDiv - --- | Create an AST node representing arg1 mod arg2. --- --- Reference: -mkMod :: MonadZ3 z3 => AST -> AST -> z3 AST -mkMod = liftFun2 Base.mkMod - --- | Create an AST node representing arg1 rem arg2. --- --- Reference: -mkRem :: MonadZ3 z3 => AST -> AST -> z3 AST -mkRem = liftFun2 Base.mkRem - --- | Create less than. --- --- Reference: -mkLt :: MonadZ3 z3 => AST -> AST -> z3 AST -mkLt = liftFun2 Base.mkLt - --- | Create less than or equal to. --- --- Reference: -mkLe :: MonadZ3 z3 => AST -> AST -> z3 AST -mkLe = liftFun2 Base.mkLe - --- | Create greater than. --- --- Reference: -mkGt :: MonadZ3 z3 => AST -> AST -> z3 AST -mkGt = liftFun2 Base.mkGt - --- | Create greater than or equal to. --- --- Reference: -mkGe :: MonadZ3 z3 => AST -> AST -> z3 AST -mkGe = liftFun2 Base.mkGe - --- | Coerce an integer to a real. --- --- Reference: -mkInt2Real :: MonadZ3 z3 => AST -> z3 AST -mkInt2Real = liftFun1 Base.mkInt2Real - --- | Coerce a real to an integer. --- --- Reference: -mkReal2Int :: MonadZ3 z3 => AST -> z3 AST -mkReal2Int = liftFun1 Base.mkReal2Int - --- | Check if a real number is an integer. --- --- Reference: -mkIsInt :: MonadZ3 z3 => AST -> z3 AST -mkIsInt = liftFun1 Base.mkIsInt - ---------------------------------------------------------------------- --- Bit-vectors - --- | Bitwise negation. --- --- Reference: -mkBvnot :: MonadZ3 z3 => AST -> z3 AST -mkBvnot = liftFun1 Base.mkBvnot - --- | Take conjunction of bits in vector, return vector of length 1. --- --- Reference: -mkBvredand :: MonadZ3 z3 => AST -> z3 AST -mkBvredand = liftFun1 Base.mkBvredand - --- | Take disjunction of bits in vector, return vector of length 1. --- --- Reference: -mkBvredor :: MonadZ3 z3 => AST -> z3 AST -mkBvredor = liftFun1 Base.mkBvredor - --- | Bitwise and. --- --- Reference: -mkBvand :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvand = liftFun2 Base.mkBvand - --- | Bitwise or. --- --- Reference: -mkBvor :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvor = liftFun2 Base.mkBvor - --- | Bitwise exclusive-or. --- --- Reference: -mkBvxor :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvxor = liftFun2 Base.mkBvxor - --- | Bitwise nand. --- --- Reference: -mkBvnand :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvnand = liftFun2 Base.mkBvnand - --- | Bitwise nor. --- --- Reference: -mkBvnor :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvnor = liftFun2 Base.mkBvnor - --- | Bitwise xnor. --- --- Reference: -mkBvxnor :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvxnor = liftFun2 Base.mkBvxnor - --- | Standard two's complement unary minus. --- --- Reference: AST -> z3 AST -mkBvneg = liftFun1 Base.mkBvneg - --- | Standard two's complement addition. --- --- Reference: -mkBvadd :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvadd = liftFun2 Base.mkBvadd - --- | Standard two's complement subtraction. --- --- Reference: -mkBvsub :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsub = liftFun2 Base.mkBvsub - --- | Standard two's complement multiplication. --- --- Reference: -mkBvmul :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvmul = liftFun2 Base.mkBvmul - --- | Unsigned division. --- --- Reference: -mkBvudiv :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvudiv = liftFun2 Base.mkBvudiv - --- | Two's complement signed division. --- --- Reference: -mkBvsdiv :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsdiv = liftFun2 Base.mkBvsdiv - --- | Unsigned remainder. --- --- Reference: -mkBvurem :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvurem = liftFun2 Base.mkBvurem - --- | Two's complement signed remainder (sign follows dividend). --- --- Reference: -mkBvsrem :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsrem = liftFun2 Base.mkBvsrem - --- | Two's complement signed remainder (sign follows divisor). --- --- Reference: -mkBvsmod :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsmod = liftFun2 Base.mkBvsmod - --- | Unsigned less than. --- --- Reference: -mkBvult :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvult = liftFun2 Base.mkBvult - --- | Two's complement signed less than. --- --- Reference: -mkBvslt :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvslt = liftFun2 Base.mkBvslt - --- | Unsigned less than or equal to. --- --- Reference: -mkBvule :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvule = liftFun2 Base.mkBvule - --- | Two's complement signed less than or equal to. --- --- Reference: -mkBvsle :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsle = liftFun2 Base.mkBvsle - --- | Unsigned greater than or equal to. --- --- Reference: -mkBvuge :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvuge = liftFun2 Base.mkBvuge - --- | Two's complement signed greater than or equal to. --- --- Reference: -mkBvsge :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsge = liftFun2 Base.mkBvsge - --- | Unsigned greater than. --- --- Reference: -mkBvugt :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvugt = liftFun2 Base.mkBvugt - --- | Two's complement signed greater than. --- --- Reference: -mkBvsgt :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsgt = liftFun2 Base.mkBvsgt - --- | Concatenate the given bit-vectors. --- --- Reference: -mkConcat :: MonadZ3 z3 => AST -> AST -> z3 AST -mkConcat = liftFun2 Base.mkConcat - --- | Extract the bits high down to low from a bitvector of size m to yield a new --- bitvector of size /n/, where /n = high - low + 1/. --- --- Reference: -mkExtract :: MonadZ3 z3 => Int -> Int -> AST -> z3 AST -mkExtract = liftFun3 Base.mkExtract - --- | Sign-extend of the given bit-vector to the (signed) equivalent bitvector --- of size /m+i/, where /m/ is the size of the given bit-vector. --- --- Reference: -mkSignExt :: MonadZ3 z3 => Int -> AST -> z3 AST -mkSignExt = liftFun2 Base.mkSignExt - --- | Extend the given bit-vector with zeros to the (unsigned) equivalent --- bitvector of size /m+i/, where /m/ is the size of the given bit-vector. --- --- Reference: -mkZeroExt :: MonadZ3 z3 => Int -> AST -> z3 AST -mkZeroExt = liftFun2 Base.mkZeroExt - --- | Repeat the given bit-vector up length /i/. --- --- Reference: -mkRepeat :: MonadZ3 z3 => Int -> AST -> z3 AST -mkRepeat = liftFun2 Base.mkRepeat - --- | Shift left. --- --- Reference: -mkBvshl :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvshl = liftFun2 Base.mkBvshl - --- | Logical shift right. --- --- Reference: -mkBvlshr :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvlshr = liftFun2 Base.mkBvlshr - --- | Arithmetic shift right. --- --- Reference: -mkBvashr :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvashr = liftFun2 Base.mkBvashr - --- | Rotate bits of /t1/ to the left /i/ times. --- --- Reference: -mkRotateLeft :: MonadZ3 z3 => Int -> AST -> z3 AST -mkRotateLeft = liftFun2 Base.mkRotateLeft - --- | Rotate bits of /t1/ to the right /i/ times. --- --- Reference: -mkRotateRight :: MonadZ3 z3 => Int -> AST -> z3 AST -mkRotateRight = liftFun2 Base.mkRotateRight - --- | Rotate bits of /t1/ to the left /t2/ times. --- --- Reference: -mkExtRotateLeft :: MonadZ3 z3 => AST -> AST -> z3 AST -mkExtRotateLeft = liftFun2 Base.mkExtRotateLeft - --- | Rotate bits of /t1/ to the right /t2/ times. --- --- Reference: -mkExtRotateRight :: MonadZ3 z3 => AST -> AST -> z3 AST -mkExtRotateRight = liftFun2 Base.mkExtRotateRight - --- | Create an /n/ bit bit-vector from the integer argument /t1/. --- --- Reference: -mkInt2bv :: MonadZ3 z3 => Int -> AST -> z3 AST -mkInt2bv = liftFun2 Base.mkInt2bv - --- | Create an integer from the bit-vector argument /t1/. If /is_signed/ is false, --- then the bit-vector /t1/ is treated as unsigned. So the result is non-negative --- and in the range [0..2^/N/-1], where /N/ are the number of bits in /t1/. --- If /is_signed/ is true, /t1/ is treated as a signed bit-vector. --- --- Reference: -mkBv2int :: MonadZ3 z3 => AST -> Bool -> z3 AST -mkBv2int = liftFun2 Base.mkBv2int - --- | Create a predicate that checks that the bit-wise addition of /t1/ and /t2/ --- does not overflow. --- --- Reference: -mkBvaddNoOverflow :: MonadZ3 z3 => AST -> AST -> Bool -> z3 AST -mkBvaddNoOverflow = liftFun3 Base.mkBvaddNoOverflow - --- | Create a predicate that checks that the bit-wise signed addition of /t1/ --- and /t2/ does not underflow. --- --- Reference: -mkBvaddNoUnderflow :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvaddNoUnderflow = liftFun2 Base.mkBvaddNoUnderflow - --- | Create a predicate that checks that the bit-wise signed subtraction of /t1/ --- and /t2/ does not overflow. --- --- Reference: -mkBvsubNoOverflow :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsubNoOverflow = liftFun2 Base.mkBvsubNoOverflow - --- | Create a predicate that checks that the bit-wise subtraction of /t1/ and --- /t2/ does not underflow. --- --- Reference: -mkBvsubNoUnderflow :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsubNoUnderflow = liftFun2 Base.mkBvsubNoUnderflow - --- | Create a predicate that checks that the bit-wise signed division of /t1/ --- and /t2/ does not overflow. --- --- Reference: -mkBvsdivNoOverflow :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvsdivNoOverflow = liftFun2 Base.mkBvsdivNoOverflow - --- | Check that bit-wise negation does not overflow when /t1/ is interpreted as --- a signed bit-vector. --- --- Reference: -mkBvnegNoOverflow :: MonadZ3 z3 => AST -> z3 AST -mkBvnegNoOverflow = liftFun1 Base.mkBvnegNoOverflow - --- | Create a predicate that checks that the bit-wise multiplication of /t1/ and --- /t2/ does not overflow. --- --- Reference: -mkBvmulNoOverflow :: MonadZ3 z3 => AST -> AST -> Bool -> z3 AST -mkBvmulNoOverflow = liftFun3 Base.mkBvmulNoOverflow - --- | Create a predicate that checks that the bit-wise signed multiplication of --- /t1/ and /t2/ does not underflow. --- --- Reference: -mkBvmulNoUnderflow :: MonadZ3 z3 => AST -> AST -> z3 AST -mkBvmulNoUnderflow = liftFun2 Base.mkBvmulNoUnderflow - ---------------------------------------------------------------------- --- Arrays - --- | Array read. The argument a is the array and i is the index of the array --- that gets read. --- --- Reference: -mkSelect :: MonadZ3 z3 => AST -> AST -> z3 AST -mkSelect = liftFun2 Base.mkSelect - --- | Array update.   --- --- Reference: -mkStore :: MonadZ3 z3 => AST -> AST -> AST -> z3 AST -mkStore = liftFun3 Base.mkStore - --- | Create the constant array. --- --- Reference: -mkConstArray :: MonadZ3 z3 => Sort -> AST -> z3 AST -mkConstArray = liftFun2 Base.mkConstArray - --- | map f on the the argument arrays. --- --- Reference: -mkMap :: MonadZ3 z3 => FuncDecl -> [AST] -> z3 AST -mkMap = liftFun2 Base.mkMap - --- | Access the array default value. Produces the default range value, for --- arrays that can be represented as finite maps with a default range value. --- --- Reference: -mkArrayDefault :: MonadZ3 z3 => AST -> z3 AST -mkArrayDefault = liftFun1 Base.mkArrayDefault - ---------------------------------------------------------------------- --- Numerals - --- | Create a numeral of a given sort. --- --- Reference: -mkNumeral :: MonadZ3 z3 => String -> Sort -> z3 AST -mkNumeral = liftFun2 Base.mkNumeral - -------------------------------------------------- --- Numerals / Integers - --- | Create a numeral of sort /int/. -mkInt :: (MonadZ3 z3, Integral a) => a -> z3 AST -mkInt = liftFun1 Base.mkInt - -------------------------------------------------- --- Numerals / Reals - --- | Create a numeral of sort /real/. -mkReal :: (MonadZ3 z3, Real r) => r -> z3 AST -mkReal = liftFun1 Base.mkReal - ---------------------------------------------------------------------- --- Quantifiers - -mkPattern :: MonadZ3 z3 => [AST] -> z3 Pattern -mkPattern = liftFun1 Base.mkPattern - -mkBound :: MonadZ3 z3 => Int -> Sort -> z3 AST -mkBound = liftFun2 Base.mkBound - -mkForall :: MonadZ3 z3 => [Pattern] -> [Symbol] -> [Sort] -> AST -> z3 AST -mkForall = liftFun4 Base.mkForall - -mkForallConst :: MonadZ3 z3 => [Pattern] -> [App] -> AST -> z3 AST -mkForallConst = liftFun3 Base.mkForallConst - -mkExistsConst :: MonadZ3 z3 => [Pattern] -> [App] -> AST -> z3 AST -mkExistsConst = liftFun3 Base.mkExistsConst - -mkExists :: MonadZ3 z3 => [Pattern] -> [Symbol] -> [Sort] -> AST -> z3 AST -mkExists = liftFun4 Base.mkExists - ---------------------------------------------------------------------- --- Accessors - --- | Return the size of the given bit-vector sort. --- --- Reference: -getBvSortSize :: MonadZ3 z3 => Sort -> z3 Int -getBvSortSize = liftFun1 Base.getBvSortSize - --- | Returns @Just True@, @Just False@, or @Nothing@ for /undefined/. --- --- Reference: -getBool :: MonadZ3 z3 => AST -> z3 (Maybe Bool) -getBool = liftFun1 Base.getBool - --- | Return the integer value -getInt :: MonadZ3 z3 => AST -> z3 Integer -getInt = liftFun1 Base.getInt - --- | Return rational value -getReal :: MonadZ3 z3 => AST -> z3 Rational -getReal = liftFun1 Base.getReal - --- | Cast AST into an App. -toApp :: MonadZ3 z3 => AST -> z3 App -toApp = liftFun1 Base.toApp - ---------------------------------------------------------------------- --- Models - --- | Evaluate an AST node in the given model. -eval :: MonadZ3 z3 => Model -> AST -> z3 (Maybe AST) -eval = liftFun2 Base.eval - --- | Evaluate a collection of AST nodes in the given model. -evalT :: (MonadZ3 z3,Traversable t) => Model -> t AST -> z3 (Maybe (t AST)) -evalT = liftFun2 Base.evalT - --- | Get function as a list of argument/value pairs. -evalFunc :: MonadZ3 z3 => Model -> FuncDecl -> z3 (Maybe FuncModel) -evalFunc = liftFun2 Base.evalFunc - --- | Get array as a list of argument/value pairs, if it is --- represented as a function (ie, using as-array). -evalArray :: MonadZ3 z3 => Model -> AST -> z3 (Maybe FuncModel) -evalArray = liftFun2 Base.evalArray - --- | Return the interpretation of the function f in the model m. --- Return NULL, if the model does not assign an interpretation for f. --- That should be interpreted as: the f does not matter. --- --- Reference: -getFuncInterp :: MonadZ3 z3 => Model -> FuncDecl -> z3 (Maybe FuncInterp) -getFuncInterp = liftFun2 Base.getFuncInterp - --- | The (_ as-array f) AST node is a construct for assigning interpretations --- for arrays in Z3. It is the array such that forall indices i we have that --- (select (_ as-array f) i) is equal to (f i). This procedure returns Z3_TRUE --- if the a is an as-array AST node. --- --- Reference: -isAsArray :: MonadZ3 z3 => AST -> z3 Bool -isAsArray = liftFun1 Base.isAsArray - --- | Return the function declaration f associated with a (_ as_array f) node. --- --- Reference: -getAsArrayFuncDecl :: MonadZ3 z3 => AST -> z3 FuncDecl -getAsArrayFuncDecl = liftFun1 Base.getAsArrayFuncDecl - --- | Return the number of entries in the given function interpretation. --- --- Reference: -funcInterpGetNumEntries :: MonadZ3 z3 => FuncInterp -> z3 Int -funcInterpGetNumEntries = liftFun1 Base.funcInterpGetNumEntries - --- | Return a "point" of the given function intepretation. --- It represents the value of f in a particular point. --- --- Reference: -funcInterpGetEntry :: MonadZ3 z3 => FuncInterp -> Int -> z3 FuncEntry -funcInterpGetEntry = liftFun2 Base.funcInterpGetEntry - --- | Return the 'else' value of the given function interpretation. --- --- Reference: -funcInterpGetElse :: MonadZ3 z3 => FuncInterp -> z3 AST -funcInterpGetElse = liftFun1 Base.funcInterpGetElse - --- | Return the arity (number of arguments) of the given function --- interpretation. --- --- Reference: -funcInterpGetArity :: MonadZ3 z3 => FuncInterp -> z3 Int -funcInterpGetArity = liftFun1 Base.funcInterpGetArity - --- | Return the value of this point. --- --- Reference: -funcEntryGetValue :: MonadZ3 z3 => FuncEntry -> z3 AST -funcEntryGetValue = liftFun1 Base.funcEntryGetValue - --- | Return the number of arguments in a Z3_func_entry object. --- --- Reference: -funcEntryGetNumArgs :: MonadZ3 z3 => FuncEntry -> z3 Int -funcEntryGetNumArgs = liftFun1 Base.funcEntryGetNumArgs - --- | Return an argument of a Z3_func_entry object. --- --- Reference: -funcEntryGetArg :: MonadZ3 z3 => FuncEntry -> Int -> z3 AST -funcEntryGetArg = liftFun2 Base.funcEntryGetArg - --- | Convert the given model into a string. -modelToString :: MonadZ3 z3 => Model -> z3 String -modelToString = liftFun1 Base.modelToString - --- | Alias for 'modelToString'. -showModel :: MonadZ3 z3 => Model -> z3 String -showModel = modelToString - ---------------------------------------------------------------------- --- Constraints - --- | Create a backtracking point. -push :: MonadZ3 z3 => z3 () -push = liftSolver0 Base.solverPush Base.push - --- | Backtrack /n/ backtracking points. -pop :: MonadZ3 z3 => Int -> z3 () -pop = liftSolver1 Base.solverPop Base.pop - --- | Run a query and restore the initial logical context. --- --- This is a shorthand for 'push', run the query, and 'pop'. -local :: MonadZ3 z3 => z3 a -> z3 a -local q = do - push - r <- q - pop 1 - return r - --- | Backtrack all the way. -reset :: MonadZ3 z3 => z3 () -reset = liftSolver0 Base.solverReset - (error "reset requires solver") - --- | Get number of backtracking points. -getNumScopes :: MonadZ3 z3 => z3 Int -getNumScopes = liftSolver0 Base.solverGetNumScopes - (error "getNumScopes requires solver") - --- | Assert a constraing into the logical context. --- --- Reference: -assertCnstr :: MonadZ3 z3 => AST -> z3 () -assertCnstr = liftSolver1 Base.solverAssertCnstr Base.assertCnstr - --- | Get model. --- --- Reference : -getModel :: MonadZ3 z3 => z3 (Result, Maybe Model) -getModel = liftSolver0 Base.solverCheckAndGetModel Base.getModel - --- | Delete a model object. --- --- Reference: -delModel :: MonadZ3 z3 => Model -> z3 () -delModel = liftFun1 Base.delModel - -withModel :: (Applicative z3, MonadZ3 z3) => - (Base.Model -> z3 a) -> z3 (Result, Maybe a) -withModel f = do - (r,mb_m) <- getModel - mb_e <- T.traverse f mb_m - void $ T.traverse delModel mb_m - return (r, mb_e) - --- | Check whether the given logical context is consistent or not. -check :: MonadZ3 z3 => z3 Result -check = liftSolver0 Base.solverCheck Base.check - ---------------------------------------------------------------------- --- String Conversion - --- | Set the mode for converting expressions to strings. -setASTPrintMode :: MonadZ3 z3 => ASTPrintMode -> z3 () -setASTPrintMode = liftFun1 Base.setASTPrintMode - --- | Convert an AST to a string. -astToString :: MonadZ3 z3 => AST -> z3 String -astToString = liftFun1 Base.astToString - --- | Convert a pattern to a string. -patternToString :: MonadZ3 z3 => Pattern -> z3 String -patternToString = liftFun1 Base.patternToString - --- | Convert a sort to a string. -sortToString :: MonadZ3 z3 => Sort -> z3 String -sortToString = liftFun1 Base.sortToString - --- | Convert a FuncDecl to a string. -funcDeclToString :: MonadZ3 z3 => FuncDecl -> z3 String -funcDeclToString = liftFun1 Base.funcDeclToString - --- | Convert the solver to a string. -solverToString :: MonadZ3 z3 => z3 String -solverToString = liftSolver0 Base.solverToString - (error "solverToString requires solver") - --- | Convert the given benchmark into SMT-LIB formatted string. --- --- The output format can be configured via 'setASTPrintMode'. -benchmarkToSMTLibString :: MonadZ3 z3 => - String -- ^ name - -> String -- ^ logic - -> String -- ^ status - -> String -- ^ attributes - -> [AST] -- ^ assumptions1 - -> AST -- ^ formula - -> z3 String -benchmarkToSMTLibString = liftFun6 Base.benchmarkToSMTLibString - ---------------------------------------------------------------------- --- Miscellaneous - --- | Return Z3 version number information. -getVersion :: MonadZ3 z3 => z3 Version -getVersion = liftIO Base.getVersion diff --git a/Z3/Opts.hs b/Z3/Opts.hs deleted file mode 100644 --- a/Z3/Opts.hs +++ /dev/null @@ -1,99 +0,0 @@ - --- | --- Module : Z3.Opts --- Copyright : (c) Iago Abal, 2013-2014 --- (c) David Castro, 2013 --- License : BSD3 --- Maintainer: Iago Abal , --- David Castro --- --- Configuring Z3. --- --- Z3 has plenty of configuration options and these vary quite a lot --- across Z3 versions, being hard to design a proper abstraction. --- We decided to keep this simple. - -module Z3.Opts - ( -- * Z3 configuration - Opts - , setOpts - , stdOpts - , (+?) - -- * Z3 options - , opt - , OptValue - ) - where - -import qualified Z3.Base as Base - -import Data.Monoid ( Monoid(..) ) - ---------------------------------------------------------------------- --- Configuration - --- | Z3 configuration. -newtype Opts = Opts [Opt] - -instance Monoid Opts where - mempty = Opts [] - mappend (Opts ps1) (Opts ps2) = Opts (ps1++ps2) - -singleton :: Opt -> Opts -singleton o = Opts [o] - --- | Default configuration. -stdOpts :: Opts -stdOpts = mempty - --- | Append configurations. -(+?) :: Opts -> Opts -> Opts -(+?) = mappend - --- | Set a configuration option. -opt :: OptValue val => String -> val -> Opts -opt oid val = singleton $ option oid val - --- | Set configuration. --- --- If you are using 'Z3.Lang' or 'Z3.Monad' interfaces, you don't need --- to call this function directly, just pass your 'Opts' to /evalZ3*/. -setOpts :: Base.Config -> Opts -> IO () -setOpts baseCfg (Opts params) = mapM_ (setOpt baseCfg) params - -------------------------------------------------- --- Options - --- | Configuration option. -data Opt = Opt String -- id - String -- value - --- | Set an option. -setOpt :: Base.Config -> Opt -> IO () -setOpt baseCfg (Opt oid val) = Base.setParamValue baseCfg oid val - --- | Values for Z3 options. -class OptValue val where - option :: String -> val -> Opt - -instance OptValue Bool where - option oid = Opt oid . boolVal - -instance OptValue Int where - option oid = Opt oid . show - -instance OptValue Integer where - option oid = Opt oid . show - -instance OptValue Double where - option oid = Opt oid . show - -instance OptValue [Char] where - option = Opt - -------------------------------------------------- --- Utils - -boolVal :: Bool -> String -boolVal True = "true" -boolVal False = "false" diff --git a/examples/Examples.hs b/examples/Examples.hs new file mode 100644 --- /dev/null +++ b/examples/Examples.hs @@ -0,0 +1,47 @@ + +module Main where + +import qualified Example.Monad.Queens4 +import qualified Example.Monad.Queens4All +import qualified Example.Monad.DataTypes +import qualified Example.Monad.FuncModel +import qualified Example.Monad.ToSMTLib +import qualified Example.Monad.Tuple + +import System.Environment + +examples = + [ ("4queens" + , Example.Monad.Queens4.run + ) + , ("all4queens" + , Example.Monad.Queens4All.run + ) + , ("datatypes" + , Example.Monad.DataTypes.run + ) + , ("funcmodel" + , Example.Monad.FuncModel.run + ) + , ("smtlib" + , Example.Monad.ToSMTLib.run + ) + , ("tuple" + , Example.Monad.Tuple.run + ) + ] + +runExample :: String -> IO () +runExample x = case lookup x examples of + Just x -> x + Nothing -> error "Example not found" + +listExamples :: IO () +listExamples = mapM_ (putStrLn . fst) examples + +main = do + args <- getArgs + if null args + then listExamples + else case args !! 0 of + x -> runExample x diff --git a/src/Z3/Base.hs b/src/Z3/Base.hs new file mode 100644 --- /dev/null +++ b/src/Z3/Base.hs @@ -0,0 +1,2551 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PatternGuards #-} + +-- | +-- Module : Z3.Base +-- Copyright : (c) Iago Abal, 2012-2015 +-- (c) David Castro, 2012-2015 +-- License : BSD3 +-- Maintainer: Iago Abal , +-- David Castro +-- +-- Low-level bindings to Z3 API. +-- +-- There is (mostly) a one-to-one correspondence with Z3 C API, thus see +-- +-- for further details. + +{- HACKING + +Add here the IO-based wrapper for a new Z3 API function: + +* Take a look to a few others API functions and follow the same coding style. + * 2-space wide indentation, no tabs. + * No trailing spaces, please. + * ... +* Place the API function in the right section, according to the Z3's API documentation. +* Annotate the API function with a short but concise haddock comment. + * Look at the Z3 API documentation for inspiration. +* Add the API function to the module export list, (only) if needed. + +This should be straightforward for most cases using [MARSHALLING HELPERS]. + +Reference counting +------------------ + +When an object is returned by the C API, we: +* increment its reference counter (if applicable), +* wrap the pointer into a ForeignPtr, and +* install a finalizer to decrement the counter. + +Objects with explicit /delete/ functions, instead of reference +counters, are handled analogously.In this way, we move memory +management into the GC. + +Remarkably, a Z3_context cannot be deleted until we "free" every +object depending on it. But ForeignPtr finalizers do not provide +any ordering guarantee, and it's not possible to establish +dependencies between finalizers. Thus, we /count references/ to +a Z3_context and only delete it when this count reaches /zero/. + +-} + +module Z3.Base ( + + -- * Types + Config + , Context + , Symbol + , AST + , Sort + , FuncDecl + , App + , Pattern + , Constructor + , Model + , FuncInterp + , FuncEntry + , Params + , Solver + , ASTKind(..) + -- ** Satisfiability result + , Result(..) + + -- * Create configuration + , mkConfig + , delConfig + , setParamValue + -- ** Helpers + , withConfig + + -- * Create context + , mkContext + , withContext + + -- * Parameters + , mkParams + , paramsSetBool + , paramsSetUInt + , paramsSetDouble + , paramsSetSymbol + , paramsToString + + -- * Symbols + , mkIntSymbol + , mkStringSymbol + + -- * Sorts + , mkUninterpretedSort + , mkBoolSort + , mkIntSort + , mkRealSort + , mkBvSort + , mkArraySort + , mkTupleSort + , mkConstructor + , mkDatatype + + -- * Constants and Applications + , mkFuncDecl + , mkApp + , mkConst + , mkFreshFuncDecl + , mkFreshConst + -- ** Helpers + , mkVar + , mkBoolVar + , mkRealVar + , mkIntVar + , mkBvVar + , mkFreshVar + , mkFreshBoolVar + , mkFreshRealVar + , mkFreshIntVar + , mkFreshBvVar + + -- * Propositional Logic and Equality + , mkTrue + , mkFalse + , mkEq + , mkNot + , mkIte + , mkIff + , mkImplies + , mkXor + , mkAnd + , mkOr + , mkDistinct + -- ** Helpers + , mkBool + + -- * Arithmetic: Integers and Reals + , mkAdd + , mkMul + , mkSub + , mkUnaryMinus + , mkDiv + , mkMod + , mkRem + , mkLt + , mkLe + , mkGt + , mkGe + , mkInt2Real + , mkReal2Int + , mkIsInt + + -- * Bit-vectors + , mkBvnot + , mkBvredand + , mkBvredor + , mkBvand + , mkBvor + , mkBvxor + , mkBvnand + , mkBvnor + , mkBvxnor + , mkBvneg + , mkBvadd + , mkBvsub + , mkBvmul + , mkBvudiv + , mkBvsdiv + , mkBvurem + , mkBvsrem + , mkBvsmod + , mkBvult + , mkBvslt + , mkBvule + , mkBvsle + , mkBvuge + , mkBvsge + , mkBvugt + , mkBvsgt + , mkConcat + , mkExtract + , mkSignExt + , mkZeroExt + , mkRepeat + , mkBvshl + , mkBvlshr + , mkBvashr + , mkRotateLeft + , mkRotateRight + , mkExtRotateLeft + , mkExtRotateRight + , mkInt2bv + , mkBv2int + , mkBvnegNoOverflow + , mkBvaddNoOverflow + , mkBvaddNoUnderflow + , mkBvsubNoOverflow + , mkBvsubNoUnderflow + , mkBvmulNoOverflow + , mkBvmulNoUnderflow + , mkBvsdivNoOverflow + + -- * Arrays + , mkSelect + , mkStore + , mkConstArray + , mkMap + , mkArrayDefault + + -- * Numerals + , mkNumeral + , mkReal + , mkInt + , mkUnsignedInt + , mkInt64 + , mkUnsignedInt64 + -- ** Helpers + , mkIntegral + , mkRational + , mkFixed + , mkRealNum + , mkInteger + , mkIntNum + , mkBitvector + , mkBvNum + + -- * Quantifiers + , mkPattern + , mkBound + , mkForall + , mkExists + , mkForallConst + , mkExistsConst + + -- * Accessors + , getSymbolString + , getBvSortSize + , getDatatypeSortConstructors + , getDatatypeSortRecognizers + , getDeclName + , getSort + , getBoolValue + , getAstKind + , toApp + , getNumeralString + -- ** Helpers + , getBool + , getInt + , getReal + , getBv + + -- * Models + , modelEval + , evalArray + , getFuncInterp + , isAsArray + , getAsArrayFuncDecl + , funcInterpGetNumEntries + , funcInterpGetEntry + , funcInterpGetElse + , funcInterpGetArity + , funcEntryGetValue + , funcEntryGetNumArgs + , funcEntryGetArg + , modelToString + , showModel + -- ** Helpers + , EvalAst + , eval + , evalBool + , evalInt + , evalReal + , evalBv + , mapEval + , evalT + , FuncModel (..) + , evalFunc + + -- * String Conversion + , ASTPrintMode(..) + , setASTPrintMode + , astToString + , patternToString + , sortToString + , funcDeclToString + , benchmarkToSMTLibString + + -- * Error Handling + , Z3Error(..) + , Z3ErrorCode(..) + + -- * Miscellaneous + , Version(..) + , getVersion + + -- * Solvers + , Logic(..) + , mkSolver + , mkSimpleSolver + , mkSolverForLogic + , solverGetHelp + , solverSetParams + , solverPush + , solverPop + , solverReset + , solverGetNumScopes + , solverAssertCnstr + , solverAssertAndTrack + , solverCheck + , solverCheckAssumptions + , solverGetModel + , solverGetUnsatCore + , solverGetReasonUnknown + , solverToString + -- ** Helpers + , solverCheckAndGetModel + ) where + +import Z3.Base.C + +import Control.Applicative ( (<$>), (<*>), (<*), pure ) +import Control.Exception ( Exception, bracket, throw ) +import Control.Monad ( join, when ) +import Data.Fixed ( Fixed, HasResolution ) +import Data.Int +import Data.IORef ( IORef, newIORef, atomicModifyIORef' ) +import Data.Maybe ( fromJust ) +import Data.Ratio ( numerator, denominator, (%) ) +import Data.Traversable ( Traversable ) +import qualified Data.Traversable as T +import Data.Typeable ( Typeable ) +import Data.Word +import Foreign hiding ( toBool, newForeignPtr ) +import Foreign.C + ( CDouble, CInt, CUInt, CLLong, CULLong, CString + , peekCString + , withCString ) +import Foreign.Concurrent + +--------------------------------------------------------------------- +-- * Types + +-- | A Z3 /configuration object/. +newtype Config = Config { unConfig :: Ptr Z3_config } + deriving Eq + +-- | A Z3 /logical context/. +data Context = + Context { + unContext :: ForeignPtr Z3_context + , refCount :: !(IORef Word) + } + deriving Eq + +-- | A Z3 /symbol/. +-- +-- Used to name types, constants and functions. +newtype Symbol = Symbol { unSymbol :: Ptr Z3_symbol } + deriving (Eq, Ord, Show, Storable) + +-- | A Z3 /AST node/. +-- +-- This is the data-structure used in Z3 to represent terms, formulas and types. +newtype AST = AST { unAST :: ForeignPtr Z3_ast } + deriving (Eq, Ord, Show, Typeable) + +-- | A kind of AST representing /types/. +newtype Sort = Sort { unSort :: ForeignPtr Z3_sort } + deriving (Eq, Ord, Show) + +-- | A kind of AST representing function symbols. +newtype FuncDecl = FuncDecl { unFuncDecl :: ForeignPtr Z3_func_decl } + deriving (Eq, Ord, Show, Typeable) + +-- | A kind of AST representing constant and function declarations. +newtype App = App { unApp :: ForeignPtr Z3_app } + deriving (Eq, Ord, Show) + +-- | A kind of AST representing pattern and multi-patterns to +-- guide quantifier instantiation. +newtype Pattern = Pattern { unPattern :: ForeignPtr Z3_pattern } + deriving (Eq, Ord, Show) + +-- | A type contructor for a (recursive) datatype. +newtype Constructor = Constructor { unConstructor :: ForeignPtr Z3_constructor } + deriving (Eq, Ord, Show) + +-- | A model for the constraints asserted into the logical context. +newtype Model = Model { unModel :: ForeignPtr Z3_model } + deriving Eq + +-- | An interpretation of a function in a model. +newtype FuncInterp = FuncInterp { unFuncInterp :: ForeignPtr Z3_func_interp } + deriving Eq + +-- | Representation of the value of a 'Z3_func_interp' at a particular point. +newtype FuncEntry = FuncEntry { unFuncEntry :: ForeignPtr Z3_func_entry } + deriving Eq + +-- | A Z3 parameter set. +-- +-- Starting at Z3 4.0, parameter sets are used to configure many components +-- such as: simplifiers, tactics, solvers, etc. +newtype Params = Params { unParams :: ForeignPtr Z3_params } + deriving Eq + +-- | A Z3 solver engine. +-- +-- A(n) (incremental) solver, possibly specialized by a particular tactic +-- or logic. +newtype Solver = Solver { unSolver :: ForeignPtr Z3_solver } + deriving Eq + +-- | Result of a satisfiability check. +-- +-- This corresponds to the /z3_lbool/ type in the C API. +data Result + = Sat + | Unsat + | Undef + deriving (Eq, Ord, Read, Show) + +-- | Different kinds of Z3 AST nodes. +data ASTKind + = Z3_NUMERAL_AST + | Z3_APP_AST + | Z3_VAR_AST + | Z3_QUANTIFIER_AST + | Z3_SORT_AST + | Z3_FUNC_DECL_AST + | Z3_UNKNOWN_AST + +--------------------------------------------------------------------- +-- * Configuration + +-- TODO: Z3_global_param_set +-- TODO: Z3_global_param_reset_all +-- TODO: Z3_global_param_get + +--------------------------------------------------------------------- +-- * Create configuration + +-- | Create a configuration. +-- +-- See 'withConfig'. +mkConfig :: IO Config +mkConfig = Config <$> z3_mk_config + +-- | Delete a configuration. +-- +-- See 'withConfig'. +delConfig :: Config -> IO () +delConfig = z3_del_config . unConfig + +-- | Set a configuration parameter. +setParamValue :: Config -> String -> String -> IO () +setParamValue cfg s1 s2 = + withCString s1 $ \cs1 -> + withCString s2 $ \cs2 -> + z3_set_param_value (unConfig cfg) cs1 cs2 + +------------------------------------------------- +-- ** Helpers + +-- | Run a computation using a temporally created configuration. +-- +-- Note that the configuration object can be thrown away once +-- it has been used to create the Z3 'Context'. +withConfig :: (Config -> IO a) -> IO a +withConfig = bracket mkConfig delConfig + +--------------------------------------------------------------------- +-- Create context + +-- | Create a context using the given configuration. +-- +-- /Z3_del_context/ is called by Haskell's garbage collector before +-- freeing the 'Context' object. +mkContext :: Config -> IO Context +mkContext cfg = do + ctxPtr <- z3_mk_context_rc (unConfig cfg) + z3_set_error_handler ctxPtr nullFunPtr + count <- newIORef 1 + Context <$> newForeignPtr ctxPtr (contextDecRef ctxPtr count) + <*> pure count + +-- TODO: Z3_update_param_value +-- TODO: Z3_interrupt + +------------------------------------------------- +-- Reference counting of Context + +contextIncRef :: Context -> IO () +contextIncRef ctx = atomicModifyIORef' (refCount ctx) $ \n -> + (n+1, ()) + +contextDecRef :: Ptr Z3_context -> IORef Word -> IO () +contextDecRef ctxPtr count = join $ atomicModifyIORef' count $ \n -> + if n > 1 + then (n-1, return ()) + else ( 0, z3_del_context ctxPtr) + +--------------------------------------------------------------------- +-- Parameters + +-- | Create a Z3 (empty) parameter set. +-- +-- Starting at Z3 4.0, parameter sets are used to configure many components +-- such as: simplifiers, tactics, solvers, etc. +mkParams :: Context -> IO Params +mkParams = liftFun0 z3_mk_params + +-- | Add a Boolean parameter /k/ with value /v/ to the parameter set /p/. +paramsSetBool :: Context -> Params -> Symbol -> Bool -> IO () +paramsSetBool = liftFun3 z3_params_set_bool + +-- | Add a unsigned parameter /k/ with value /v/ to the parameter set /p/. +paramsSetUInt :: Context -> Params -> Symbol -> Word -> IO () +paramsSetUInt = liftFun3 z3_params_set_uint + +-- | Add a double parameter /k/ with value /v/ to the parameter set /p/. +paramsSetDouble :: Context -> Params -> Symbol -> Double -> IO () +paramsSetDouble = liftFun3 z3_params_set_double + +-- | Add a symbol parameter /k/ with value /v/ to the parameter set /p/. +paramsSetSymbol :: Context -> Params -> Symbol -> Symbol -> IO () +paramsSetSymbol = liftFun3 z3_params_set_symbol + +-- | Convert a parameter set into a string. +-- +-- This function is mainly used for printing the contents of a parameter set. +paramsToString :: Context -> Params -> IO String +paramsToString = liftFun1 z3_params_to_string + +-- TODO: Z3_params_validate + +--------------------------------------------------------------------- +-- Parameter Descriptions + +-- TODO + +--------------------------------------------------------------------- +-- Symbols + +-- | Create a Z3 symbol using an integer. +-- +-- @mkIntSymbol c i@ /requires/ @0 <= i < 2^30@ +mkIntSymbol :: Integral int => Context -> int -> IO Symbol +mkIntSymbol c i + | 0 <= i && i <= 2^(30::Int)-1 + = liftFun1 z3_mk_int_symbol c i + | otherwise + = error "Z3.Base.mkIntSymbol: invalid range" + +-- | Create a Z3 symbol using a 'String'. +mkStringSymbol :: Context -> String -> IO Symbol +mkStringSymbol = liftFun1 z3_mk_string_symbol + +--------------------------------------------------------------------- +-- Sorts + +-- | Create a free (uninterpreted) type using the given name (symbol). +-- +-- Two free types are considered the same iff the have the same name. +mkUninterpretedSort :: Context -> Symbol -> IO Sort +mkUninterpretedSort = liftFun1 z3_mk_uninterpreted_sort + +-- | Create the /boolean/ type. +-- +-- This type is used to create propositional variables and predicates. +mkBoolSort :: Context -> IO Sort +mkBoolSort = liftFun0 z3_mk_bool_sort + +-- | Create the /integer/ type. +-- +-- This is the type of arbitrary precision integers. +-- A machine integer can be represented using bit-vectors, see 'mkBvSort'. +mkIntSort :: Context -> IO Sort +mkIntSort = liftFun0 z3_mk_int_sort + +-- | Create the /real/ type. +-- +-- This type is not a floating point number. +-- Z3 does not have support for floating point numbers yet. +mkRealSort :: Context -> IO Sort +mkRealSort = liftFun0 z3_mk_real_sort + +-- | Create a bit-vector type of the given size. +-- +-- This type can also be seen as a machine integer. +-- +-- @mkBvSort c sz@ /requires/ @sz >= 0@ +mkBvSort :: Integral int => Context -> int -> IO Sort +mkBvSort c i + | i >= 0 = liftFun1 z3_mk_bv_sort c i + | otherwise = error "Z3.Base.mkBvSort: negative size" + +-- TODO: Z3_mk_finite_domain_sort + +-- | Create an array type +-- +-- We usually represent the array type as: [domain -> range]. +-- Arrays are usually used to model the heap/memory in software verification. +mkArraySort :: Context -> Sort -> Sort -> IO Sort +mkArraySort = liftFun2 z3_mk_array_sort + +{- TODO +data TupleTyple + = TupleType { + tupleSort :: Sort + , tupleCons :: FunDecl + , tupleProj :: [FunDecl] + } + +mkTupleSort :: ... -> IO TupleType +-} + +-- | Create a tuple type +-- +-- A tuple with n fields has a constructor and n projections. +-- This function will also declare the constructor and projection functions. +mkTupleSort :: Context -- ^ Context + -> Symbol -- ^ Name of the sort + -> [(Symbol, Sort)] -- ^ Name and sort of each field + -> IO (Sort, FuncDecl, [FuncDecl]) -- ^ Resulting sort, and function + -- declarations for the + -- constructor and projections. +mkTupleSort c sym symSorts = withContextError c $ \cPtr -> + h2c sym $ \symPtr -> + marshalArrayLen syms $ \ n symsPtr -> + marshalArray sorts $ \ sortsPtr -> + alloca $ \ outConstrPtr -> + allocaArray n $ \ outProjsPtr -> do + srtPtr <- z3_mk_tuple_sort cPtr symPtr + (fromIntegral n) symsPtr sortsPtr + outConstrPtr outProjsPtr + outConstr <- peek outConstrPtr + outProjs <- peekArray n outProjsPtr + sort <- c2h c srtPtr + constrFd <- c2h c outConstr + projsFds <- mapM (c2h c) outProjs + return (sort, constrFd, projsFds) + where (syms, sorts) = unzip symSorts + +-- TODO: Z3_mk_enumeration_sort +-- TODO: Z3_mk_list_sort + +-- | Create a contructor +mkConstructor :: Context -- ^ Context + -> Symbol -- ^ Name of the constructor + -> Symbol -- ^ Name of recognizer function + -> [(Symbol, Maybe Sort, Int)] -- ^ Name, sort option, and sortRefs + -> IO Constructor +mkConstructor c sym recog symSortsRefs = + withContextError c $ \cPtr -> + h2c sym $ \symPtr -> + h2c recog $ \recogPtr -> + marshalArrayLen syms $ \ n symsPtr -> + marshalArray maybeSorts $ \ sortsPtr -> + marshalArray (map toInteger refs) $ \ refsPtr -> do + constructor <- checkError cPtr $ z3_mk_constructor + cPtr symPtr recogPtr n symsPtr sortsPtr refsPtr + c2h c constructor + where (syms, maybeSorts, refs) = unzip3 symSortsRefs + +-- | Create datatype, such as lists, trees, records, +-- enumerations or unions of records. +-- +-- The datatype may be recursive. +-- Returns the datatype sort. +mkDatatype :: Context + -> Symbol + -> [Constructor] + -> IO Sort +mkDatatype c sym consList = withContextError c $ \cPtr -> + marshalArrayLen consList $ \ n consPtrs -> checkError cPtr $ do + sortPtr <- z3_mk_datatype cPtr (unSymbol sym) n consPtrs + c2h c sortPtr + +-- TODO: from Z3_mk_constructor_list on + +--------------------------------------------------------------------- +-- * Constants and Applications + +-- | Declare a constant or function. +mkFuncDecl :: Context -- ^ Logical context. + -> Symbol -- ^ Name of the function (or constant). + -> [Sort] -- ^ Function domain (empty for constants). + -> Sort -- ^ Return sort of the function. + -> IO FuncDecl +mkFuncDecl ctx smb dom rng = + marshal z3_mk_func_decl ctx $ \f -> + h2c smb $ \ptrSym -> + marshalArrayLen dom $ \domNum domArr -> + h2c rng $ \ptrRange -> + f ptrSym domNum domArr ptrRange + +-- | Create a constant or function application. +mkApp :: Context -> FuncDecl -> [AST] -> IO AST +mkApp ctx fd args = marshal z3_mk_app ctx $ \f -> + h2c fd $ \fdPtr -> + marshalArrayLen args $ \argsNum argsArr -> + f fdPtr argsNum argsArr + +-- | Declare and create a constant. +-- +-- This is a shorthand for: +-- @do xd <- mkFunDecl c x [] s; mkApp c xd []@ +mkConst :: Context -> Symbol -> Sort -> IO AST +mkConst = liftFun2 z3_mk_const + +-- | Declare a fresh constant or function. +mkFreshFuncDecl :: Context -> String -> [Sort] -> Sort -> IO FuncDecl +mkFreshFuncDecl ctx str dom rng = + withCString str $ \cstr -> + marshal z3_mk_fresh_func_decl ctx $ \f -> + marshalArrayLen dom $ \domNum domArr -> + h2c rng $ \ptrRange -> + f cstr domNum domArr ptrRange + +-- | Declare and create a fresh constant. +mkFreshConst :: Context -- ^ Logical context. + -> String -- ^ Prefix. + -> Sort -- ^ Sort of the constant. + -> IO AST +mkFreshConst = liftFun2 z3_mk_fresh_const + +------------------------------------------------- +-- ** Helpers + +-- | Declare and create a variable (aka /constant/). +-- +-- An alias for 'mkConst'. +mkVar :: Context -> Symbol -> Sort -> IO AST +mkVar = mkConst + +-- | Declarate and create a variable of sort /bool/. +-- +-- See 'mkVar'. +mkBoolVar :: Context -> Symbol -> IO AST +mkBoolVar ctx sym = mkVar ctx sym =<< mkBoolSort ctx + +-- | Declarate and create a variable of sort /real/. +-- +-- See 'mkVar'. +mkRealVar :: Context -> Symbol -> IO AST +mkRealVar ctx sym = mkVar ctx sym =<< mkRealSort ctx + +-- | Declarate and create a variable of sort /int/. +-- +-- See 'mkVar'. +mkIntVar :: Context -> Symbol -> IO AST +mkIntVar ctx sym = mkVar ctx sym =<< mkIntSort ctx + +-- | Declarate and create a variable of sort /bit-vector/. +-- +-- See 'mkVar'. +mkBvVar :: Context -> Symbol + -> Int -- ^ bit-width + -> IO AST +mkBvVar ctx sym sz = mkVar ctx sym =<< mkBvSort ctx sz + +-- | Declare and create a /fresh/ variable (aka /constant/). +-- +-- An alias for 'mkFreshConst'. +mkFreshVar :: Context -> String -> Sort -> IO AST +mkFreshVar = mkFreshConst + +-- | Declarate and create a /fresh/ variable of sort /bool/. +-- +-- See 'mkFreshVar'. +mkFreshBoolVar :: Context -> String -> IO AST +mkFreshBoolVar ctx str = mkFreshVar ctx str =<< mkBoolSort ctx + +-- | Declarate and create a /fresh/ variable of sort /real/. +-- +-- See 'mkFreshVar'. +mkFreshRealVar :: Context -> String -> IO AST +mkFreshRealVar ctx str = mkFreshVar ctx str =<< mkRealSort ctx + +-- | Declarate and create a /fresh/ variable of sort /int/. +-- +-- See 'mkFreshVar'. +mkFreshIntVar :: Context -> String -> IO AST +mkFreshIntVar ctx str = mkFreshVar ctx str =<< mkIntSort ctx + +-- | Declarate and create a /fresh/ variable of sort /bit-vector/. +-- +-- See 'mkFreshVar'. +mkFreshBvVar :: Context -> String + -> Int -- ^ bit-width + -> IO AST +mkFreshBvVar ctx str sz = mkFreshVar ctx str =<< mkBvSort ctx sz + +--------------------------------------------------------------------- +-- Propositional Logic and Equality + +-- | Create an AST node representing /true/. +mkTrue :: Context -> IO AST +mkTrue = liftFun0 z3_mk_true + +-- | Create an AST node representing /false/. +mkFalse :: Context -> IO AST +mkFalse = liftFun0 z3_mk_false + +-- | Create an AST node representing /l = r/. +mkEq :: Context -> AST -> AST -> IO AST +mkEq = liftFun2 z3_mk_eq + +-- | The distinct construct is used for declaring the arguments pairwise +-- distinct. +-- +-- That is, @and [ args!!i /= args!!j | i <- [0..length(args)-1], j <- [i+1..length(args)-1] ]@ +mkDistinct :: Context -> [AST] -> IO AST +mkDistinct = + liftAstN "Z3.Base.mkDistinct: empty list of expressions" z3_mk_distinct + +-- | Create an AST node representing /not(a)/. +mkNot :: Context -> AST -> IO AST +mkNot = liftFun1 z3_mk_not + +-- | Create an AST node representing an if-then-else: /ite(t1, t2, t3)/. +mkIte :: Context -> AST -> AST -> AST -> IO AST +mkIte = liftFun3 z3_mk_ite + +-- | Create an AST node representing /t1 iff t2/. +mkIff :: Context -> AST -> AST -> IO AST +mkIff = liftFun2 z3_mk_iff + +-- | Create an AST node representing /t1 implies t2/. +mkImplies :: Context -> AST -> AST -> IO AST +mkImplies = liftFun2 z3_mk_implies + +-- | Create an AST node representing /t1 xor t2/. +mkXor :: Context -> AST -> AST -> IO AST +mkXor = liftFun2 z3_mk_xor + +-- | Create an AST node representing args[0] and ... and args[num_args-1]. +mkAnd :: Context -> [AST] -> IO AST +mkAnd = liftAstN "Z3.Base.mkAnd: empty list of expressions" z3_mk_and + +-- | Create an AST node representing args[0] or ... or args[num_args-1]. +mkOr :: Context -> [AST] -> IO AST +mkOr = liftAstN "Z3.Base.mkOr: empty list of expressions" z3_mk_or + +------------------------------------------------- +-- ** Helpers + +-- | Create an AST node representing the given boolean. +mkBool :: Context -> Bool -> IO AST +mkBool ctx False = mkFalse ctx +mkBool ctx True = mkTrue ctx + +--------------------------------------------------------------------- +-- Arithmetic: Integers and Reals + +-- | Create an AST node representing args[0] + ... + args[num_args-1]. +mkAdd :: Context -> [AST] -> IO AST +mkAdd = liftAstN "Z3.Base.mkAdd: empty list of expressions" z3_mk_add + +-- | Create an AST node representing args[0] * ... * args[num_args-1]. +mkMul :: Context -> [AST] -> IO AST +mkMul = liftAstN "Z3.Base.mkMul: empty list of expressions" z3_mk_mul + +-- | Create an AST node representing args[0] - ... - args[num_args - 1]. +mkSub :: Context -> [AST] -> IO AST +mkSub = liftAstN "Z3.Base.mkSub: empty list of expressions" z3_mk_sub + +-- | Create an AST node representing -arg. +mkUnaryMinus :: Context -> AST -> IO AST +mkUnaryMinus = liftFun1 z3_mk_unary_minus + +-- | Create an AST node representing arg1 div arg2. +mkDiv :: Context -> AST -> AST -> IO AST +mkDiv = liftFun2 z3_mk_div + +-- | Create an AST node representing arg1 mod arg2. +mkMod :: Context -> AST -> AST -> IO AST +mkMod = liftFun2 z3_mk_mod + +-- | Create an AST node representing arg1 rem arg2. +mkRem :: Context -> AST -> AST -> IO AST +mkRem = liftFun2 z3_mk_rem + +-- TODO: Z3_mk_power + +-- | Create less than. +mkLt :: Context -> AST -> AST -> IO AST +mkLt = liftFun2 z3_mk_lt + +-- | Create less than or equal to. +mkLe :: Context -> AST -> AST -> IO AST +mkLe = liftFun2 z3_mk_le + +-- | Create greater than. +mkGt :: Context -> AST -> AST -> IO AST +mkGt = liftFun2 z3_mk_gt + +-- | Create greater than or equal to. +mkGe :: Context -> AST -> AST -> IO AST +mkGe = liftFun2 z3_mk_ge + +-- | Coerce an integer to a real. +mkInt2Real :: Context -> AST -> IO AST +mkInt2Real = liftFun1 z3_mk_int2real + +-- | Coerce a real to an integer. +mkReal2Int :: Context -> AST -> IO AST +mkReal2Int = liftFun1 z3_mk_real2int + +-- | Check if a real number is an integer. +mkIsInt :: Context -> AST -> IO AST +mkIsInt = liftFun1 z3_mk_is_int + +--------------------------------------------------------------------- +-- Bit-vectors + +-- | Bitwise negation. +mkBvnot :: Context -> AST -> IO AST +mkBvnot = liftFun1 z3_mk_bvnot + +-- | Take conjunction of bits in vector, return vector of length 1. +mkBvredand :: Context -> AST -> IO AST +mkBvredand = liftFun1 z3_mk_bvredand + +-- | Take disjunction of bits in vector, return vector of length 1. +mkBvredor :: Context -> AST -> IO AST +mkBvredor = liftFun1 z3_mk_bvredor + +-- | Bitwise and. +mkBvand :: Context -> AST -> AST -> IO AST +mkBvand = liftFun2 z3_mk_bvand + +-- | Bitwise or. +mkBvor :: Context -> AST -> AST -> IO AST +mkBvor = liftFun2 z3_mk_bvor + +-- | Bitwise exclusive-or. +mkBvxor :: Context -> AST -> AST -> IO AST +mkBvxor = liftFun2 z3_mk_bvxor + +-- | Bitwise nand. +mkBvnand :: Context -> AST -> AST -> IO AST +mkBvnand = liftFun2 z3_mk_bvnand + +-- | Bitwise nor. +mkBvnor :: Context -> AST -> AST -> IO AST +mkBvnor = liftFun2 z3_mk_bvnor + +-- | Bitwise xnor. +mkBvxnor :: Context -> AST -> AST -> IO AST +mkBvxnor = liftFun2 z3_mk_bvxnor + +-- | Standard two's complement unary minus. +mkBvneg :: Context -> AST -> IO AST +mkBvneg = liftFun1 z3_mk_bvneg + +-- | Standard two's complement addition. +mkBvadd :: Context -> AST -> AST -> IO AST +mkBvadd = liftFun2 z3_mk_bvadd + +-- | Standard two's complement subtraction. +mkBvsub :: Context -> AST -> AST -> IO AST +mkBvsub = liftFun2 z3_mk_bvsub + +-- | Standard two's complement multiplication. +mkBvmul :: Context -> AST -> AST -> IO AST +mkBvmul = liftFun2 z3_mk_bvmul + +-- | Unsigned division. +mkBvudiv :: Context -> AST -> AST -> IO AST +mkBvudiv = liftFun2 z3_mk_bvudiv + +-- | Two's complement signed division. +mkBvsdiv :: Context -> AST -> AST -> IO AST +mkBvsdiv = liftFun2 z3_mk_bvsdiv + +-- | Unsigned remainder. +mkBvurem :: Context -> AST -> AST -> IO AST +mkBvurem = liftFun2 z3_mk_bvurem + +-- | Two's complement signed remainder (sign follows dividend). +mkBvsrem :: Context -> AST -> AST -> IO AST +mkBvsrem = liftFun2 z3_mk_bvsrem + +-- | Two's complement signed remainder (sign follows divisor). +mkBvsmod :: Context -> AST -> AST -> IO AST +mkBvsmod = liftFun2 z3_mk_bvsmod + +-- | Unsigned less than. +mkBvult :: Context -> AST -> AST -> IO AST +mkBvult = liftFun2 z3_mk_bvult + +-- | Two's complement signed less than. +mkBvslt :: Context -> AST -> AST -> IO AST +mkBvslt = liftFun2 z3_mk_bvslt + +-- | Unsigned less than or equal to. +mkBvule :: Context -> AST -> AST -> IO AST +mkBvule = liftFun2 z3_mk_bvule + +-- | Two's complement signed less than or equal to. +mkBvsle :: Context -> AST -> AST -> IO AST +mkBvsle = liftFun2 z3_mk_bvsle + +-- | Unsigned greater than or equal to. +mkBvuge :: Context -> AST -> AST -> IO AST +mkBvuge = liftFun2 z3_mk_bvuge + +-- | Two's complement signed greater than or equal to. +mkBvsge :: Context -> AST -> AST -> IO AST +mkBvsge = liftFun2 z3_mk_bvsge + +-- | Unsigned greater than. +mkBvugt :: Context -> AST -> AST -> IO AST +mkBvugt = liftFun2 z3_mk_bvugt + +-- | Two's complement signed greater than. +mkBvsgt :: Context -> AST -> AST -> IO AST +mkBvsgt = liftFun2 z3_mk_bvsgt + +-- | Concatenate the given bit-vectors. +mkConcat :: Context -> AST -> AST -> IO AST +mkConcat = liftFun2 z3_mk_concat + +-- | Extract the bits high down to low from a bitvector of size m to yield a new +-- bitvector of size /n/, where /n = high - low + 1/. +mkExtract :: Context -> Int -> Int -> AST -> IO AST +mkExtract = liftFun3 z3_mk_extract + +-- | Sign-extend of the given bit-vector to the (signed) equivalent bitvector +-- of size /m+i/, where /m/ is the size of the given bit-vector. +mkSignExt :: Context -> Int -> AST -> IO AST +mkSignExt = liftFun2 z3_mk_sign_ext + +-- | Extend the given bit-vector with zeros to the (unsigned) equivalent +-- bitvector of size /m+i/, where /m/ is the size of the given bit-vector. +mkZeroExt :: Context -> Int -> AST -> IO AST +mkZeroExt = liftFun2 z3_mk_zero_ext + +-- | Repeat the given bit-vector up length /i/. +mkRepeat :: Context -> Int -> AST -> IO AST +mkRepeat = liftFun2 z3_mk_repeat + +-- | Shift left. +mkBvshl :: Context -> AST -> AST -> IO AST +mkBvshl = liftFun2 z3_mk_bvshl + +-- | Logical shift right. +mkBvlshr :: Context -> AST -> AST -> IO AST +mkBvlshr = liftFun2 z3_mk_bvlshr + +-- | Arithmetic shift right. +mkBvashr :: Context -> AST -> AST -> IO AST +mkBvashr = liftFun2 z3_mk_bvashr + +-- | Rotate bits of /t1/ to the left /i/ times. +mkRotateLeft :: Context -> Int -> AST -> IO AST +mkRotateLeft = liftFun2 z3_mk_rotate_left + +-- | Rotate bits of /t1/ to the right /i/ times. +mkRotateRight :: Context -> Int -> AST -> IO AST +mkRotateRight = liftFun2 z3_mk_rotate_right + +-- | Rotate bits of /t1/ to the left /t2/ times. +mkExtRotateLeft :: Context -> AST -> AST -> IO AST +mkExtRotateLeft = liftFun2 z3_mk_ext_rotate_left + +-- | Rotate bits of /t1/ to the right /t2/ times. +mkExtRotateRight :: Context -> AST -> AST -> IO AST +mkExtRotateRight = liftFun2 z3_mk_ext_rotate_right + +-- | Create an /n/ bit bit-vector from the integer argument /t1/. +mkInt2bv :: Context -> Int -> AST -> IO AST +mkInt2bv = liftFun2 z3_mk_int2bv + +-- | Create an integer from the bit-vector argument /t1/. +-- +-- If /is_signed/ is false, then the bit-vector /t1/ is treated as unsigned. +-- So the result is non-negative and in the range [0..2^/N/-1], +-- where /N/ are the number of bits in /t1/. +-- If /is_signed/ is true, /t1/ is treated as a signed bit-vector. +mkBv2int :: Context -> AST -> Bool -> IO AST +mkBv2int = liftFun2 z3_mk_bv2int + +-- | Create a predicate that checks that the bit-wise addition of /t1/ and /t2/ +-- does not overflow. +mkBvaddNoOverflow :: Context -> AST -> AST -> Bool -> IO AST +mkBvaddNoOverflow = liftFun3 z3_mk_bvadd_no_overflow + +-- | Create a predicate that checks that the bit-wise signed addition of /t1/ +-- and /t2/ does not underflow. +mkBvaddNoUnderflow :: Context -> AST -> AST -> IO AST +mkBvaddNoUnderflow = liftFun2 z3_mk_bvadd_no_underflow + +-- | Create a predicate that checks that the bit-wise signed subtraction of /t1/ +-- and /t2/ does not overflow. +mkBvsubNoOverflow :: Context -> AST -> AST -> IO AST +mkBvsubNoOverflow = liftFun2 z3_mk_bvsub_no_overflow + +-- | Create a predicate that checks that the bit-wise subtraction of /t1/ and +-- /t2/ does not underflow. +mkBvsubNoUnderflow :: Context -> AST -> AST -> IO AST +mkBvsubNoUnderflow = liftFun2 z3_mk_bvsub_no_underflow + +-- | Create a predicate that checks that the bit-wise signed division of /t1/ +-- and /t2/ does not overflow. +mkBvsdivNoOverflow :: Context -> AST -> AST -> IO AST +mkBvsdivNoOverflow = liftFun2 z3_mk_bvsdiv_no_overflow + +-- | Check that bit-wise negation does not overflow when /t1/ is interpreted as +-- a signed bit-vector. +mkBvnegNoOverflow :: Context -> AST -> IO AST +mkBvnegNoOverflow = liftFun1 z3_mk_bvneg_no_overflow + +-- | Create a predicate that checks that the bit-wise multiplication of /t1/ and +-- /t2/ does not overflow. +mkBvmulNoOverflow :: Context -> AST -> AST -> Bool -> IO AST +mkBvmulNoOverflow = liftFun3 z3_mk_bvmul_no_overflow + +-- | Create a predicate that checks that the bit-wise signed multiplication of +-- /t1/ and /t2/ does not underflow. +mkBvmulNoUnderflow :: Context -> AST -> AST -> IO AST +mkBvmulNoUnderflow = liftFun2 z3_mk_bvmul_no_underflow + +--------------------------------------------------------------------- +-- Arrays + +-- | Array read. The argument a is the array and i is the index of the array +-- that gets read. +mkSelect :: Context + -> AST -- ^ Array. + -> AST -- ^ Index of the array to read. + -> IO AST +mkSelect = liftFun2 z3_mk_select + +-- | Array update. +-- +-- The result of this function is an array that is equal to the input array +-- (with respect to select) on all indices except for i, where it maps to v. +-- +-- The semantics of this function is given by the theory of arrays described +-- in the SMT-LIB standard. See for more details. +mkStore :: Context + -> AST -- ^ Array. + -> AST -- ^ Index /i/ of the array. + -> AST -- ^ New value for /i/. + -> IO AST +mkStore = liftFun3 z3_mk_store + +-- | Create the constant array. +-- +-- The resulting term is an array, such that a select on an arbitrary index +-- produces the value /v/. +mkConstArray :: Context + -> Sort -- ^ Domain sort of the array. + -> AST -- ^ Value /v/ that the array maps to. + -> IO AST +mkConstArray = liftFun2 z3_mk_const_array + +-- | Map a function /f/ on the the argument arrays. +-- +-- The /n/ nodes args must be of array sorts [domain -> range_i]. +-- The function declaration /f/ must have type range_1 .. range_n -> range. +-- The sort of the result is [domain -> range]. +mkMap :: Context + -> FuncDecl -- ^ Function /f/. + -> [AST] -- ^ List of arrays. + -> IO AST +mkMap ctx fun args = marshal z3_mk_map ctx $ \f -> + h2c fun $ \funPtr -> + marshalArrayLen args $ \argsNum argsArr -> + f funPtr argsNum argsArr + +-- | Access the array default value. +-- +-- Produces the default range value, for arrays that can be represented as +-- finite maps with a default range value. +mkArrayDefault :: Context + -> AST -- ^ Array. + -> IO AST +mkArrayDefault = liftFun1 z3_mk_array_default + +--------------------------------------------------------------------- +-- Sets + +-- TODO: Sets + +--------------------------------------------------------------------- +-- * Numerals + +-- | Create a numeral of a given sort. +mkNumeral :: Context -> String -> Sort -> IO AST +mkNumeral = liftFun2 z3_mk_numeral + +-- | Create a real from a fraction. +mkReal :: Context -> Int -- ^ numerator + -> Int -- ^ denominator (/= 0) + -> IO AST +mkReal ctx num den + | den /= 0 = liftFun2 z3_mk_real ctx num den + | otherwise = error "Z3.Base.mkReal: zero denominator" + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +-- +-- This function can be use to create numerals that fit in a +-- /machine integer/. +-- It is slightly faster than 'mkNumeral' since it is not necessary +-- to parse a string. +mkInt :: Context -> Int -> Sort -> IO AST +mkInt = liftFun2 z3_mk_int + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +-- +-- This function can be use to create numerals that fit in a +-- /machine unsigned integer/. +-- It is slightly faster than 'mkNumeral' since it is not necessary +-- to parse a string. +mkUnsignedInt :: Context -> Word -> Sort -> IO AST +mkUnsignedInt = liftFun2 z3_mk_unsigned_int + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +-- +-- This function can be use to create numerals that fit in a +-- /machine 64-bit integer/. +-- It is slightly faster than 'mkNumeral' since it is not necessary +-- to parse a string. +mkInt64 :: Context -> Int64 -> Sort -> IO AST +mkInt64 = liftFun2 z3_mk_int64 + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +-- +-- This function can be use to create numerals that fit in a +-- /machine unsigned 64-bit integer/. +-- It is slightly faster than 'mkNumeral' since it is not necessary +-- to parse a string. +mkUnsignedInt64 :: Context -> Word64 -> Sort -> IO AST +mkUnsignedInt64 = liftFun2 z3_mk_unsigned_int64 + +------------------------------------------------- +-- ** Helpers + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +mkIntegral :: Integral a => Context -> a -> Sort -> IO AST +mkIntegral c n s = mkNumeral c n_str s + where n_str = show $ toInteger n + +-- | Create a numeral of sort /real/ from a 'Rational'. +mkRational :: Context -> Rational -> IO AST +mkRational = mkRealNum + +-- | Create a numeral of sort /real/ from a 'Fixed'. +mkFixed :: HasResolution a => Context -> Fixed a -> IO AST +mkFixed ctx = mkRational ctx . toRational + +-- | Create a numeral of sort /real/ from a 'Real'. +mkRealNum :: Real r => Context -> r -> IO AST +mkRealNum c n = mkNumeral c n_str =<< mkRealSort c + where r = toRational n + r_n = toInteger $ numerator r + r_d = toInteger $ denominator r + n_str = show r_n ++ " / " ++ show r_d + +-- | Create a numeral of sort /int/ from an 'Integer'. +mkInteger :: Context -> Integer -> IO AST +mkInteger = mkIntNum + +-- | Create a numeral of sort /int/ from an 'Integral'. +mkIntNum :: Integral a => Context -> a -> IO AST +mkIntNum ctx n = mkIntegral ctx n =<< mkIntSort ctx + +-- | Create a numeral of sort /Bit-vector/ from an 'Integer'. +mkBitvector :: Context -> Int -- ^ bit-width + -> Integer -- ^ integer value + -> IO AST +mkBitvector = mkBvNum + +-- | Create a numeral of sort /Bit-vector/ from an 'Integral'. +mkBvNum :: Integral i => Context -> Int -- ^ bit-width + -> i -- ^ integer value + -> IO AST +mkBvNum ctx s n = mkIntegral ctx n =<< mkBvSort ctx s + +--------------------------------------------------------------------- +-- Quantifiers + +-- | Create a pattern for quantifier instantiation. +-- +-- Z3 uses pattern matching to instantiate quantifiers. +-- If a pattern is not provided for a quantifier, then Z3 will automatically +-- compute a set of patterns for it. However, for optimal performance, +-- the user should provide the patterns. +-- +-- Patterns comprise a list of terms. +-- The list should be non-empty. +-- If the list comprises of more than one term, it is a called a multi-pattern. +-- +-- In general, one can pass in a list of (multi-)patterns in the quantifier +-- constructor. +mkPattern :: Context + -> [AST] -- ^ Terms. + -> IO Pattern +mkPattern _ [] = error "Z3.Base.mkPattern: empty list of expressions" +mkPattern c es = marshal z3_mk_pattern c $ marshalArrayLen es + +-- | Create a bound variable. +-- +-- Bound variables are indexed by de-Bruijn indices. +-- +-- See +mkBound :: Context + -> Int -- ^ de-Bruijn index. + -> Sort + -> IO AST +mkBound c i s + | i >= 0 = liftFun2 z3_mk_bound c i s + | otherwise = error "Z3.Base.mkBound: negative de-Bruijn index" + +type MkZ3Quantifier = Ptr Z3_context -> CUInt + -> CUInt -> Ptr (Ptr Z3_pattern) + -> CUInt -> Ptr (Ptr Z3_sort) -> Ptr (Ptr Z3_symbol) + -> Ptr Z3_ast + -> IO (Ptr Z3_ast) + +-- TODO: Allow the user to specify the quantifier weight! +marshalMkQ :: MkZ3Quantifier + -> Context + -> [Pattern] + -> [Symbol] + -> [Sort] + -> AST + -> IO AST +marshalMkQ z3_mk_Q ctx pats x s body = marshal z3_mk_Q ctx $ \f -> + marshalArrayLen pats $ \n patsArr -> + marshalArray x $ \xArr -> + marshalArray s $ \sArr -> + h2c body $ \bodyPtr -> + f 0 n patsArr len sArr xArr bodyPtr + where len + | l == 0 = error "Z3.Base.mkQuantifier:\ + \ quantifier with 0 bound variables" + | l /= length x = error "Z3.Base.mkQuantifier:\ + \ different number of symbols and sorts" + | otherwise = fromIntegral l + where l = length s + +-- | Create a forall formula. +-- +-- The bound variables are de-Bruijn indices created using 'mkBound'. +-- +-- Z3 applies the convention that the last element in /xs/ refers to the +-- variable with index 0, the second to last element of /xs/ refers to the +-- variable with index 1, etc. +mkForall :: Context + -> [Pattern] -- ^ Instantiation patterns (see 'mkPattern'). + -> [Symbol] -- ^ Bound (quantified) variables /xs/. + -> [Sort] -- ^ Sorts of the bound variables. + -> AST -- ^ Body of the quantifier. + -> IO AST +mkForall = marshalMkQ z3_mk_forall + +-- | Create an exists formula. +-- +-- Similar to 'mkForall'. +mkExists :: Context -> [Pattern] -> [Symbol] -> [Sort] -> AST -> IO AST +mkExists = marshalMkQ z3_mk_exists + +-- TODO: Z3_mk_quantifier +-- TODO: Z3_mk_quantifier_ex + +type MkZ3QuantifierConst = Ptr Z3_context + -> CUInt + -> CUInt + -> Ptr (Ptr Z3_app) + -> CUInt + -> Ptr (Ptr Z3_pattern) + -> Ptr Z3_ast + -> IO (Ptr Z3_ast) + +marshalMkQConst :: MkZ3QuantifierConst + -> Context + -> [Pattern] + -> [App] + -> AST + -> IO AST +marshalMkQConst z3_mk_Q_const ctx pats apps body = + marshal z3_mk_Q_const ctx $ \f -> + marshalArrayLen pats $ \patsNum patsArr -> + marshalArray apps $ \appsArr -> + h2c body $ \bodyPtr -> + f 0 len appsArr patsNum patsArr bodyPtr + where len + | l == 0 = error "Z3.Base.mkQuantifierConst:\ + \ quantifier with 0 bound variables" + | otherwise = fromIntegral l + where l = length apps +-- TODO: Allow the user to specify the quantifier weight! + +-- | Create a universal quantifier using a list of constants that will form the +-- set of bound variables. +mkForallConst :: Context + -> [Pattern] -- ^ Instantiation patterns (see 'mkPattern'). + -> [App] -- ^ Constants to be abstracted into bound variables. + -> AST -- ^ Quantifier body. + -> IO AST +mkForallConst = marshalMkQConst z3_mk_forall_const + +-- | Create a existential quantifier using a list of constants that will form +-- the set of bound variables. +mkExistsConst :: Context + -> [Pattern] -- ^ Instantiation patterns (see 'mkPattern'). + -> [App] -- ^ Constants to be abstracted into bound variables. + -> AST -- ^ Quantifier body. + -> IO AST +mkExistsConst = marshalMkQConst z3_mk_exists_const + +-- TODO: Z3_mk_quantifier_const +-- TODO: Z3_mk_quantifier_const_ex + +--------------------------------------------------------------------- +-- Accessors + +-- TODO: Z3_get_symbol_kind + +-- TODO: Z3_get_symbol_int + +-- | Return the symbol name. +getSymbolString :: Context -> Symbol -> IO String +getSymbolString = liftFun1 z3_get_symbol_string + +-- TODO: Z3_get_sort_name + +-- TODO: Z3_get_sort_id + +-- TODO: Z3_sort_to_ast + +-- TODO: Z3_is_eq_sort + +-- TODO: Z3_get_sort_kind + +-- | Return the size of the given bit-vector sort. +getBvSortSize :: Context -> Sort -> IO Int +getBvSortSize = liftFun1 z3_get_bv_sort_size + +-- TODO: Z3_get_finite_domain_sort_size + +-- TODO: Z3_get_array_sort_size + +-- TODO: Z3_get_array_sort_range + +-- TODO: Z3_get_tuple_sort_mk_decl + +-- TODO: Z3_get_tuple_sort_num_fields + +-- TODO: Z3_get_tuple_sort_field_decl + +-- TODO: Needs proper review +-- | Get list of constructors for datatype. +getDatatypeSortConstructors :: Context + -> Sort -- ^ Datatype sort. + -> IO [FuncDecl] -- ^ Constructor declarations. +getDatatypeSortConstructors c dtSort = + withContextError c $ \cPtr -> + h2c dtSort $ \dtSortPtr -> do + numCons <- z3_get_datatype_sort_num_constructors cPtr dtSortPtr + T.mapM (getConstructor cPtr dtSortPtr) [0..(numCons-1)] + where + getConstructor cPtr dtSortPtr idx = do + funcDeclPtr <- z3_get_datatype_sort_constructor cPtr dtSortPtr idx + c2h c funcDeclPtr + +-- TODO: Needs proper review +-- | Get list of recognizers for datatype. +getDatatypeSortRecognizers :: Context + -> Sort -- ^ Datatype sort. + -> IO [FuncDecl] -- ^ Constructor recognizers. +getDatatypeSortRecognizers c dtSort = + withContextError c $ \cPtr -> + h2c dtSort $ \dtSortPtr -> do + numCons <- z3_get_datatype_sort_num_constructors cPtr dtSortPtr + T.mapM (getConstructor cPtr dtSortPtr) [0..(numCons-1)] + where + -- TODO: Maybe this should be renamed to getRecognizer :-) + getConstructor cPtr dtSortPtr idx = do + funcDeclPtr <- z3_get_datatype_sort_recognizer cPtr dtSortPtr idx + c2h c funcDeclPtr + +-- TODO: Z3_get_datatype_sort_constructor_accessor + +-- TODO: Z3_get_relation_arity + +-- TODO: Z3_get_relation_column + +-- TODO: Z3_func_decl_to_ast + +-- TODO: Z3_is_eq_func_decl + +-- TODO: Z3_get_func_decl_id + +-- | Return the constant declaration name as a symbol. +getDeclName :: Context -> FuncDecl -> IO Symbol +getDeclName c decl = withContextError c $ \cPtr -> + h2c decl $ \declPtr -> + Symbol <$> z3_get_decl_name cPtr declPtr + +-- TODO: Z3_get_decl_kind + +-- TODO: Z3_get_domain_size + +-- TODO: Z3_get_range + +-- TODO: Z3_get_decl_num_parameters + +-- TODO: Z3_get_decl_parameter_kind + +-- TODO: Z3_get_decl_int_parameter + +-- TODO: Z3_get_decl_double_parameter + +-- TODO: Z3_get_decl_symbol_parameter + +-- TODO: Z3_get_decl_sort_parameter + +-- TODO: Z3_get_decl_ast_parameter + +-- TODO: Z3_get_decl_func_decl_parameter + +-- TODO: Z3_get_decl_rational_parameter + +-- TODO: Z3_app_to_ast + +-- TODO: Z3_get_app_decl + +-- TODO: Z3_get_app_num_args + +-- TODO: Z3_get_app_arg + +-- TODO: Z3_is_eq_ast + +-- TODO: Z3_get_ast_id + +-- TODO: Z3_get_ast_hash + +-- | Return the sort of an AST node. +getSort :: Context -> AST -> IO Sort +getSort = liftFun1 z3_get_sort + +-- TODO: Z3_is_well_sorted + +-- TODO: fix doc +-- | Return Z3_L_TRUE if a is true, Z3_L_FALSE if it is false, and Z3_L_UNDEF +-- otherwise. +getBoolValue :: Context -> AST -> IO (Maybe Bool) +getBoolValue c a = withContextError c $ \cPtr -> + h2c a $ \astPtr -> + castLBool <$> z3_get_bool_value cPtr astPtr + where castLBool :: Z3_lbool -> Maybe Bool + castLBool lb + | lb == z3_l_true = Just True + | lb == z3_l_false = Just False + | lb == z3_l_undef = Nothing + | otherwise = + error "Z3.Base.castLBool: illegal `Z3_lbool' value" + +-- | Return the kind of the given AST. +getAstKind :: Context -> AST -> IO ASTKind +getAstKind ctx ast = toAstKind <$> liftFun1 z3_get_ast_kind ctx ast + where toAstKind :: Z3_ast_kind -> ASTKind + toAstKind k + | k == z3_numeral_ast = Z3_NUMERAL_AST + | k == z3_app_ast = Z3_APP_AST + | k == z3_var_ast = Z3_VAR_AST + | k == z3_quantifier_ast = Z3_QUANTIFIER_AST + | k == z3_sort_ast = Z3_SORT_AST + | k == z3_func_decl_ast = Z3_FUNC_DECL_AST + | k == z3_unknown_ast = Z3_UNKNOWN_AST + | otherwise = + error "Z3.Base.getAstKind: unknown `Z3_ast_kind'" + +-- TODO: Z3_is_app + +-- TODO: Z3_is_numeral_ast + +-- TODO: Z3_is_algebraic_number + +-- | Convert an ast into an APP_AST. This is just type casting. +toApp :: Context -> AST -> IO App +toApp = liftFun1 z3_to_app + +-- TODO: Z3_to_func_decl + +-- | Return numeral value, as a string of a numeric constant term. +getNumeralString :: Context -> AST -> IO String +getNumeralString = liftFun1 z3_get_numeral_string + +-- TODO: Z3_get_numeral_decimal_string + +-- TODO: Z3_get_numerator + +-- TODO: Z3_get_denominator + +-- TODO: Z3_get_numeral_small + +-- TODO: Z3_get_numeral_int + +-- TODO: Z3_get_numeral_int + +-- TODO: Z3_get_numeral_uint + +-- TODO: Z3_get_numeral_uint64 + +-- TODO: Z3_get_numeral_int64 + +-- TODO: Z3_get_numeral_rational_int64 + +-- TODO: Z3_get_algebraic_number_lower + +-- TODO: Z3_get_algebraic_number_upper + +-- TODO: Z3_pattern_to_ast + +-- TODO: Z3_get_pattern_num_terms + +-- TODO: Z3_get_pattern + +-- TODO: Z3_get_index_value + +-- TODO: Z3_is_quantifier_forall + +-- TODO: Z3_get_quantifier_weight + +-- TODO: Z3_get_quantifier_num_patterns + +-- TODO: Z3_get_quantifier_pattern_ast + +-- TODO: Z3_get_quantifier_num_no_patterns + +-- TODO: Z3_get_quantifier_no_pattern_ast + +-- TODO: Z3_get_quantifier_num_bound + +-- TODO: Z3_get_quantifier_bound_name + +-- TODO: Z3_get_quantifier_bound_sort + +-- TODO: Z3_get_quantifier_body + +-- TODO: Z3_simplify + +-- TODO: Z3_simplify_ex + +-- TODO: Z3_simplify_get_help + +-- TODO: Z3_simplify_get_param_descrs + +------------------------------------------------- +-- ** Helpers + +-- | Read a 'Bool' value from an 'AST' +getBool :: Context -> AST -> IO Bool +getBool c a = fromJust <$> getBoolValue c a + -- TODO: throw an custom error if Nothing? + -- TODO: Refactor castLBool? + +-- | Read an 'Integer' value from an 'AST' +getInt :: Context -> AST -> IO Integer +getInt c a = read <$> getNumeralString c a + +-- | Read a 'Rational' value from an 'AST' +getReal :: Context -> AST -> IO Rational +getReal c a = parse <$> getNumeralString c a + where parse :: String -> Rational + parse s + | [(i, sj)] <- reads s = i % parseDen (dropWhile (== ' ') sj) + | otherwise = error "Z3.Base.getReal: no parse" + + parseDen :: String -> Integer + parseDen "" = 1 + parseDen ('/':sj) = read sj + parseDen _ = error "Z3.Base.getReal: no parse" + +-- | Read the 'Integer' value from an 'AST' of sort /bit-vector/. +-- +-- See 'mkBv2int'. +getBv :: Context -> AST + -> Bool -- ^ signed? + -> IO Integer +getBv c a signed = getInt c =<< mkBv2int c a signed + +--------------------------------------------------------------------- +-- Modifiers + +-- TODO Modifiers + +--------------------------------------------------------------------- +-- Models + +-- | Evaluate an AST node in the given model. +-- +-- The evaluation may fail for the following reasons: +-- +-- * /t/ contains a quantifier. +-- * the model /m/ is partial. +-- * /t/ is type incorrect. +modelEval :: Context + -> Model -- ^ Model /m/. + -> AST -- ^ Expression to evaluate /t/. + -> IO (Maybe AST) +modelEval ctx m a = + withContext ctx $ \ctxPtr -> + alloca $ \aptr2 -> + h2c a $ \astPtr -> + h2c m $ \mPtr -> + checkError ctxPtr $ + z3_eval ctxPtr mPtr astPtr aptr2 >>= peekAST aptr2 . toBool + where peekAST :: Ptr (Ptr Z3_ast) -> Bool -> IO (Maybe AST) + peekAST _p False = return Nothing + peekAST p True = fmap Just . c2h ctx =<< peek p + +-- TODO: Z3_model_get_const_interp + +-- TODO: Z3_model_has_interp + +-- | Evaluate an array as a function, if possible. +evalArray :: Context -> Model -> AST -> IO (Maybe FuncModel) +evalArray ctx model array = + do -- The array must first be evaluated normally, to get it into + -- 'as-array' form, which is required to acquire the FuncDecl. + evaldArrayMb <- eval ctx model array + case evaldArrayMb of + Nothing -> return Nothing + Just evaldArray -> + do canConvert <- isAsArray ctx evaldArray + if canConvert + then + do arrayDecl <- getAsArrayFuncDecl ctx evaldArray + evalFunc ctx model arrayDecl + else return Nothing + + +-- | Return the function declaration f associated with a (_ as_array f) node. +getAsArrayFuncDecl :: Context -> AST -> IO FuncDecl +getAsArrayFuncDecl = liftFun1 z3_get_as_array_func_decl + +-- | The (_ as-array f) AST node is a construct for assigning interpretations +-- for arrays in Z3. It is the array such that forall indices i we have that +-- (select (_ as-array f) i) is equal to (f i). This procedure returns Z3_TRUE +-- if the a is an as-array AST node. +isAsArray :: Context -> AST -> IO Bool +isAsArray = liftFun1 z3_is_as_array + + +getMapFromInterp :: Context -> FuncInterp -> IO [([AST], AST)] +getMapFromInterp ctx interp = + do n <- funcInterpGetNumEntries ctx interp + entries <- mapM (funcInterpGetEntry ctx interp) [0..n-1] + mapM (getEntry ctx) entries + +getEntry :: Context -> FuncEntry -> IO ([AST], AST) +getEntry ctx entry = + do val <- funcEntryGetValue ctx entry + args <- getEntryArgs ctx entry + return (args, val) + +getEntryArgs :: Context -> FuncEntry -> IO [AST] +getEntryArgs ctx entry = + do n <- funcEntryGetNumArgs ctx entry + mapM (funcEntryGetArg ctx entry) [0..n-1] + +-- | Return the interpretation of the function f in the model m. +-- Return NULL, if the model does not assign an interpretation for f. +-- That should be interpreted as: the f does not matter. +getFuncInterp :: Context -> Model -> FuncDecl -> IO (Maybe FuncInterp) +getFuncInterp ctx m fd = marshal z3_model_get_func_interp ctx $ \f -> + h2c m $ \mPtr -> + h2c fd $ \fdPtr -> + f mPtr fdPtr + +-- | Return the number of entries in the given function interpretation. +funcInterpGetNumEntries :: Context -> FuncInterp -> IO Int +funcInterpGetNumEntries = liftFun1 z3_func_interp_get_num_entries + +-- | Return a _point_ of the given function intepretation. +-- It represents the value of f in a particular point. +funcInterpGetEntry :: Context -> FuncInterp -> Int -> IO FuncEntry +funcInterpGetEntry = liftFun2 z3_func_interp_get_entry + +-- | Return the 'else' value of the given function interpretation. +funcInterpGetElse :: Context -> FuncInterp -> IO AST +funcInterpGetElse = liftFun1 z3_func_interp_get_else + +-- | Return the arity (number of arguments) of the given function +-- interpretation. +funcInterpGetArity :: Context -> FuncInterp -> IO Int +funcInterpGetArity = liftFun1 z3_func_interp_get_arity + +-- | Return the value of this point. +funcEntryGetValue :: Context -> FuncEntry -> IO AST +funcEntryGetValue = liftFun1 z3_func_entry_get_value + +-- | Return the number of arguments in a Z3_func_entry object. +funcEntryGetNumArgs :: Context -> FuncEntry -> IO Int +funcEntryGetNumArgs = liftFun1 z3_func_entry_get_num_args + +-- | Return an argument of a Z3_func_entry object. +funcEntryGetArg :: Context -> FuncEntry -> Int -> IO AST +funcEntryGetArg = liftFun2 z3_func_entry_get_arg + +-- | Convert the given model into a string. +modelToString :: Context -> Model -> IO String +modelToString = liftFun1 z3_model_to_string + +-- | Alias for 'modelToString'. +showModel :: Context -> Model -> IO String +showModel = modelToString +{-# DEPRECATED showModel "Use modelToString instead." #-} + +------------------------------------------------- +-- ** Helpers + +-- | Type of an evaluation function for 'AST'. +-- +-- Evaluation may fail (i.e. return 'Nothing') for a few +-- reasons, see 'modelEval'. +type EvalAst a = Model -> AST -> IO (Maybe a) + +-- | An alias for 'modelEval'. +eval :: Context -> EvalAst AST +eval = modelEval + +-- | Evaluate an AST node of sort /bool/ in the given model. +-- +-- See 'modelEval' and 'getBool'. +evalBool :: Context -> EvalAst Bool +evalBool ctx m ast = eval ctx m ast >>= T.traverse (getBool ctx) + +-- | Evaluate an AST node of sort /int/ in the given model. +-- +-- See 'modelEval' and 'getInt'. +evalInt :: Context -> EvalAst Integer +evalInt ctx m ast = eval ctx m ast >>= T.traverse (getInt ctx) + +-- | Evaluate an AST node of sort /real/ in the given model. +-- +-- See 'modelEval' and 'getReal'. +evalReal :: Context -> EvalAst Rational +evalReal ctx m ast = eval ctx m ast >>= T.traverse (getReal ctx) + +-- | Evaluate an AST node of sort /bit-vector/ in the given model. +-- +-- The flag /signed/ decides whether the bit-vector value is +-- interpreted as a signed or unsigned integer. +-- +-- See 'modelEval' and 'getBv'. +evalBv :: Context -> Bool -- ^ signed? + -> EvalAst Integer +evalBv ctx signed m ast = + eval ctx m ast >>= T.traverse (\a -> getBv ctx a signed) + +-- | Evaluate a /collection/ of AST nodes in the given model. +evalT :: Traversable t => Context -> Model -> t AST -> IO (Maybe (t AST)) +evalT c = mapEval (eval c) + +-- | Run a evaluation function on a 'Traversable' data structure of 'AST's +-- (e.g. @[AST]@, @Vector AST@, @Maybe AST@, etc). +-- +-- This a generic version of 'evalT' which can be used in combination with +-- other helpers. For instance, @mapEval (evalInt c)@ can be used to obtain +-- the 'Integer' interpretation of a list of 'AST' of sort /int/. +mapEval :: Traversable t => EvalAst a -> Model -> t AST -> IO (Maybe (t a)) +mapEval f m = fmap T.sequence . T.mapM (f m) + +{- TODO: Parameterize FuncModel + +data FuncModel a b = FuncModel [([a], b)] b + +type FuncModelAST = FuncModel AST AST + +evalFuncWith :: Context -> Model -> EvalAst a -> EvalAst b -> FuncDecl -> IO (Maybe (FuncModel a b)) + +-} + +-- | The interpretation of a function. +data FuncModel = FuncModel + { interpMap :: [([AST], AST)] + -- ^ Mapping from arguments to values. + , interpElse :: AST + -- ^ Default value. + } + +-- | Evaluate a function declaration to a list of argument/value pairs. +evalFunc :: Context -> Model -> FuncDecl -> IO (Maybe FuncModel) +evalFunc ctx m fDecl = + do interpMb <- getFuncInterp ctx m fDecl + case interpMb of + Nothing -> return Nothing + Just interp -> + do funcMap <- getMapFromInterp ctx interp + elsePart <- funcInterpGetElse ctx interp + return (Just $ FuncModel funcMap elsePart) + +--------------------------------------------------------------------- +-- Interaction logging + +-- TODO + +--------------------------------------------------------------------- +-- String Conversion + +-- | Pretty-printing mode for converting ASTs to strings. The mode +-- can be one of the following: +-- +-- * Z3_PRINT_SMTLIB_FULL: Print AST nodes in SMTLIB verbose format. +-- +-- * Z3_PRINT_LOW_LEVEL: Print AST nodes using a low-level format. +-- +-- * Z3_PRINT_SMTLIB_COMPLIANT: Print AST nodes in SMTLIB 1.x +-- compliant format. +-- +-- * Z3_PRINT_SMTLIB2_COMPLIANT: Print AST nodes in SMTLIB 2.x +-- compliant format. +data ASTPrintMode + = Z3_PRINT_SMTLIB_FULL + | Z3_PRINT_LOW_LEVEL + | Z3_PRINT_SMTLIB_COMPLIANT + | Z3_PRINT_SMTLIB2_COMPLIANT + +-- | Set the pretty-printing mode for converting ASTs to strings. +setASTPrintMode :: Context -> ASTPrintMode -> IO () +setASTPrintMode ctx mode = withContextError ctx $ \ctxPtr -> + case mode of + Z3_PRINT_SMTLIB_FULL -> + z3_set_ast_print_mode ctxPtr z3_print_smtlib_full + Z3_PRINT_LOW_LEVEL -> + z3_set_ast_print_mode ctxPtr z3_print_low_level + Z3_PRINT_SMTLIB_COMPLIANT -> + z3_set_ast_print_mode ctxPtr z3_print_smtlib_compliant + Z3_PRINT_SMTLIB2_COMPLIANT -> + z3_set_ast_print_mode ctxPtr z3_print_smtlib2_compliant + +-- | Convert an AST to a string. +astToString :: Context -> AST -> IO String +astToString = liftFun1 z3_ast_to_string + +-- | Convert a pattern to a string. +patternToString :: Context -> Pattern -> IO String +patternToString = liftFun1 z3_pattern_to_string + +-- | Convert a sort to a string. +sortToString :: Context -> Sort -> IO String +sortToString = liftFun1 z3_sort_to_string + +-- | Convert a FuncDecl to a string. +funcDeclToString :: Context -> FuncDecl -> IO String +funcDeclToString = liftFun1 z3_func_decl_to_string + +-- | Convert the given benchmark into SMT-LIB formatted string. +-- +-- The output format can be configured via 'setASTPrintMode'. +benchmarkToSMTLibString :: Context + -> String -- ^ name + -> String -- ^ logic + -> String -- ^ status + -> String -- ^ attributes + -> [AST] -- ^ assumptions + -> AST -- ^ formula + -> IO String +benchmarkToSMTLibString ctx name logic status attr assump form = + marshal z3_benchmark_to_smtlib_string ctx $ \f -> + withCString name $ \namePtr -> + withCString logic $ \logicPtr -> + withCString status $ \statusPtr -> + withCString attr $ \attrPtr -> + marshalArrayLen assump $ \assumpNum assumpArr -> + h2c form $ \formPtr -> + f namePtr logicPtr statusPtr attrPtr assumpNum assumpArr formPtr + +--------------------------------------------------------------------- +-- Parser interface + +-- TODO + +--------------------------------------------------------------------- +-- Error handling + +-- | Z3 exceptions. +-- +-- Z3 errors are re-thrown as Haskell 'Z3Error' exceptions, +-- see 'Control.Exception'. +data Z3Error = Z3Error + { errCode :: Z3ErrorCode + , errMsg :: String + } + deriving Typeable + +instance Show Z3Error where + show (Z3Error _ s) = s + +-- | Z3 error codes. +data Z3ErrorCode = SortError | IOB | InvalidArg | ParserError | NoParser + | InvalidPattern | MemoutFail | FileAccessError | InternalFatal + | InvalidUsage | DecRefError | Z3Exception + deriving (Show, Typeable) + +toZ3Error :: Z3_error_code -> Z3ErrorCode +toZ3Error e + | e == z3_sort_error = SortError + | e == z3_iob = IOB + | e == z3_invalid_arg = InvalidArg + | e == z3_parser_error = ParserError + | e == z3_no_parser = NoParser + | e == z3_invalid_pattern = InvalidPattern + | e == z3_memout_fail = MemoutFail + | e == z3_file_access_error = FileAccessError + | e == z3_internal_fatal = InternalFatal + | e == z3_invalid_usage = InvalidUsage + | e == z3_dec_ref_error = DecRefError + | e == z3_exception = Z3Exception + | otherwise = error "Z3.Base.toZ3Error: illegal `Z3_error_code' value" + +instance Exception Z3Error + +-- | Throws a z3 error +z3Error :: Z3ErrorCode -> String -> IO () +z3Error cd = throw . Z3Error cd + +-- | Throw an exception if a Z3 error happened +checkError :: Ptr Z3_context -> IO a -> IO a +checkError cPtr m = do + m <* (z3_get_error_code cPtr >>= throwZ3Exn) + where getErrStr i = peekCString =<< z3_get_error_msg_ex cPtr i + throwZ3Exn i = when (i /= z3_ok) $ getErrStr i >>= z3Error (toZ3Error i) + +--------------------------------------------------------------------- +-- Miscellaneous + +data Version + = Version { + z3Major :: !Int + , z3Minor :: !Int + , z3Build :: !Int + , z3Revision :: !Int + } + deriving (Eq,Ord) + +instance Show Version where + show (Version major minor build _) = + show major ++ "." ++ show minor ++ "." ++ show build + +-- | Return Z3 version number information. +getVersion :: IO Version +getVersion = + alloca $ \ptrMinor -> + alloca $ \ptrMajor -> + alloca $ \ptrBuild -> + alloca $ \ptrRevision -> do + z3_get_version ptrMinor ptrMajor ptrBuild ptrRevision + minor <- fromIntegral <$> peek ptrMinor + major <- fromIntegral <$> peek ptrMajor + build <- fromIntegral <$> peek ptrBuild + revision <- fromIntegral <$> peek ptrRevision + return $ Version minor major build revision + +--------------------------------------------------------------------- +-- Externalm Theory Plugins + +-- TODO + +--------------------------------------------------------------------- +-- Fixedpoint facilities + +-- TODO + +-- AST vectors ? + +-- AST maps ? + +--------------------------------------------------------------------- +-- Goals + +-- TODO + +--------------------------------------------------------------------- +-- Tactics and Probes + +-- TODO + +--------------------------------------------------------------------- +-- Solvers + +-- | Solvers available in Z3. +-- +-- These are described at +data Logic + = AUFLIA + -- ^ Closed formulas over the theory of linear integer arithmetic + -- and arrays extended with free sort and function symbols but + -- restricted to arrays with integer indices and values. + + | AUFLIRA + -- ^ Closed linear formulas with free sort and function symbols over + -- one- and two-dimentional arrays of integer index and real + -- value. + + | AUFNIRA + -- ^ Closed formulas with free function and predicate symbols over a + -- theory of arrays of arrays of integer index and real value. + + | LRA + -- ^ Closed linear formulas in linear real arithmetic. + + | QF_ABV + -- ^ Closed quantifier-free formulas over the theory of bitvectors + -- and bitvector arrays. + + | QF_AUFBV + -- ^ Closed quantifier-free formulas over the theory of bitvectors + -- and bitvector arrays extended with free sort and function + -- symbols. + + | QF_AUFLIA + -- ^ Closed quantifier-free linear formulas over the theory of + -- integer arrays extended with free sort and function symbols. + + | QF_AX + -- ^ Closed quantifier-free formulas over the theory of arrays with + -- extensionality. + + | QF_BV + -- ^ Closed quantifier-free formulas over the theory of fixed-size + -- bitvectors. + + | QF_IDL + -- ^ Difference Logic over the integers. In essence, Boolean + -- combinations of inequations of the form x - y < b where x and y + -- are integer variables and b is an integer constant. + + | QF_LIA + -- ^ Unquantified linear integer arithmetic. In essence, Boolean + -- combinations of inequations between linear polynomials over + -- integer variables. + + | QF_LRA + -- ^ Unquantified linear real arithmetic. In essence, Boolean + -- combinations of inequations between linear polynomials over + -- real variables. + + | QF_NIA + -- ^ Quantifier-free integer arithmetic. + + | QF_NRA + -- ^ Quantifier-free real arithmetic. + + | QF_RDL + -- ^ Difference Logic over the reals. In essence, Boolean + -- combinations of inequations of the form x - y < b where x and y + -- are real variables and b is a rational constant. + + | QF_UF + -- ^ Unquantified formulas built over a signature of uninterpreted + -- (i.e., free) sort and function symbols. + + | QF_UFBV + -- ^ Unquantified formulas over bitvectors with uninterpreted sort + -- function and symbols. + + | QF_UFIDL + -- ^ Difference Logic over the integers (in essence) but with + -- uninterpreted sort and function symbols. + + | QF_UFLIA + -- ^ Unquantified linear integer arithmetic with uninterpreted sort + -- and function symbols. + + | QF_UFLRA + -- ^ Unquantified linear real arithmetic with uninterpreted sort and + -- function symbols. + + | QF_UFNRA + -- ^ Unquantified non-linear real arithmetic with uninterpreted sort + -- and function symbols. + + | UFLRA + -- ^ Linear real arithmetic with uninterpreted sort and function + -- symbols. + + | UFNIA + -- ^ Non-linear integer arithmetic with uninterpreted sort and + -- function symbols. + +instance Show Logic where + show AUFLIA = "AUFLIA" + show AUFLIRA = "AUFLIRA" + show AUFNIRA = "AUFNIRA" + show LRA = "LRA" + show QF_ABV = "QF_ABV" + show QF_AUFBV = "QF_AUFBV" + show QF_AUFLIA = "QF_AUFLIA" + show QF_AX = "QF_AX" + show QF_BV = "QF_BV" + show QF_IDL = "QF_IDL" + show QF_LIA = "QF_LIA" + show QF_LRA = "QF_LRA" + show QF_NIA = "QF_NIA" + show QF_NRA = "QF_NRA" + show QF_RDL = "QF_RDL" + show QF_UF = "QF_UF" + show QF_UFBV = "QF_UFBV" + show QF_UFIDL = "QF_UFIDL" + show QF_UFLIA = "QF_UFLIA" + show QF_UFLRA = "QF_UFLRA" + show QF_UFNRA = "QF_UFNRA" + show UFLRA = "UFLRA" + show UFNIA = "UFNIA" + +mkSolver :: Context -> IO Solver +mkSolver = liftFun0 z3_mk_solver + +mkSimpleSolver :: Context -> IO Solver +mkSimpleSolver = liftFun0 z3_mk_simple_solver + +mkSolverForLogic :: Context -> Logic -> IO Solver +mkSolverForLogic c logic = withContextError c $ \cPtr -> + do sym <- mkStringSymbol c (show logic) + c2h c =<< z3_mk_solver_for_logic cPtr (unSymbol sym) + +-- | Return a string describing all solver available parameters. +solverGetHelp :: Context -> Solver -> IO String +solverGetHelp = liftFun1 z3_solver_get_help + +-- | Set the given solver using the given parameters. +solverSetParams :: Context -> Solver -> Params -> IO () +solverSetParams = liftFun2 z3_solver_set_params + +solverPush :: Context -> Solver -> IO () +solverPush = liftFun1 z3_solver_push + +solverPop :: Context -> Solver -> Int -> IO () +solverPop = liftFun2 z3_solver_pop + +solverReset :: Context -> Solver -> IO () +solverReset = liftFun1 z3_solver_reset + +-- | Number of backtracking points. +solverGetNumScopes :: Context -> Solver -> IO Int +solverGetNumScopes = liftFun1 z3_solver_get_num_scopes + +solverAssertCnstr :: Context -> Solver -> AST -> IO () +solverAssertCnstr = liftFun2 z3_solver_assert + +solverAssertAndTrack :: Context -> Solver -> AST -> AST -> IO () +solverAssertAndTrack = liftFun3 z3_solver_assert_and_track + +-- | Check whether the assertions in a given solver are consistent or not. +solverCheck :: Context -> Solver -> IO Result +solverCheck ctx solver = marshal z3_solver_check ctx $ h2c solver + +-- | Check whether the assertions in the given solver and optional assumptions are consistent or not. +solverCheckAssumptions :: Context -> Solver -> [AST] -> IO Result +solverCheckAssumptions ctx solver assump = + marshal z3_solver_check_assumptions ctx $ \f -> + h2c solver $ \solverPtr -> + marshalArrayLen assump $ \assumpNum assumpArr -> + f solverPtr assumpNum assumpArr + +-- | Retrieve the model for the last 'solverCheck'. +-- +-- The error handler is invoked if a model is not available because +-- the commands above were not invoked for the given solver, +-- or if the result was 'Unsat'. +solverGetModel :: Context -> Solver -> IO Model +solverGetModel ctx solver = marshal z3_solver_get_model ctx $ \f -> + h2c solver $ \solverPtr -> + f solverPtr + +-- | Retrieve the unsat core for the last 'solverCheckAssumptions'; the unsat core is a subset of the assumptions +solverGetUnsatCore :: Context -> Solver -> IO [AST] +solverGetUnsatCore = liftFun1 z3_solver_get_unsat_core + +-- | Return a brief justification for an 'Unknown' result for the commands 'solverCheck' and 'solverCheckAssumptions'. +solverGetReasonUnknown :: Context -> Solver -> IO String +solverGetReasonUnknown = liftFun1 z3_solver_get_reason_unknown + +-- | Convert the given solver into a string. +solverToString :: Context -> Solver -> IO String +solverToString = liftFun1 z3_solver_to_string + +------------------------------------------------- +-- ** Helpers + +solverCheckAndGetModel :: Context -> Solver -> IO (Result, Maybe Model) +solverCheckAndGetModel ctx solver = + do res <- solverCheck ctx solver + mbModel <- case res of + Unsat -> return Nothing + _ -> Just <$> solverGetModel ctx solver + return (res, mbModel) + +--------------------------------------------------------------------- +-- Marshalling + +{- MARSHALLING HELPERS + +We try to get rid of most of the marshalling boilerplate which, by the way, +is going to be essential for transitioning to Z3 4 API. + +Most API functions can be lifted using 'liftFun'{0-3} helpers. Otherwise try +using 'marshal'. Worst case scenario, write the marshalling code yourself. + +-} + +-- withIntegral :: (Integral a, Integral b) => a -> (b -> r) -> r +-- withIntegral x f = f (fromIntegral x) + +withContext :: Context -> (Ptr Z3_context -> IO r) -> IO r +withContext c = withForeignPtr (unContext c) + +withContextError :: Context -> (Ptr Z3_context -> IO r) -> IO r +withContextError c f = withContext c $ \cPtr -> checkError cPtr (f cPtr) + +marshalArray :: (Marshal h c, Storable c) => [h] -> (Ptr c -> IO a) -> IO a +marshalArray hs f = hs2cs hs $ \cs -> withArray cs f + +marshalArrayLen :: (Marshal h c, Storable c, Integral i) => + [h] -> (i -> Ptr c -> IO a) -> IO a +marshalArrayLen hs f = + hs2cs hs $ \cs -> withArrayLen cs $ \n -> f (fromIntegral n) + +liftAstN :: String + -> (Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast)) + -> Context -> [AST] -> IO AST +liftAstN s _ _ [] = error s +liftAstN _ f c es = marshal f c $ marshalArrayLen es +{-# INLINE liftAstN #-} + +class Marshal h c where + c2h :: Context -> c -> IO h + h2c :: h -> (c -> IO r) -> IO r + +hs2cs :: Marshal h c => [h] -> ([c] -> IO r) -> IO r +hs2cs [] f = f [] +hs2cs (h:hs) f = + h2c h $ \c -> + hs2cs hs $ \cs -> f (c:cs) + +type Z3SetRefCount c = Ptr Z3_context -> Ptr c -> IO () +type Z3IncRefFun c = Z3SetRefCount c +type Z3DecRefFun c = Z3SetRefCount c + +mkC2hRefCount :: (ForeignPtr c -> h) + -> Z3IncRefFun c + -> Z3DecRefFun c + -> Context -> Ptr c -> IO h +mkC2hRefCount mk incRef decRef ctx xPtr = + withContext ctx $ \ctxPtr -> do + incRef ctxPtr xPtr + contextIncRef ctx + let xFinalizer = do + decRef ctxPtr xPtr + contextDecRef ctxPtr (refCount ctx) + mk <$> newForeignPtr xPtr xFinalizer + +dummy_inc_ref :: Z3IncRefFun c +dummy_inc_ref _ _ = return () + +on_ast_ptr :: Z3SetRefCount Z3_ast + -> (Ptr Z3_context -> Ptr a -> IO (Ptr Z3_ast)) + -> Z3SetRefCount a +f `on_ast_ptr` t = \ctxPtr ptr -> f ctxPtr =<< t ctxPtr ptr + +instance Marshal h (Ptr x) => Marshal (Maybe h) (Ptr x) where + c2h c = T.mapM (c2h c) . ptrToMaybe + h2c Nothing f = f nullPtr + h2c (Just x) f = h2c x f + +instance Marshal () () where + c2h _ = return + h2c x f = f x + +instance Marshal Bool Z3_bool where + c2h _ = return . toBool + h2c b f = f (unBool b) + +instance Marshal Result Z3_lbool where + c2h _ = return . toResult + h2c = error "Marshal Result Z3_lbool => h2c not implemented" + +instance Integral h => Marshal h CInt where + c2h _ = return . fromIntegral + h2c i f = f (fromIntegral i) + +instance Integral h => Marshal h CUInt where + c2h _ = return . fromIntegral + h2c i f = f (fromIntegral i) + +instance Integral h => Marshal h CLLong where + c2h _ = return . fromIntegral + h2c i f = f (fromIntegral i) + +instance Integral h => Marshal h CULLong where + c2h _ = return . fromIntegral + h2c i f = f (fromIntegral i) + +instance Marshal Double CDouble where + c2h _ = return . realToFrac + h2c d f = f (realToFrac d) + +instance Marshal String CString where + c2h _ = peekCString + h2c = withCString + +instance Marshal App (Ptr Z3_app) where + c2h = mkC2hRefCount App + (z3_inc_ref `on_ast_ptr` z3_app_to_ast) + (z3_dec_ref `on_ast_ptr` z3_app_to_ast) + h2c app = withForeignPtr (unApp app) + +instance Marshal Params (Ptr Z3_params) where + c2h = mkC2hRefCount Params z3_params_inc_ref z3_params_dec_ref + h2c prm = withForeignPtr (unParams prm) + +instance Marshal Symbol (Ptr Z3_symbol) where + c2h _ = return . Symbol + h2c s f = f (unSymbol s) + +instance Marshal AST (Ptr Z3_ast) where + c2h = mkC2hRefCount AST z3_inc_ref z3_dec_ref + h2c a f = withForeignPtr (unAST a) f + +instance Marshal [AST] (Ptr Z3_ast_vector) where + c2h ctx vecPtr = withContext ctx $ \ctxPtr -> do + z3_ast_vector_inc_ref ctxPtr vecPtr + n <- z3_ast_vector_size ctxPtr vecPtr + res <- if n == 0 -- Need an explicit check, since n is unsigned so n - 1 might overflow + then return [] + else mapM (\i -> z3_ast_vector_get ctxPtr vecPtr i >>= c2h ctx) [0 .. (n - 1)] + z3_ast_vector_dec_ref ctxPtr vecPtr + return res + h2c _ _ = error "Marshal [AST] (Ptr Z3_ast_vector) => h2c not implemented" + +instance Marshal Sort (Ptr Z3_sort) where + c2h = mkC2hRefCount Sort + (z3_inc_ref `on_ast_ptr` z3_sort_to_ast) + (z3_dec_ref `on_ast_ptr` z3_sort_to_ast) + h2c srt = withForeignPtr (unSort srt) + +instance Marshal FuncDecl (Ptr Z3_func_decl) where + c2h = mkC2hRefCount FuncDecl + (z3_inc_ref `on_ast_ptr` z3_func_decl_to_ast) + (z3_dec_ref `on_ast_ptr` z3_func_decl_to_ast) + h2c fnd = withForeignPtr (unFuncDecl fnd) + +instance Marshal FuncEntry (Ptr Z3_func_entry) where + c2h = mkC2hRefCount FuncEntry z3_func_entry_inc_ref + z3_func_entry_dec_ref + h2c fne = withForeignPtr (unFuncEntry fne) + +instance Marshal FuncInterp (Ptr Z3_func_interp) where + c2h = mkC2hRefCount FuncInterp z3_func_interp_inc_ref + z3_func_interp_dec_ref + h2c fni = withForeignPtr (unFuncInterp fni) + +instance Marshal Model (Ptr Z3_model) where + c2h = mkC2hRefCount Model z3_model_inc_ref z3_model_dec_ref + h2c m = withForeignPtr (unModel m) + +instance Marshal Pattern (Ptr Z3_pattern) where + c2h = mkC2hRefCount Pattern + (z3_inc_ref `on_ast_ptr` z3_pattern_to_ast) + (z3_dec_ref `on_ast_ptr` z3_pattern_to_ast) + h2c pat = withForeignPtr (unPattern pat) + +instance Marshal Constructor (Ptr Z3_constructor) where + c2h = mkC2hRefCount Constructor dummy_inc_ref z3_del_constructor + h2c cns = withForeignPtr (unConstructor cns) + +instance Marshal Solver (Ptr Z3_solver) where + c2h = mkC2hRefCount Solver z3_solver_inc_ref z3_solver_dec_ref + h2c slv = withForeignPtr (unSolver slv) + + +marshal :: Marshal rh rc => (Ptr Z3_context -> t) -> + Context -> (t -> IO rc) -> IO rh +marshal f c cont = withContextError c $ \cPtr -> + cont (f cPtr) >>= c2h c + +liftFun0 :: Marshal rh rc => (Ptr Z3_context -> IO rc) -> + Context -> IO rh +liftFun0 f c = withContextError c $ \cPtr -> + c2h c =<< f cPtr +{-# INLINE liftFun0 #-} + +liftFun1 :: (Marshal ah ac, Marshal rh rc) => + (Ptr Z3_context -> ac -> IO rc) -> + Context -> ah -> IO rh +liftFun1 f c x = withContextError c $ \cPtr -> + h2c x $ \a -> + c2h c =<< f cPtr a +{-# INLINE liftFun1 #-} + +liftFun2 :: (Marshal ah ac, Marshal bh bc, Marshal rh rc) => + (Ptr Z3_context -> ac -> bc -> IO rc) -> + Context -> ah -> bh -> IO rh +liftFun2 f c x y = withContextError c $ \cPtr -> + h2c x $ \a -> h2c y $ \b -> + c2h c =<< f cPtr a b +{-# INLINE liftFun2 #-} + +liftFun3 :: (Marshal ah ac, Marshal bh bc, Marshal ch cc, Marshal rh rc) => + (Ptr Z3_context -> ac -> bc -> cc -> IO rc) -> + Context -> ah -> bh -> ch -> IO rh +liftFun3 f c x y z = withContextError c $ \cPtr -> + h2c x $ \x1 -> h2c y $ \y1 -> h2c z $ \z1 -> + c2h c =<< f cPtr x1 y1 z1 +{-# INLINE liftFun3 #-} + +--------------------------------------------------------------------- +-- Utils + +-- | Convert 'Z3_lbool' from Z3.Base.C to 'Result' +toResult :: Z3_lbool -> Result +toResult lb + | lb == z3_l_true = Sat + | lb == z3_l_false = Unsat + | lb == z3_l_undef = Undef + | otherwise = error "Z3.Base.toResult: illegal `Z3_lbool' value" + +-- | Convert 'Z3_bool' to 'Bool'. +-- +-- 'Foreign.toBool' should be OK but this is more convenient. +toBool :: Z3_bool -> Bool +toBool b + | b == z3_true = True + | b == z3_false = False + | otherwise = error "Z3.Base.toBool: illegal `Z3_bool' value" + +-- | Convert 'Bool' to 'Z3_bool'. +unBool :: Bool -> Z3_bool +unBool True = z3_true +unBool False = z3_false + +-- | Wraps a non-null pointer with 'Just', or else returns 'Nothing'. +ptrToMaybe :: Ptr a -> Maybe (Ptr a) +ptrToMaybe ptr | ptr == nullPtr = Nothing + | otherwise = Just ptr + diff --git a/src/Z3/Base/C.hsc b/src/Z3/Base/C.hsc new file mode 100644 --- /dev/null +++ b/src/Z3/Base/C.hsc @@ -0,0 +1,1103 @@ +{-# LANGUAGE EmptyDataDecls #-} + +-- | +-- Module : Z3.Base.C +-- Copyright : (c) Iago Abal, 2012-2014 +-- (c) David Castro, 2012-2013 +-- License : BSD3 +-- Maintainer: Iago Abal , +-- David Castro +-- +-- Z3 API foreign imports. + +{- HACKING + +Add here the foreign import to support a new API function: + +* Take a look to a few others foreign imports and follow the same coding style. + * 2-space wide indentation, no tabs. + * No trailing spaces, please. + * ... +* Place the foreign import in the right section, according to the Z3's API documentation. +* Include a reference to the function's API documentation. +-} + +module Z3.Base.C where + +import Foreign +import Foreign.C.Types +import Foreign.C.String + +#include + + +--------------------------------------------------------------------- +-- * Types + +data Z3_config + +data Z3_context + +data Z3_symbol + +data Z3_ast + +data Z3_sort + +data Z3_func_decl + +data Z3_app + +data Z3_pattern + +data Z3_constructor + +data Z3_model + +data Z3_func_interp + +data Z3_func_entry + +data Z3_solver + +data Z3_params + +data Z3_ast_vector + +-- | Reference: +newtype Z3_lbool = Z3_lbool CInt + deriving Eq + +z3_l_true, z3_l_false, z3_l_undef :: Z3_lbool +z3_l_true = Z3_lbool (#const Z3_L_TRUE) +z3_l_false = Z3_lbool (#const Z3_L_FALSE) +z3_l_undef = Z3_lbool (#const Z3_L_UNDEF) + +-- | Reference: +newtype Z3_bool = Z3_bool CInt + deriving Eq + +-- | Reference: +type Z3_error_handler = Ptr Z3_context -> Z3_error_code -> IO () + +z3_true, z3_false :: Z3_bool +-- | Reference: +z3_true = Z3_bool(#const Z3_TRUE) +-- | Reference: +z3_false = Z3_bool(#const Z3_FALSE) + +-- | Reference: +type Z3_string = CString + +-- | Reference: +type Z3_ast_print_mode = CInt +z3_print_smtlib_full :: Z3_ast_print_mode +z3_print_smtlib_full = #const Z3_PRINT_SMTLIB_FULL +z3_print_low_level :: Z3_ast_print_mode +z3_print_low_level = #const Z3_PRINT_LOW_LEVEL +z3_print_smtlib_compliant :: Z3_ast_print_mode +z3_print_smtlib_compliant = #const Z3_PRINT_SMTLIB_COMPLIANT +z3_print_smtlib2_compliant :: Z3_ast_print_mode +z3_print_smtlib2_compliant = #const Z3_PRINT_SMTLIB2_COMPLIANT + +-- | Reference: +type Z3_error_code = CInt +#{enum Z3_error_code, + , z3_ok = Z3_OK + , z3_sort_error = Z3_SORT_ERROR + , z3_iob = Z3_IOB + , z3_invalid_arg = Z3_INVALID_ARG + , z3_parser_error = Z3_PARSER_ERROR + , z3_no_parser = Z3_NO_PARSER + , z3_invalid_pattern = Z3_INVALID_PATTERN + , z3_memout_fail = Z3_MEMOUT_FAIL + , z3_file_access_error = Z3_FILE_ACCESS_ERROR + , z3_internal_fatal = Z3_INTERNAL_FATAL + , z3_invalid_usage = Z3_INVALID_USAGE + , z3_dec_ref_error = Z3_DEC_REF_ERROR + , z3_exception = Z3_EXCEPTION + } + +-- | Reference: +type Z3_ast_kind = CInt +z3_numeral_ast :: Z3_ast_kind +z3_numeral_ast = #const Z3_NUMERAL_AST +z3_app_ast :: Z3_ast_kind +z3_app_ast = #const Z3_APP_AST +z3_var_ast :: Z3_ast_kind +z3_var_ast = #const Z3_VAR_AST +z3_quantifier_ast :: Z3_ast_kind +z3_quantifier_ast = #const Z3_QUANTIFIER_AST +z3_sort_ast :: Z3_ast_kind +z3_sort_ast = #const Z3_SORT_AST +z3_func_decl_ast :: Z3_ast_kind +z3_func_decl_ast = #const Z3_FUNC_DECL_AST +z3_unknown_ast :: Z3_ast_kind +z3_unknown_ast = #const Z3_UNKNOWN_AST + + +--------------------------------------------------------------------- +-- * Create configuration + +-- | Reference: +foreign import ccall unsafe "Z3_mk_config" + z3_mk_config :: IO (Ptr Z3_config) + +-- | Reference: +foreign import ccall unsafe "Z3_del_config" + z3_del_config :: Ptr Z3_config -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_set_param_value" + z3_set_param_value :: Ptr Z3_config -> Z3_string -> Z3_string -> IO () + + +--------------------------------------------------------------------- +-- * Create context + +-- | Reference: +foreign import ccall unsafe "Z3_mk_context_rc" + z3_mk_context_rc :: Ptr Z3_config -> IO (Ptr Z3_context) + +-- | Reference: +foreign import ccall unsafe "Z3_del_context" + z3_del_context :: Ptr Z3_context -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_inc_ref" + z3_inc_ref :: Ptr Z3_context -> Ptr Z3_ast -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_inc_ref" + z3_dec_ref :: Ptr Z3_context -> Ptr Z3_ast -> IO () + +--------------------------------------------------------------------- +-- * Symbols + +-- | Reference: +foreign import ccall unsafe "Z3_mk_int_symbol" + z3_mk_int_symbol :: Ptr Z3_context -> CInt -> IO (Ptr Z3_symbol) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_string_symbol" + z3_mk_string_symbol :: Ptr Z3_context -> Z3_string -> IO (Ptr Z3_symbol) + +--------------------------------------------------------------------- +-- * Sorts + +-- | Reference: +foreign import ccall unsafe "Z3_sort_to_ast" + z3_sort_to_ast :: Ptr Z3_context -> Ptr Z3_sort -> IO (Ptr Z3_ast) + +-- TODO Sorts: Z3_is_eq_sort + +-- | Reference: +foreign import ccall unsafe "Z3_mk_uninterpreted_sort" + z3_mk_uninterpreted_sort :: Ptr Z3_context -> Ptr Z3_symbol -> IO (Ptr Z3_sort) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bool_sort" + z3_mk_bool_sort :: Ptr Z3_context -> IO (Ptr Z3_sort) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_int_sort" + z3_mk_int_sort :: Ptr Z3_context -> IO (Ptr Z3_sort) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_real_sort" + z3_mk_real_sort :: Ptr Z3_context -> IO (Ptr Z3_sort) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bv_sort" + z3_mk_bv_sort :: Ptr Z3_context -> CUInt -> IO (Ptr Z3_sort) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_array_sort" + z3_mk_array_sort :: Ptr Z3_context -> Ptr Z3_sort -> Ptr Z3_sort -> IO (Ptr Z3_sort) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_tuple_sort" + z3_mk_tuple_sort :: Ptr Z3_context + -> Ptr Z3_symbol + -> CUInt + -> Ptr (Ptr Z3_symbol) + -> Ptr (Ptr Z3_sort) + -> Ptr (Ptr Z3_func_decl) + -> Ptr (Ptr Z3_func_decl) + -> IO (Ptr Z3_sort) + +-- Reference +foreign import ccall unsafe "Z3_mk_constructor" + z3_mk_constructor :: Ptr Z3_context + -> Ptr Z3_symbol + -> Ptr Z3_symbol + -> CUInt + -> Ptr (Ptr Z3_symbol) + -> Ptr (Ptr Z3_sort) + -> Ptr CUInt + -> IO (Ptr Z3_constructor) + +-- Reference +foreign import ccall unsafe "Z3_del_constructor" + z3_del_constructor :: Ptr Z3_context -> Ptr Z3_constructor -> IO () + + +-- Reference: +foreign import ccall unsafe "Z3_mk_datatype" + z3_mk_datatype :: Ptr Z3_context + -> Ptr Z3_symbol + -> CUInt + -> Ptr (Ptr Z3_constructor) + -> IO (Ptr Z3_sort) + +-- TODO Sorts: from Z3_mk_array_sort on + +--------------------------------------------------------------------- +-- * Constants and Applications + +-- | Reference: +foreign import ccall unsafe "Z3_mk_func_decl" + z3_mk_func_decl :: Ptr Z3_context + -> Ptr Z3_symbol + -> CUInt + -> Ptr (Ptr Z3_sort) + -> Ptr Z3_sort + -> IO (Ptr Z3_func_decl) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_app" + z3_mk_app :: Ptr Z3_context + -> Ptr Z3_func_decl + -> CUInt + -> Ptr (Ptr Z3_ast) + -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_const" + z3_mk_const :: Ptr Z3_context -> Ptr Z3_symbol -> Ptr Z3_sort -> IO (Ptr Z3_ast) + +-- Reference: +foreign import ccall unsafe "Z3_mk_fresh_const" + z3_mk_fresh_const :: Ptr Z3_context -> Z3_string -> Ptr Z3_sort -> IO (Ptr Z3_ast) + +-- Reference: +foreign import ccall unsafe "Z3_mk_fresh_func_decl" + z3_mk_fresh_func_decl :: Ptr z3_context + -> Z3_string + -> CUInt + -> Ptr (Ptr Z3_sort) + -> Ptr Z3_sort + -> IO (Ptr Z3_func_decl) + +--------------------------------------------------------------------- +-- * Propositional Logic and Equality + +-- | Reference: +foreign import ccall unsafe "Z3_mk_true" + z3_mk_true :: Ptr Z3_context -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_false" + z3_mk_false :: Ptr Z3_context -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_eq" + z3_mk_eq :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_distinct" + z3_mk_distinct :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_not" + z3_mk_not :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_ite" + z3_mk_ite :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_iff" + z3_mk_iff :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_implies" + z3_mk_implies :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_xor" + z3_mk_xor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_and" + z3_mk_and :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_or" + z3_mk_or :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) + +--------------------------------------------------------------------- +-- * Arithmetic: Integers and Reals + +-- | Reference: +foreign import ccall unsafe "Z3_mk_add" + z3_mk_add :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_mul" + z3_mk_mul :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_sub" + z3_mk_sub :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_unary_minus" + z3_mk_unary_minus :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_div" + z3_mk_div :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_mod" + z3_mk_mod :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_rem" + z3_mk_rem :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_lt" + z3_mk_lt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_le" + z3_mk_le :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_gt" + z3_mk_gt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_ge" + z3_mk_ge :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_int2real" + z3_mk_int2real :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_real2int" + z3_mk_real2int :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_is_int" + z3_mk_is_int :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +--------------------------------------------------------------------- +-- * Bit-vectors + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvnot" + z3_mk_bvnot :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvredand" + z3_mk_bvredand :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvredor" + z3_mk_bvredor :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvand" + z3_mk_bvand :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvor" + z3_mk_bvor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvxor" + z3_mk_bvxor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvnand" + z3_mk_bvnand :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvnor" + z3_mk_bvnor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvxnor" + z3_mk_bvxnor :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvadd" + z3_mk_bvadd :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsub" + z3_mk_bvsub :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvmul" + z3_mk_bvmul :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvudiv" + z3_mk_bvudiv :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsdiv" + z3_mk_bvsdiv :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvurem" + z3_mk_bvurem :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsrem" + z3_mk_bvsrem :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsmod" + z3_mk_bvsmod :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvult" + z3_mk_bvult :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvslt" + z3_mk_bvslt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvule" + z3_mk_bvule :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsle" + z3_mk_bvsle :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvuge" + z3_mk_bvuge :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsge" + z3_mk_bvsge :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvugt" + z3_mk_bvugt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsgt" + z3_mk_bvsgt :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_concat" + z3_mk_concat :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_extract" + z3_mk_extract :: Ptr Z3_context -> CUInt -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_sign_ext" + z3_mk_sign_ext :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_zero_ext" + z3_mk_zero_ext :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_repeat" + z3_mk_repeat :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvshl" + z3_mk_bvshl :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvlshr" + z3_mk_bvlshr :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvashr" + z3_mk_bvashr :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_rotate_left" + z3_mk_rotate_left :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_rotate_right" + z3_mk_rotate_right :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_ext_rotate_left" + z3_mk_ext_rotate_left :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_ext_rotate_right" + z3_mk_ext_rotate_right :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_int2bv" + z3_mk_int2bv :: Ptr Z3_context -> CUInt -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bv2int" + z3_mk_bv2int :: Ptr Z3_context -> Ptr Z3_ast -> Z3_bool -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvadd_no_overflow" + z3_mk_bvadd_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> Z3_bool -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvadd_no_underflow" + z3_mk_bvadd_no_underflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsub_no_overflow" + z3_mk_bvsub_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsub_no_underflow" + z3_mk_bvsub_no_underflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvsdiv_no_overflow" + z3_mk_bvsdiv_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvneg_no_overflow" + z3_mk_bvneg_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvmul_no_overflow" + z3_mk_bvmul_no_overflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> Z3_bool -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bvmul_no_underflow" + z3_mk_bvmul_no_underflow :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-------------------------------------------------------------------------------- +-- * Arrays + +-- | Reference: +foreign import ccall unsafe "Z3_mk_select" + z3_mk_select :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_store" + z3_mk_store :: Ptr Z3_context -> Ptr Z3_ast -> Ptr Z3_ast -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_const_array" + z3_mk_const_array :: Ptr Z3_context -> Ptr Z3_sort -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_map" + z3_mk_map :: Ptr Z3_context -> Ptr Z3_func_decl -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_array_default" + z3_mk_array_default :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_ast) + +-- TODO Sets + +--------------------------------------------------------------------- +-- * Numerals + +-- | Reference: +foreign import ccall unsafe "Z3_mk_numeral" + z3_mk_numeral :: Ptr Z3_context -> Z3_string -> Ptr Z3_sort -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_real" + z3_mk_real :: Ptr Z3_context -> CInt -> CInt -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_int" + z3_mk_int :: Ptr Z3_context -> CInt -> Ptr Z3_sort -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_unsigned_int" + z3_mk_unsigned_int :: Ptr Z3_context -> CUInt -> Ptr Z3_sort -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_int64" + z3_mk_int64 :: Ptr Z3_context -> CLLong -> Ptr Z3_sort -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_unsigned_int64" + z3_mk_unsigned_int64 :: Ptr Z3_context -> CULLong -> Ptr Z3_sort -> IO (Ptr Z3_ast) + +--------------------------------------------------------------------- +-- * Quantifiers + +-- | Reference: +foreign import ccall unsafe "Z3_mk_pattern" + z3_mk_pattern :: Ptr Z3_context -> CUInt -> Ptr (Ptr Z3_ast) -> IO (Ptr Z3_pattern) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_bound" + z3_mk_bound :: Ptr Z3_context -> CUInt -> Ptr Z3_sort -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_forall" + z3_mk_forall :: Ptr Z3_context -> CUInt + -> CUInt -> Ptr (Ptr Z3_pattern) + -> CUInt -> Ptr (Ptr Z3_sort) -> Ptr (Ptr Z3_symbol) + -> Ptr Z3_ast + -> IO (Ptr Z3_ast) + +-- | Referece: +foreign import ccall unsafe "Z3_mk_exists" + z3_mk_exists :: Ptr Z3_context -> CUInt + -> CUInt -> Ptr (Ptr Z3_pattern) + -> CUInt -> Ptr (Ptr Z3_sort) -> Ptr (Ptr Z3_symbol) + -> Ptr Z3_ast + -> IO (Ptr Z3_ast) + +-- TODO: Z3_mk_quantifier, Z3_mk_quantifier_ex + +-- | Reference +foreign import ccall unsafe "Z3_mk_forall_const" + z3_mk_forall_const :: Ptr Z3_context + -> CUInt + -> CUInt + -> Ptr (Ptr Z3_app) + -> CUInt + -> Ptr (Ptr Z3_pattern) + -> Ptr Z3_ast + -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_exists_const" + z3_mk_exists_const :: Ptr Z3_context + -> CUInt + -> CUInt + -> Ptr (Ptr Z3_app) + -> CUInt + -> Ptr (Ptr Z3_pattern) + -> Ptr Z3_ast + -> IO (Ptr Z3_ast) + +-- TODO: Z3_mk_quantifier_const, Z3_mk_quantifier_const_ex + +--------------------------------------------------------------------- +-- * Accessors + +-- | Reference: +foreign import ccall unsafe "Z3_func_decl_to_ast" + z3_func_decl_to_ast :: Ptr Z3_context -> Ptr Z3_func_decl -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_get_ast_kind" + z3_get_ast_kind :: Ptr Z3_context -> Ptr Z3_ast -> IO Z3_ast_kind + +-- Reference: +foreign import ccall unsafe "Z3_get_app_num_args" + z3_get_app_num_args :: Ptr Z3_context -> Ptr Z3_app -> IO CUInt + +-- Reference: +foreign import ccall unsafe "Z3_get_app_arg" + z3_get_app_arg :: Ptr Z3_context -> Ptr Z3_app -> CUInt -> IO (Ptr Z3_ast) + +-- Reference: +foreign import ccall unsafe "Z3_get_app_decl" + z3_get_app_decl :: Ptr Z3_context -> Ptr Z3_app -> IO (Ptr Z3_func_decl) + +-- Reference: +foreign import ccall unsafe "Z3_get_datatype_sort_num_constructors" + z3_get_datatype_sort_num_constructors :: Ptr Z3_context -> Ptr Z3_sort -> IO CUInt + +-- Reference: +foreign import ccall unsafe "Z3_get_datatype_sort_constructor" + z3_get_datatype_sort_constructor :: Ptr Z3_context -> Ptr Z3_sort -> CUInt -> IO (Ptr Z3_func_decl) + +-- Reference: +foreign import ccall unsafe "Z3_get_datatype_sort_recognizer" + z3_get_datatype_sort_recognizer :: Ptr Z3_context -> Ptr Z3_sort -> CUInt -> IO (Ptr Z3_func_decl) + +-- Reference: +foreign import ccall unsafe "Z3_get_datatype_sort_constructor_accessor" + z3_get_datatype_sort_constructor_accessor :: Ptr Z3_context -> Ptr Z3_sort -> CUInt -> CUInt -> IO (Ptr Z3_func_decl) + +-- Reference: +foreign import ccall unsafe "Z3_get_decl_name" + z3_get_decl_name :: Ptr Z3_context -> Ptr Z3_func_decl -> IO (Ptr Z3_symbol) + +-- Reference: +foreign import ccall unsafe "Z3_get_symbol_string" + z3_get_symbol_string :: Ptr Z3_context -> Ptr Z3_symbol -> IO Z3_string + +-- | Reference: +foreign import ccall unsafe "Z3_get_bv_sort_size" + z3_get_bv_sort_size :: Ptr Z3_context -> Ptr Z3_sort -> IO CUInt + +-- | Reference: +foreign import ccall unsafe "Z3_app_to_ast" + z3_app_to_ast :: Ptr Z3_context -> Ptr Z3_app -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_get_sort" + z3_get_sort :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_sort) + +-- | Reference: +foreign import ccall unsafe "Z3_get_bool_value" + z3_get_bool_value :: Ptr Z3_context -> Ptr Z3_ast -> IO Z3_lbool + +-- | Reference: +foreign import ccall unsafe "Z3_get_numeral_string" + z3_get_numeral_string :: Ptr Z3_context -> Ptr Z3_ast -> IO Z3_string + +-- | Reference: +foreign import ccall unsafe "Z3_to_app" + z3_to_app :: Ptr Z3_context -> Ptr Z3_ast -> IO (Ptr Z3_app) + +-- | Reference: +foreign import ccall unsafe "Z3_pattern_to_ast" + z3_pattern_to_ast :: Ptr Z3_context -> Ptr Z3_pattern -> IO (Ptr Z3_ast) + +-- TODO Modifiers + +--------------------------------------------------------------------- +-- * AST vectors + +-- | Reference: +foreign import ccall unsafe "Z3_ast_vector_size" + z3_ast_vector_size :: Ptr Z3_context -> Ptr Z3_ast_vector -> IO CUInt + +-- | Reference: +foreign import ccall unsafe "Z3_ast_vector_get" + z3_ast_vector_get :: Ptr Z3_context -> Ptr Z3_ast_vector -> CUInt -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_ast_vector_inc_ref" + z3_ast_vector_inc_ref :: Ptr Z3_context -> Ptr Z3_ast_vector -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_ast_vector_dec_ref" + z3_ast_vector_dec_ref :: Ptr Z3_context -> Ptr Z3_ast_vector -> IO () + +--------------------------------------------------------------------- +-- * Models + +-- | Reference: +foreign import ccall unsafe "Z3_model_inc_ref" + z3_model_inc_ref :: Ptr Z3_context + -> Ptr Z3_model + -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_model_dec_ref" + z3_model_dec_ref :: Ptr Z3_context + -> Ptr Z3_model + -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_eval" + z3_eval :: Ptr Z3_context + -> Ptr Z3_model + -> Ptr Z3_ast + -> Ptr (Ptr Z3_ast) + -> IO Z3_bool + +-- | Reference: +foreign import ccall unsafe "Z3_is_as_array" + z3_is_as_array :: Ptr Z3_context + -> Ptr Z3_ast + -> IO Z3_bool + +-- | Reference: +foreign import ccall unsafe "Z3_get_as_array_func_decl" + z3_get_as_array_func_decl :: Ptr Z3_context + -> Ptr Z3_ast + -> IO (Ptr Z3_func_decl) + +-- | Reference: +foreign import ccall unsafe "Z3_model_get_func_interp" + z3_model_get_func_interp :: Ptr Z3_context + -> Ptr Z3_model + -> Ptr Z3_func_decl + -> IO (Ptr Z3_func_interp) + +-- | Reference: +foreign import ccall unsafe "Z3_func_interp_inc_ref" + z3_func_interp_inc_ref :: Ptr Z3_context + -> Ptr Z3_func_interp + -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_func_interp_dec_ref" + z3_func_interp_dec_ref :: Ptr Z3_context + -> Ptr Z3_func_interp + -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_func_interp_get_num_entries" + z3_func_interp_get_num_entries :: Ptr Z3_context + -> Ptr Z3_func_interp + -> IO CUInt + +-- | Reference: +foreign import ccall unsafe "Z3_func_interp_get_entry" + z3_func_interp_get_entry :: Ptr Z3_context + -> Ptr Z3_func_interp + -> CUInt + -> IO (Ptr Z3_func_entry) + +-- | Reference: +foreign import ccall unsafe "Z3_func_interp_get_else" + z3_func_interp_get_else :: Ptr Z3_context + -> Ptr Z3_func_interp + -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_func_interp_get_arity" + z3_func_interp_get_arity :: Ptr Z3_context + -> Ptr Z3_func_interp + -> IO CUInt + +-- | Reference: +foreign import ccall unsafe "Z3_func_entry_inc_ref" + z3_func_entry_inc_ref :: Ptr Z3_context + -> Ptr Z3_func_entry + -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_func_entry_dec_ref" + z3_func_entry_dec_ref :: Ptr Z3_context + -> Ptr Z3_func_entry + -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_func_entry_get_value" + z3_func_entry_get_value :: Ptr Z3_context + -> Ptr Z3_func_entry + -> IO (Ptr Z3_ast) + +-- | Reference: +foreign import ccall unsafe "Z3_func_entry_get_num_args" + z3_func_entry_get_num_args :: Ptr Z3_context + -> Ptr Z3_func_entry + -> IO CUInt + +-- | Reference: +foreign import ccall unsafe "Z3_func_entry_get_arg" + z3_func_entry_get_arg :: Ptr Z3_context + -> Ptr Z3_func_entry + -> CUInt + -> IO (Ptr Z3_ast) + +--------------------------------------------------------------------- +-- * Constraints + +-- TODO Constraints: Z3_get_num_scopes +-- TODO Constraints: Z3_persist_ast +-- TODO Constraints: Z3_check_assumptions +-- TODO Constraints: Z3_get_implied_equalities + +-- | Reference: +foreign import ccall unsafe "Z3_model_to_string" + z3_model_to_string :: Ptr Z3_context -> Ptr Z3_model -> IO Z3_string + +-- TODO From section 'Constraints' on. + + +--------------------------------------------------------------------- +-- * Parameters + +-- | Reference: +foreign import ccall unsafe "Z3_mk_params" + z3_mk_params :: Ptr Z3_context -> IO (Ptr Z3_params) + +-- | Reference: +foreign import ccall unsafe "Z3_params_inc_ref" + z3_params_inc_ref :: Ptr Z3_context -> Ptr Z3_params -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_params_dec_ref" + z3_params_dec_ref :: Ptr Z3_context -> Ptr Z3_params -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_params_set_bool" + z3_params_set_bool :: Ptr Z3_context -> Ptr Z3_params -> Ptr Z3_symbol -> + Z3_bool -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_params_set_uint" + z3_params_set_uint :: Ptr Z3_context -> Ptr Z3_params -> Ptr Z3_symbol -> + CUInt -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_params_set_double" + z3_params_set_double :: Ptr Z3_context -> Ptr Z3_params -> Ptr Z3_symbol -> + CDouble -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_params_set_symbol" + z3_params_set_symbol :: Ptr Z3_context -> Ptr Z3_params -> Ptr Z3_symbol -> + Ptr Z3_symbol -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_params_to_string" + z3_params_to_string :: Ptr Z3_context -> Ptr Z3_params -> IO Z3_string + +--------------------------------------------------------------------- +-- * Solvers + +-- | Reference: +foreign import ccall unsafe "Z3_mk_solver" + z3_mk_solver :: Ptr Z3_context -> IO (Ptr Z3_solver) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_simple_solver" + z3_mk_simple_solver :: Ptr Z3_context -> IO (Ptr Z3_solver) + +-- | Reference: +foreign import ccall unsafe "Z3_mk_solver_for_logic" + z3_mk_solver_for_logic :: Ptr Z3_context -> Ptr Z3_symbol -> IO (Ptr Z3_solver) + +-- | Reference: +foreign import ccall unsafe "Z3_solver_get_help" + z3_solver_get_help :: Ptr Z3_context -> Ptr Z3_solver -> IO Z3_string + +-- | Reference: +foreign import ccall unsafe "Z3_solver_set_params" + z3_solver_set_params :: Ptr Z3_context -> Ptr Z3_solver -> Ptr Z3_params -> + IO () + +-- | Reference: +foreign import ccall unsafe "Z3_solver_inc_ref" + z3_solver_inc_ref :: Ptr Z3_context -> Ptr Z3_solver -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_solver_dec_ref" + z3_solver_dec_ref :: Ptr Z3_context -> Ptr Z3_solver -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_solver_push" + z3_solver_push :: Ptr Z3_context -> Ptr Z3_solver -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_solver_pop" + z3_solver_pop :: Ptr Z3_context -> Ptr Z3_solver -> CUInt -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_solver_get_num_scopes" + z3_solver_get_num_scopes :: Ptr Z3_context -> Ptr Z3_solver -> IO CUInt + +-- | Reference: +foreign import ccall unsafe "Z3_solver_reset" + z3_solver_reset :: Ptr Z3_context -> Ptr Z3_solver -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_solver_assert" + z3_solver_assert :: Ptr Z3_context -> Ptr Z3_solver -> Ptr Z3_ast -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_solver_assert_and_track" + z3_solver_assert_and_track :: Ptr Z3_context -> Ptr Z3_solver -> + Ptr Z3_ast -> Ptr Z3_ast -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_solver_check" + z3_solver_check :: Ptr Z3_context -> Ptr Z3_solver -> IO Z3_lbool + +-- | Reference: +foreign import ccall unsafe "Z3_solver_check_assumptions" + z3_solver_check_assumptions :: Ptr Z3_context -> Ptr Z3_solver -> CUInt -> Ptr (Ptr Z3_ast) -> IO Z3_lbool + +-- | Reference: +foreign import ccall unsafe "Z3_solver_get_model" + z3_solver_get_model :: Ptr Z3_context -> Ptr Z3_solver -> IO (Ptr Z3_model) + +-- | Reference: +foreign import ccall unsafe "Z3_solver_get_unsat_core" + z3_solver_get_unsat_core :: Ptr Z3_context -> Ptr Z3_solver -> IO (Ptr Z3_ast_vector) + +-- | Reference: +foreign import ccall unsafe "Z3_solver_get_reason_unknown" + z3_solver_get_reason_unknown :: Ptr Z3_context -> Ptr Z3_solver -> + IO Z3_string + +-- | Reference: +foreign import ccall unsafe "Z3_solver_to_string" + z3_solver_to_string :: Ptr Z3_context -> Ptr Z3_solver -> IO Z3_string + +--------------------------------------------------------------------- +-- * String Conversion + +-- | Reference: +foreign import ccall unsafe "Z3_set_ast_print_mode" + z3_set_ast_print_mode :: Ptr Z3_context -> Z3_ast_print_mode -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_ast_to_string" + z3_ast_to_string :: Ptr Z3_context -> Ptr Z3_ast -> IO Z3_string + +-- | Reference: +foreign import ccall unsafe "Z3_pattern_to_string" + z3_pattern_to_string :: Ptr Z3_context -> Ptr Z3_pattern -> IO Z3_string + +-- | Reference: +foreign import ccall unsafe "Z3_sort_to_string" + z3_sort_to_string :: Ptr Z3_context -> Ptr Z3_sort -> IO Z3_string + +-- | Reference: +foreign import ccall unsafe "Z3_func_decl_to_string" + z3_func_decl_to_string :: Ptr Z3_context -> Ptr Z3_func_decl -> IO Z3_string + +-- | Reference: +foreign import ccall unsafe "Z3_benchmark_to_smtlib_string" + z3_benchmark_to_smtlib_string :: Ptr Z3_context + -> Z3_string -- ^ name + -> Z3_string -- ^ logic + -> Z3_string -- ^ status + -> Z3_string -- ^ attributes + -> CUInt -- ^ assumptions# + -> Ptr (Ptr Z3_ast) -- ^ assumptions + -> Ptr Z3_ast -- ^ formula + -> IO Z3_string + +--------------------------------------------------------------------- +-- * Error Handling + +-- | Reference: +foreign import ccall unsafe "Z3_get_error_code" + z3_get_error_code :: Ptr Z3_context -> IO Z3_error_code + +-- | Reference: +foreign import ccall unsafe "Z3_set_error_handler" + z3_set_error_handler :: Ptr Z3_context -> FunPtr Z3_error_handler -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_set_error" + z3_set_error :: Ptr Z3_context -> Z3_error_code -> IO () + +-- | Reference: +foreign import ccall unsafe "Z3_get_error_msg" + z3_get_error_msg :: Z3_error_code -> IO Z3_string + +-- | Reference: +foreign import ccall unsafe "Z3_get_error_msg_ex" + z3_get_error_msg_ex :: Ptr Z3_context -> Z3_error_code -> IO Z3_string + +--------------------------------------------------------------------- +-- * Miscellaneous + +-- | Reference: +foreign import ccall unsafe "Z3_get_version" + z3_get_version :: Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO () diff --git a/src/Z3/Monad.hs b/src/Z3/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Z3/Monad.hs @@ -0,0 +1,1694 @@ + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | +-- Module : Z3.Monad +-- Copyright : (c) Iago Abal, 2013-2015 +-- (c) David Castro, 2013-2015 +-- License : BSD3 +-- Maintainer: Iago Abal , +-- David Castro +-- +-- A simple monadic interface to Z3 API. +-- +-- Examples: + +module Z3.Monad + ( -- * Z3 monad + MonadZ3(..) + , Z3 + , module Z3.Opts + , Logic(..) + , evalZ3 + , evalZ3With + -- ** Z3 enviroments + , Z3Env + , newEnv + , evalZ3WithEnv + + -- * Types + , Symbol + , AST + , Sort + , FuncDecl + , App + , Pattern + , Constructor + , Model + , Base.Context + , FuncInterp + , FuncEntry + , Params + , Solver + , ASTKind(..) + -- ** Satisfiability result + , Result(..) + + -- * Parameters + , mkParams + , paramsSetBool + , paramsSetUInt + , paramsSetDouble + , paramsSetSymbol + , paramsToString + + -- * Symbols + , mkIntSymbol + , mkStringSymbol + + -- * Sorts + , mkUninterpretedSort + , mkBoolSort + , mkIntSort + , mkRealSort + , mkBvSort + , mkArraySort + , mkTupleSort + , mkConstructor + , mkDatatype + + -- * Constants and Applications + , mkFuncDecl + , mkApp + , mkConst + , mkFreshConst + , mkFreshFuncDecl + -- ** Helpers + , mkVar + , mkBoolVar + , mkRealVar + , mkIntVar + , mkBvVar + , mkFreshVar + , mkFreshBoolVar + , mkFreshRealVar + , mkFreshIntVar + , mkFreshBvVar + + -- * Propositional Logic and Equality + , mkTrue + , mkFalse + , mkEq + , mkNot + , mkIte + , mkIff + , mkImplies + , mkXor + , mkAnd + , mkOr + , mkDistinct + -- ** Helpers + , mkBool + + -- * Arithmetic: Integers and Reals + , mkAdd + , mkMul + , mkSub + , mkUnaryMinus + , mkDiv + , mkMod + , mkRem + , mkLt + , mkLe + , mkGt + , mkGe + , mkInt2Real + , mkReal2Int + , mkIsInt + + -- * Bit-vectors + , mkBvnot + , mkBvredand + , mkBvredor + , mkBvand + , mkBvor + , mkBvxor + , mkBvnand + , mkBvnor + , mkBvxnor + , mkBvneg + , mkBvadd + , mkBvsub + , mkBvmul + , mkBvudiv + , mkBvsdiv + , mkBvurem + , mkBvsrem + , mkBvsmod + , mkBvult + , mkBvslt + , mkBvule + , mkBvsle + , mkBvuge + , mkBvsge + , mkBvugt + , mkBvsgt + , mkConcat + , mkExtract + , mkSignExt + , mkZeroExt + , mkRepeat + , mkBvshl + , mkBvlshr + , mkBvashr + , mkRotateLeft + , mkRotateRight + , mkExtRotateLeft + , mkExtRotateRight + , mkInt2bv + , mkBv2int + , mkBvnegNoOverflow + , mkBvaddNoOverflow + , mkBvaddNoUnderflow + , mkBvsubNoOverflow + , mkBvsubNoUnderflow + , mkBvmulNoOverflow + , mkBvmulNoUnderflow + , mkBvsdivNoOverflow + + -- * Arrays + , mkSelect + , mkStore + , mkConstArray + , mkMap + , mkArrayDefault + + -- * Numerals + , mkNumeral + , mkInt + , mkReal + , mkUnsignedInt + , mkInt64 + , mkUnsignedInt64 + -- ** Helpers + , mkIntegral + , mkRational + , mkFixed + , mkRealNum + , mkInteger + , mkIntNum + , mkBitvector + , mkBvNum + + -- * Quantifiers + , mkPattern + , mkBound + , mkForall + , mkExists + , mkForallConst + , mkExistsConst + + -- * Accessors + , getSymbolString + , getBvSortSize + , getDatatypeSortConstructors + , getDatatypeSortRecognizers + , getDeclName + , getSort + , getBoolValue + , getAstKind + , toApp + , getNumeralString + -- ** Helpers + , getBool + , getInt + , getReal + , getBv + + -- * Models + , modelEval + , evalArray + , getFuncInterp + , isAsArray + , getAsArrayFuncDecl + , funcInterpGetNumEntries + , funcInterpGetEntry + , funcInterpGetElse + , funcInterpGetArity + , funcEntryGetValue + , funcEntryGetNumArgs + , funcEntryGetArg + , modelToString + , showModel + -- ** Helpers + , EvalAst + , eval + , evalBool + , evalInt + , evalReal + , evalBv + , evalT + , mapEval + , FuncModel(..) + , evalFunc + + -- * String Conversion + , ASTPrintMode(..) + , setASTPrintMode + , astToString + , patternToString + , sortToString + , funcDeclToString + , benchmarkToSMTLibString + + -- * Error Handling + , Base.Z3Error(..) + , Base.Z3ErrorCode(..) + + -- * Miscellaneous + , Version(..) + , getVersion + + -- * Solvers + , solverGetHelp + , solverSetParams + , solverPush + , solverPop + , solverReset + , solverGetNumScopes + , solverAssertCnstr + , solverAssertAndTrack + , solverCheck + , solverCheckAssumptions + , solverGetModel + , solverGetUnsatCore + , solverGetReasonUnknown + , solverToString + -- ** Helpers + , assert + , check + , checkAssumptions + , solverCheckAndGetModel + , getModel + , withModel + , getUnsatCore + , push + , pop + , local + , reset + , getNumScopes + ) + where + +import Z3.Opts +import Z3.Base + ( Symbol + , AST + , Sort + , FuncDecl + , App + , Pattern + , Constructor + , Model + , FuncInterp + , FuncEntry + , FuncModel(..) + , Result(..) + , Logic(..) + , ASTPrintMode(..) + , Version(..) + , Params + , Solver + , ASTKind(..) + ) +import qualified Z3.Base as Base + +import Control.Applicative ( Applicative ) +import Data.Fixed ( Fixed, HasResolution ) +import Control.Monad.Reader ( ReaderT, runReaderT, asks ) +import Control.Monad.Trans ( MonadIO, liftIO ) +import Control.Monad.Fix ( MonadFix ) +import Data.Int ( Int64 ) +import Data.Word ( Word, Word64 ) +import Data.Traversable ( Traversable ) +import qualified Data.Traversable as T + +--------------------------------------------------------------------- +-- The Z3 monad-class + +class (Applicative m, Monad m, MonadIO m) => MonadZ3 m where + getSolver :: m Base.Solver + getContext :: m Base.Context + +------------------------------------------------- +-- Lifting + +-- TODO: Rename to liftFun0 for consistency +liftScalar :: MonadZ3 z3 => (Base.Context -> IO b) -> z3 b +liftScalar f = liftIO . f =<< getContext + +liftFun1 :: MonadZ3 z3 => (Base.Context -> a -> IO b) -> a -> z3 b +liftFun1 f a = getContext >>= \ctx -> liftIO (f ctx a) + +liftFun2 :: MonadZ3 z3 => (Base.Context -> a -> b -> IO c) -> a -> b -> z3 c +liftFun2 f a b = getContext >>= \ctx -> liftIO (f ctx a b) + +liftFun3 :: MonadZ3 z3 => (Base.Context -> a -> b -> c -> IO d) + -> a -> b -> c -> z3 d +liftFun3 f a b c = getContext >>= \ctx -> liftIO (f ctx a b c) + +liftFun4 :: MonadZ3 z3 => (Base.Context -> a -> b -> c -> d -> IO e) + -> a -> b -> c -> d -> z3 e +liftFun4 f a b c d = getContext >>= \ctx -> liftIO (f ctx a b c d) + +liftFun6 :: MonadZ3 z3 => + (Base.Context -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> IO b) + -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> z3 b +liftFun6 f x1 x2 x3 x4 x5 x6 = + getContext >>= \ctx -> liftIO (f ctx x1 x2 x3 x4 x5 x6) + +liftSolver0 :: MonadZ3 z3 => + (Base.Context -> Base.Solver -> IO b) + -> z3 b +liftSolver0 f_s = + do ctx <- getContext + liftIO . f_s ctx =<< getSolver + +liftSolver1 :: MonadZ3 z3 => + (Base.Context -> Base.Solver -> a -> IO b) + -> a -> z3 b +liftSolver1 f_s a = + do ctx <- getContext + liftIO . (\s -> f_s ctx s a) =<< getSolver + +liftSolver2 :: MonadZ3 z3 => (Base.Context -> Base.Solver -> a -> b -> IO c) + -> a -> b -> z3 c +liftSolver2 f a b = do + ctx <- getContext + slv <- getSolver + liftIO $ f ctx slv a b + +------------------------------------------------- +-- A simple Z3 monad. + +newtype Z3 a = Z3 { _unZ3 :: ReaderT Z3Env IO a } + deriving (Functor, Applicative, Monad, MonadIO, MonadFix) + +-- | Z3 environment. +data Z3Env + = Z3Env { + envSolver :: Base.Solver + , envContext :: Base.Context + } + +instance MonadZ3 Z3 where + getSolver = Z3 $ asks envSolver + getContext = Z3 $ asks envContext + +-- | Eval a Z3 script. +evalZ3With :: Maybe Logic -> Opts -> Z3 a -> IO a +evalZ3With mbLogic opts (Z3 s) = do + env <- newEnv mbLogic opts + runReaderT s env + +-- | Eval a Z3 script with default configuration options. +evalZ3 :: Z3 a -> IO a +evalZ3 = evalZ3With Nothing stdOpts + +-- | Create a new Z3 environment. +newEnv :: Maybe Logic -> Opts -> IO Z3Env +newEnv mbLogic opts = + Base.withConfig $ \cfg -> do + setOpts cfg opts + ctx <- Base.mkContext cfg + solver <- maybe (Base.mkSolver ctx) (Base.mkSolverForLogic ctx) mbLogic + return $ Z3Env solver ctx + +-- | Eval a Z3 script with a given environment. +-- +-- Environments may facilitate running many queries under the same +-- logical context. +-- +-- Note that an environment may change after each query. +-- If you want to preserve the same environment then use 'local', as in +-- @evalZ3WithEnv /env/ (local /query/)@. +evalZ3WithEnv :: Z3 a + -> Z3Env + -> IO a +evalZ3WithEnv (Z3 s) = runReaderT s + +--------------------------------------------------------------------- +-- * Parameters + +-- | Create a Z3 (empty) parameter set. +-- +-- Starting at Z3 4.0, parameter sets are used to configure many components +-- such as: simplifiers, tactics, solvers, etc. +mkParams :: MonadZ3 z3 => z3 Params +mkParams = liftScalar Base.mkParams + +-- | Add a Boolean parameter /k/ with value /v/ to the parameter set /p/. +paramsSetBool :: MonadZ3 z3 => Params -> Symbol -> Bool -> z3 () +paramsSetBool = liftFun3 Base.paramsSetBool + +-- | Add a unsigned parameter /k/ with value /v/ to the parameter set /p/. +paramsSetUInt :: MonadZ3 z3 => Params -> Symbol -> Word -> z3 () +paramsSetUInt = liftFun3 Base.paramsSetUInt + +-- | Add a double parameter /k/ with value /v/ to the parameter set /p/. +paramsSetDouble :: MonadZ3 z3 => Params -> Symbol -> Double -> z3 () +paramsSetDouble = liftFun3 Base.paramsSetDouble + +-- | Add a symbol parameter /k/ with value /v/ to the parameter set /p/. +paramsSetSymbol :: MonadZ3 z3 => Params -> Symbol -> Symbol -> z3 () +paramsSetSymbol = liftFun3 Base.paramsSetSymbol + +-- | Convert a parameter set into a string. +-- +-- This function is mainly used for printing the contents of a parameter set. +paramsToString :: MonadZ3 z3 => Params -> z3 String +paramsToString = liftFun1 Base.paramsToString + +-- TODO: Z3_params_validate + +--------------------------------------------------------------------- +-- Symbols + +-- | Create a Z3 symbol using an integer. +mkIntSymbol :: (MonadZ3 z3, Integral i) => i -> z3 Symbol +mkIntSymbol = liftFun1 Base.mkIntSymbol + +-- | Create a Z3 symbol using a string. +-- +-- Reference: +mkStringSymbol :: MonadZ3 z3 => String -> z3 Symbol +mkStringSymbol = liftFun1 Base.mkStringSymbol + +--------------------------------------------------------------------- +-- Sorts + +-- | Create a free (uninterpreted) type using the given name (symbol). +-- +-- Reference: +mkUninterpretedSort :: MonadZ3 z3 => Symbol -> z3 Sort +mkUninterpretedSort = liftFun1 Base.mkUninterpretedSort + +-- | Create the /boolean/ type. +-- +-- Reference: +mkBoolSort :: MonadZ3 z3 => z3 Sort +mkBoolSort = liftScalar Base.mkBoolSort + +-- | Create the /integer/ type. +-- +-- Reference: +mkIntSort :: MonadZ3 z3 => z3 Sort +mkIntSort = liftScalar Base.mkIntSort + +-- | Create the /real/ type. +-- +-- Reference: +mkRealSort :: MonadZ3 z3 => z3 Sort +mkRealSort = liftScalar Base.mkRealSort + +-- | Create a bit-vector type of the given size. +-- +-- This type can also be seen as a machine integer. +-- +-- Reference: +mkBvSort :: MonadZ3 z3 => Int -> z3 Sort +mkBvSort = liftFun1 Base.mkBvSort + +-- | Create an array type +-- +-- Reference: +-- +mkArraySort :: MonadZ3 z3 => Sort -> Sort -> z3 Sort +mkArraySort = liftFun2 Base.mkArraySort + +-- | Create a tuple type +-- +-- Reference: +mkTupleSort :: MonadZ3 z3 + => Symbol -- ^ Name of the sort + -> [(Symbol, Sort)] -- ^ Name and sort of each field + -> z3 (Sort, FuncDecl, [FuncDecl]) -- ^ Resulting sort, and function + -- declarations for the + -- constructor and projections. +mkTupleSort = liftFun2 Base.mkTupleSort + +-- | Create a contructor +-- +-- Reference: +mkConstructor :: MonadZ3 z3 + => Symbol -- ^ Name of the sonstructor + -> Symbol -- ^ Name of recognizer function + -> [(Symbol, Maybe Sort, Int)] -- ^ Name, sort option, and sortRefs + -> z3 Constructor +mkConstructor = liftFun3 Base.mkConstructor + +-- | Create datatype, such as lists, trees, records, enumerations or unions of +-- records. The datatype may be recursive. Return the datatype sort. +-- +-- Reference +mkDatatype :: MonadZ3 z3 + => Symbol + -> [Constructor] + -> z3 Sort +mkDatatype = liftFun2 Base.mkDatatype + +--------------------------------------------------------------------- +-- Constants and Applications + +-- | A Z3 function +mkFuncDecl :: MonadZ3 z3 => Symbol -> [Sort] -> Sort -> z3 FuncDecl +mkFuncDecl = liftFun3 Base.mkFuncDecl + +-- | Create a constant or function application. +-- +-- Reference: +mkApp :: MonadZ3 z3 => FuncDecl -> [AST] -> z3 AST +mkApp = liftFun2 Base.mkApp + +-- | Declare and create a constant. +-- +-- Reference: +mkConst :: MonadZ3 z3 => Symbol -> Sort -> z3 AST +mkConst = liftFun2 Base.mkConst + +-- | Declare and create a constant. +-- +-- Reference: +mkFreshConst :: MonadZ3 z3 => String -> Sort -> z3 AST +mkFreshConst = liftFun2 Base.mkFreshConst + +-- | Declare a fresh constant or function. +-- +-- Reference: +mkFreshFuncDecl :: MonadZ3 z3 => String -> [Sort] -> Sort -> z3 FuncDecl +mkFreshFuncDecl = liftFun3 Base.mkFreshFuncDecl + +------------------------------------------------- +-- ** Helpers + +-- | Declare and create a variable (aka /constant/). +-- +-- An alias for 'mkConst'. +mkVar :: MonadZ3 z3 => Symbol -> Sort -> z3 AST +mkVar = liftFun2 Base.mkVar + +-- | Declarate and create a variable of sort /bool/. +-- +-- See 'mkVar'. +mkBoolVar :: MonadZ3 z3 => Symbol -> z3 AST +mkBoolVar = liftFun1 Base.mkBoolVar + +-- | Declarate and create a variable of sort /real/. +-- +-- See 'mkVar'. +mkRealVar :: MonadZ3 z3 => Symbol -> z3 AST +mkRealVar = liftFun1 Base.mkRealVar + +-- | Declarate and create a variable of sort /int/. +-- +-- See 'mkVar'. +mkIntVar :: MonadZ3 z3 => Symbol -> z3 AST +mkIntVar = liftFun1 Base.mkIntVar + +-- | Declarate and create a variable of sort /bit-vector/. +-- +-- See 'mkVar'. +mkBvVar :: MonadZ3 z3 => Symbol + -> Int -- ^ bit-width + -> z3 AST +mkBvVar = liftFun2 Base.mkBvVar + +-- | Declare and create a /fresh/ variable (aka /constant/). +-- +-- An alias for 'mkFreshConst'. +mkFreshVar :: MonadZ3 z3 => String -> Sort -> z3 AST +mkFreshVar = liftFun2 Base.mkFreshConst + +-- | Declarate and create a /fresh/ variable of sort /bool/. +-- +-- See 'mkFreshVar'. +mkFreshBoolVar :: MonadZ3 z3 => String -> z3 AST +mkFreshBoolVar = liftFun1 Base.mkFreshBoolVar + +-- | Declarate and create a /fresh/ variable of sort /real/. +-- +-- See 'mkFreshVar'. +mkFreshRealVar :: MonadZ3 z3 => String -> z3 AST +mkFreshRealVar = liftFun1 Base.mkFreshRealVar + +-- | Declarate and create a /fresh/ variable of sort /int/. +-- +-- See 'mkFreshVar'. +mkFreshIntVar :: MonadZ3 z3 => String -> z3 AST +mkFreshIntVar = liftFun1 Base.mkFreshIntVar + +-- | Declarate and create a /fresh/ variable of sort /bit-vector/. +-- +-- See 'mkFreshVar'. +mkFreshBvVar :: MonadZ3 z3 => String + -> Int -- ^ bit-width + -> z3 AST +mkFreshBvVar = liftFun2 Base.mkFreshBvVar + +--------------------------------------------------------------------- +-- Propositional Logic and Equality + +-- | Create an AST node representing /true/. +-- +-- Reference: +mkTrue :: MonadZ3 z3 => z3 AST +mkTrue = liftScalar Base.mkTrue + +-- | Create an AST node representing /false/. +-- +-- Reference: +mkFalse :: MonadZ3 z3 => z3 AST +mkFalse = liftScalar Base.mkFalse + +-- | Create an AST node representing /l = r/. +-- +-- Reference: +mkEq :: MonadZ3 z3 => AST -> AST -> z3 AST +mkEq = liftFun2 Base.mkEq + +-- | The distinct construct is used for declaring the arguments pairwise +-- distinct. +-- +-- Reference: +mkDistinct :: MonadZ3 z3 => [AST] -> z3 AST +mkDistinct = liftFun1 Base.mkDistinct + +-- | Create an AST node representing /not(a)/. +-- +-- Reference: +mkNot :: MonadZ3 z3 => AST -> z3 AST +mkNot = liftFun1 Base.mkNot + +-- | Create an AST node representing an if-then-else: /ite(t1, t2, t3)/. +-- +-- Reference: +mkIte :: MonadZ3 z3 => AST -> AST -> AST -> z3 AST +mkIte = liftFun3 Base.mkIte + +-- | Create an AST node representing /t1 iff t2/. +-- +-- Reference: +mkIff :: MonadZ3 z3 => AST -> AST -> z3 AST +mkIff = liftFun2 Base.mkIff + +-- | Create an AST node representing /t1 implies t2/. +-- +-- Reference: +mkImplies :: MonadZ3 z3 => AST -> AST -> z3 AST +mkImplies = liftFun2 Base.mkImplies + +-- | Create an AST node representing /t1 xor t2/. +-- +-- Reference: +mkXor :: MonadZ3 z3 => AST -> AST -> z3 AST +mkXor = liftFun2 Base.mkXor + +-- | Create an AST node representing args[0] and ... and args[num_args-1]. +-- +-- Reference: +mkAnd :: MonadZ3 z3 => [AST] -> z3 AST +mkAnd = liftFun1 Base.mkAnd + +-- | Create an AST node representing args[0] or ... or args[num_args-1]. +-- +-- Reference: +mkOr :: MonadZ3 z3 => [AST] -> z3 AST +mkOr = liftFun1 Base.mkOr + +------------------------------------------------- +-- ** Helpers + +-- | Create an AST node representing the given boolean. +mkBool :: MonadZ3 z3 => Bool -> z3 AST +mkBool = liftFun1 Base.mkBool + +--------------------------------------------------------------------- +-- Arithmetic: Integers and Reals + +-- | Create an AST node representing args[0] + ... + args[num_args-1]. +-- +-- Reference: +mkAdd :: MonadZ3 z3 => [AST] -> z3 AST +mkAdd = liftFun1 Base.mkAdd + +-- | Create an AST node representing args[0] * ... * args[num_args-1]. +-- +-- Reference: +mkMul :: MonadZ3 z3 => [AST] -> z3 AST +mkMul = liftFun1 Base.mkMul + +-- | Create an AST node representing args[0] - ... - args[num_args - 1]. +-- +-- Reference: +mkSub :: MonadZ3 z3 => [AST] -> z3 AST +mkSub = liftFun1 Base.mkSub + +-- | Create an AST node representing -arg. +-- +-- Reference: +mkUnaryMinus :: MonadZ3 z3 => AST -> z3 AST +mkUnaryMinus = liftFun1 Base.mkUnaryMinus + +-- | Create an AST node representing arg1 div arg2. +-- +-- Reference: +mkDiv :: MonadZ3 z3 => AST -> AST -> z3 AST +mkDiv = liftFun2 Base.mkDiv + +-- | Create an AST node representing arg1 mod arg2. +-- +-- Reference: +mkMod :: MonadZ3 z3 => AST -> AST -> z3 AST +mkMod = liftFun2 Base.mkMod + +-- | Create an AST node representing arg1 rem arg2. +-- +-- Reference: +mkRem :: MonadZ3 z3 => AST -> AST -> z3 AST +mkRem = liftFun2 Base.mkRem + +-- | Create less than. +-- +-- Reference: +mkLt :: MonadZ3 z3 => AST -> AST -> z3 AST +mkLt = liftFun2 Base.mkLt + +-- | Create less than or equal to. +-- +-- Reference: +mkLe :: MonadZ3 z3 => AST -> AST -> z3 AST +mkLe = liftFun2 Base.mkLe + +-- | Create greater than. +-- +-- Reference: +mkGt :: MonadZ3 z3 => AST -> AST -> z3 AST +mkGt = liftFun2 Base.mkGt + +-- | Create greater than or equal to. +-- +-- Reference: +mkGe :: MonadZ3 z3 => AST -> AST -> z3 AST +mkGe = liftFun2 Base.mkGe + +-- | Coerce an integer to a real. +-- +-- Reference: +mkInt2Real :: MonadZ3 z3 => AST -> z3 AST +mkInt2Real = liftFun1 Base.mkInt2Real + +-- | Coerce a real to an integer. +-- +-- Reference: +mkReal2Int :: MonadZ3 z3 => AST -> z3 AST +mkReal2Int = liftFun1 Base.mkReal2Int + +-- | Check if a real number is an integer. +-- +-- Reference: +mkIsInt :: MonadZ3 z3 => AST -> z3 AST +mkIsInt = liftFun1 Base.mkIsInt + +--------------------------------------------------------------------- +-- Bit-vectors + +-- | Bitwise negation. +-- +-- Reference: +mkBvnot :: MonadZ3 z3 => AST -> z3 AST +mkBvnot = liftFun1 Base.mkBvnot + +-- | Take conjunction of bits in vector, return vector of length 1. +-- +-- Reference: +mkBvredand :: MonadZ3 z3 => AST -> z3 AST +mkBvredand = liftFun1 Base.mkBvredand + +-- | Take disjunction of bits in vector, return vector of length 1. +-- +-- Reference: +mkBvredor :: MonadZ3 z3 => AST -> z3 AST +mkBvredor = liftFun1 Base.mkBvredor + +-- | Bitwise and. +-- +-- Reference: +mkBvand :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvand = liftFun2 Base.mkBvand + +-- | Bitwise or. +-- +-- Reference: +mkBvor :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvor = liftFun2 Base.mkBvor + +-- | Bitwise exclusive-or. +-- +-- Reference: +mkBvxor :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvxor = liftFun2 Base.mkBvxor + +-- | Bitwise nand. +-- +-- Reference: +mkBvnand :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvnand = liftFun2 Base.mkBvnand + +-- | Bitwise nor. +-- +-- Reference: +mkBvnor :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvnor = liftFun2 Base.mkBvnor + +-- | Bitwise xnor. +-- +-- Reference: +mkBvxnor :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvxnor = liftFun2 Base.mkBvxnor + +-- | Standard two's complement unary minus. +-- +-- Reference: AST -> z3 AST +mkBvneg = liftFun1 Base.mkBvneg + +-- | Standard two's complement addition. +-- +-- Reference: +mkBvadd :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvadd = liftFun2 Base.mkBvadd + +-- | Standard two's complement subtraction. +-- +-- Reference: +mkBvsub :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsub = liftFun2 Base.mkBvsub + +-- | Standard two's complement multiplication. +-- +-- Reference: +mkBvmul :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvmul = liftFun2 Base.mkBvmul + +-- | Unsigned division. +-- +-- Reference: +mkBvudiv :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvudiv = liftFun2 Base.mkBvudiv + +-- | Two's complement signed division. +-- +-- Reference: +mkBvsdiv :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsdiv = liftFun2 Base.mkBvsdiv + +-- | Unsigned remainder. +-- +-- Reference: +mkBvurem :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvurem = liftFun2 Base.mkBvurem + +-- | Two's complement signed remainder (sign follows dividend). +-- +-- Reference: +mkBvsrem :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsrem = liftFun2 Base.mkBvsrem + +-- | Two's complement signed remainder (sign follows divisor). +-- +-- Reference: +mkBvsmod :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsmod = liftFun2 Base.mkBvsmod + +-- | Unsigned less than. +-- +-- Reference: +mkBvult :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvult = liftFun2 Base.mkBvult + +-- | Two's complement signed less than. +-- +-- Reference: +mkBvslt :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvslt = liftFun2 Base.mkBvslt + +-- | Unsigned less than or equal to. +-- +-- Reference: +mkBvule :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvule = liftFun2 Base.mkBvule + +-- | Two's complement signed less than or equal to. +-- +-- Reference: +mkBvsle :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsle = liftFun2 Base.mkBvsle + +-- | Unsigned greater than or equal to. +-- +-- Reference: +mkBvuge :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvuge = liftFun2 Base.mkBvuge + +-- | Two's complement signed greater than or equal to. +-- +-- Reference: +mkBvsge :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsge = liftFun2 Base.mkBvsge + +-- | Unsigned greater than. +-- +-- Reference: +mkBvugt :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvugt = liftFun2 Base.mkBvugt + +-- | Two's complement signed greater than. +-- +-- Reference: +mkBvsgt :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsgt = liftFun2 Base.mkBvsgt + +-- | Concatenate the given bit-vectors. +-- +-- Reference: +mkConcat :: MonadZ3 z3 => AST -> AST -> z3 AST +mkConcat = liftFun2 Base.mkConcat + +-- | Extract the bits high down to low from a bitvector of size m to yield a new +-- bitvector of size /n/, where /n = high - low + 1/. +-- +-- Reference: +mkExtract :: MonadZ3 z3 => Int -> Int -> AST -> z3 AST +mkExtract = liftFun3 Base.mkExtract + +-- | Sign-extend of the given bit-vector to the (signed) equivalent bitvector +-- of size /m+i/, where /m/ is the size of the given bit-vector. +-- +-- Reference: +mkSignExt :: MonadZ3 z3 => Int -> AST -> z3 AST +mkSignExt = liftFun2 Base.mkSignExt + +-- | Extend the given bit-vector with zeros to the (unsigned) equivalent +-- bitvector of size /m+i/, where /m/ is the size of the given bit-vector. +-- +-- Reference: +mkZeroExt :: MonadZ3 z3 => Int -> AST -> z3 AST +mkZeroExt = liftFun2 Base.mkZeroExt + +-- | Repeat the given bit-vector up length /i/. +-- +-- Reference: +mkRepeat :: MonadZ3 z3 => Int -> AST -> z3 AST +mkRepeat = liftFun2 Base.mkRepeat + +-- | Shift left. +-- +-- Reference: +mkBvshl :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvshl = liftFun2 Base.mkBvshl + +-- | Logical shift right. +-- +-- Reference: +mkBvlshr :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvlshr = liftFun2 Base.mkBvlshr + +-- | Arithmetic shift right. +-- +-- Reference: +mkBvashr :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvashr = liftFun2 Base.mkBvashr + +-- | Rotate bits of /t1/ to the left /i/ times. +-- +-- Reference: +mkRotateLeft :: MonadZ3 z3 => Int -> AST -> z3 AST +mkRotateLeft = liftFun2 Base.mkRotateLeft + +-- | Rotate bits of /t1/ to the right /i/ times. +-- +-- Reference: +mkRotateRight :: MonadZ3 z3 => Int -> AST -> z3 AST +mkRotateRight = liftFun2 Base.mkRotateRight + +-- | Rotate bits of /t1/ to the left /t2/ times. +-- +-- Reference: +mkExtRotateLeft :: MonadZ3 z3 => AST -> AST -> z3 AST +mkExtRotateLeft = liftFun2 Base.mkExtRotateLeft + +-- | Rotate bits of /t1/ to the right /t2/ times. +-- +-- Reference: +mkExtRotateRight :: MonadZ3 z3 => AST -> AST -> z3 AST +mkExtRotateRight = liftFun2 Base.mkExtRotateRight + +-- | Create an /n/ bit bit-vector from the integer argument /t1/. +-- +-- Reference: +mkInt2bv :: MonadZ3 z3 => Int -> AST -> z3 AST +mkInt2bv = liftFun2 Base.mkInt2bv + +-- | Create an integer from the bit-vector argument /t1/. If /is_signed/ is false, +-- then the bit-vector /t1/ is treated as unsigned. So the result is non-negative +-- and in the range [0..2^/N/-1], where /N/ are the number of bits in /t1/. +-- If /is_signed/ is true, /t1/ is treated as a signed bit-vector. +-- +-- Reference: +mkBv2int :: MonadZ3 z3 => AST -> Bool -> z3 AST +mkBv2int = liftFun2 Base.mkBv2int + +-- | Create a predicate that checks that the bit-wise addition of /t1/ and /t2/ +-- does not overflow. +-- +-- Reference: +mkBvaddNoOverflow :: MonadZ3 z3 => AST -> AST -> Bool -> z3 AST +mkBvaddNoOverflow = liftFun3 Base.mkBvaddNoOverflow + +-- | Create a predicate that checks that the bit-wise signed addition of /t1/ +-- and /t2/ does not underflow. +-- +-- Reference: +mkBvaddNoUnderflow :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvaddNoUnderflow = liftFun2 Base.mkBvaddNoUnderflow + +-- | Create a predicate that checks that the bit-wise signed subtraction of /t1/ +-- and /t2/ does not overflow. +-- +-- Reference: +mkBvsubNoOverflow :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsubNoOverflow = liftFun2 Base.mkBvsubNoOverflow + +-- | Create a predicate that checks that the bit-wise subtraction of /t1/ and +-- /t2/ does not underflow. +-- +-- Reference: +mkBvsubNoUnderflow :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsubNoUnderflow = liftFun2 Base.mkBvsubNoUnderflow + +-- | Create a predicate that checks that the bit-wise signed division of /t1/ +-- and /t2/ does not overflow. +-- +-- Reference: +mkBvsdivNoOverflow :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvsdivNoOverflow = liftFun2 Base.mkBvsdivNoOverflow + +-- | Check that bit-wise negation does not overflow when /t1/ is interpreted as +-- a signed bit-vector. +-- +-- Reference: +mkBvnegNoOverflow :: MonadZ3 z3 => AST -> z3 AST +mkBvnegNoOverflow = liftFun1 Base.mkBvnegNoOverflow + +-- | Create a predicate that checks that the bit-wise multiplication of /t1/ and +-- /t2/ does not overflow. +-- +-- Reference: +mkBvmulNoOverflow :: MonadZ3 z3 => AST -> AST -> Bool -> z3 AST +mkBvmulNoOverflow = liftFun3 Base.mkBvmulNoOverflow + +-- | Create a predicate that checks that the bit-wise signed multiplication of +-- /t1/ and /t2/ does not underflow. +-- +-- Reference: +mkBvmulNoUnderflow :: MonadZ3 z3 => AST -> AST -> z3 AST +mkBvmulNoUnderflow = liftFun2 Base.mkBvmulNoUnderflow + +--------------------------------------------------------------------- +-- Arrays + +-- | Array read. The argument a is the array and i is the index of the array +-- that gets read. +-- +-- Reference: +mkSelect :: MonadZ3 z3 => AST -> AST -> z3 AST +mkSelect = liftFun2 Base.mkSelect + +-- | Array update.   +-- +-- Reference: +mkStore :: MonadZ3 z3 => AST -> AST -> AST -> z3 AST +mkStore = liftFun3 Base.mkStore + +-- | Create the constant array. +-- +-- Reference: +mkConstArray :: MonadZ3 z3 => Sort -> AST -> z3 AST +mkConstArray = liftFun2 Base.mkConstArray + +-- | map f on the the argument arrays. +-- +-- Reference: +mkMap :: MonadZ3 z3 => FuncDecl -> [AST] -> z3 AST +mkMap = liftFun2 Base.mkMap + +-- | Access the array default value. Produces the default range value, for +-- arrays that can be represented as finite maps with a default range value. +-- +-- Reference: +mkArrayDefault :: MonadZ3 z3 => AST -> z3 AST +mkArrayDefault = liftFun1 Base.mkArrayDefault + +--------------------------------------------------------------------- +-- * Numerals + +-- | Create a numeral of a given sort. +-- +-- Reference: +mkNumeral :: MonadZ3 z3 => String -> Sort -> z3 AST +mkNumeral = liftFun2 Base.mkNumeral + +-- | Create a numeral of sort /real/. +mkReal :: MonadZ3 z3 => Int -> Int -> z3 AST +mkReal = liftFun2 Base.mkReal + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +-- +-- This function can be use to create numerals that fit in a +-- /machine integer/. +-- It is slightly faster than 'mkNumeral' since it is not necessary +-- to parse a string. +mkInt :: MonadZ3 z3 => Int -> Sort -> z3 AST +mkInt = liftFun2 Base.mkInt + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +-- +-- This function can be use to create numerals that fit in a +-- /machine unsigned integer/. +-- It is slightly faster than 'mkNumeral' since it is not necessary +-- to parse a string. +mkUnsignedInt :: MonadZ3 z3 => Word -> Sort -> z3 AST +mkUnsignedInt = liftFun2 Base.mkUnsignedInt + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +-- +-- This function can be use to create numerals that fit in a +-- /machine 64-bit integer/. +-- It is slightly faster than 'mkNumeral' since it is not necessary +-- to parse a string. +mkInt64 :: MonadZ3 z3 => Int64 -> Sort -> z3 AST +mkInt64 = liftFun2 Base.mkInt64 + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +-- +-- This function can be use to create numerals that fit in a +-- /machine unsigned 64-bit integer/. +-- It is slightly faster than 'mkNumeral' since it is not necessary +-- to parse a string. +mkUnsignedInt64 :: MonadZ3 z3 => Word64 -> Sort -> z3 AST +mkUnsignedInt64 = liftFun2 Base.mkUnsignedInt64 + +------------------------------------------------- +-- ** Helpers + +-- | Create a numeral of an int, bit-vector, or finite-domain sort. +mkIntegral :: (MonadZ3 z3, Integral a) => a -> Sort -> z3 AST +mkIntegral = liftFun2 Base.mkIntegral + +-- | Create a numeral of sort /real/ from a 'Rational'. +mkRational :: MonadZ3 z3 => Rational -> z3 AST +mkRational = liftFun1 Base.mkRational + +-- | Create a numeral of sort /real/ from a 'Fixed'. +mkFixed :: (MonadZ3 z3, HasResolution a) => Fixed a -> z3 AST +mkFixed = liftFun1 Base.mkFixed + +-- | Create a numeral of sort /real/ from a 'Real'. +mkRealNum :: (MonadZ3 z3, Real r) => r -> z3 AST +mkRealNum = liftFun1 Base.mkRealNum + +-- | Create a numeral of sort /int/ from an 'Integer'. +mkInteger :: MonadZ3 z3 => Integer -> z3 AST +mkInteger = liftFun1 Base.mkInteger + +-- | Create a numeral of sort /int/ from an 'Integral'. +mkIntNum :: (MonadZ3 z3, Integral a) => a -> z3 AST +mkIntNum = liftFun1 Base.mkIntNum + +-- | Create a numeral of sort /Bit-vector/ from an 'Integer'. +mkBitvector :: MonadZ3 z3 => Int -- ^ bit-width + -> Integer -- ^ integer value + -> z3 AST +mkBitvector = liftFun2 Base.mkBitvector + +-- | Create a numeral of sort /Bit-vector/ from an 'Integral'. +mkBvNum :: (MonadZ3 z3, Integral i) => Int -- ^ bit-width + -> i -- ^ integer value + -> z3 AST +mkBvNum = liftFun2 Base.mkBvNum + +--------------------------------------------------------------------- +-- Quantifiers + +mkPattern :: MonadZ3 z3 => [AST] -> z3 Pattern +mkPattern = liftFun1 Base.mkPattern + +mkBound :: MonadZ3 z3 => Int -> Sort -> z3 AST +mkBound = liftFun2 Base.mkBound + +mkForall :: MonadZ3 z3 => [Pattern] -> [Symbol] -> [Sort] -> AST -> z3 AST +mkForall = liftFun4 Base.mkForall + +mkForallConst :: MonadZ3 z3 => [Pattern] -> [App] -> AST -> z3 AST +mkForallConst = liftFun3 Base.mkForallConst + +mkExistsConst :: MonadZ3 z3 => [Pattern] -> [App] -> AST -> z3 AST +mkExistsConst = liftFun3 Base.mkExistsConst + +mkExists :: MonadZ3 z3 => [Pattern] -> [Symbol] -> [Sort] -> AST -> z3 AST +mkExists = liftFun4 Base.mkExists + +--------------------------------------------------------------------- +-- Accessors + +-- | Return the symbol name. +-- +-- Reference: +getSymbolString :: MonadZ3 z3 => Symbol -> z3 String +getSymbolString = liftFun1 Base.getSymbolString + +-- | Return the size of the given bit-vector sort. +-- +-- Reference: +getBvSortSize :: MonadZ3 z3 => Sort -> z3 Int +getBvSortSize = liftFun1 Base.getBvSortSize + +-- | Get list of constructors for datatype. +getDatatypeSortConstructors :: MonadZ3 z3 + => Sort -- ^ Datatype sort. + -> z3 [FuncDecl] -- ^ Constructor declarations. +getDatatypeSortConstructors = liftFun1 Base.getDatatypeSortConstructors + +-- | Get list of recognizers for datatype. +getDatatypeSortRecognizers :: MonadZ3 z3 + => Sort -- ^ Datatype sort. + -> z3 [FuncDecl] -- ^ Constructor recognizers. +getDatatypeSortRecognizers = liftFun1 Base.getDatatypeSortRecognizers + +-- | Return the constant declaration name as a symbol. +-- +-- Reference: +getDeclName :: MonadZ3 z3 => FuncDecl -> z3 Symbol +getDeclName = liftFun1 Base.getDeclName + +-- | Return the sort of an AST node. +getSort :: MonadZ3 z3 => AST -> z3 Sort +getSort = liftFun1 Base.getSort + +-- | Returns @Just True@, @Just False@, or @Nothing@ for /undefined/. +-- +-- Reference: +getBoolValue :: MonadZ3 z3 => AST -> z3 (Maybe Bool) +getBoolValue = liftFun1 Base.getBoolValue + +-- | Return the kind of the given AST. +-- +-- Reference: +getAstKind :: MonadZ3 z3 => AST -> z3 ASTKind +getAstKind = liftFun1 Base.getAstKind + +-- | Cast AST into an App. +toApp :: MonadZ3 z3 => AST -> z3 App +toApp = liftFun1 Base.toApp + +-- | Return numeral value, as a string of a numeric constant term. +getNumeralString :: MonadZ3 z3 => AST -> z3 String +getNumeralString = liftFun1 Base.getNumeralString + +------------------------------------------------- +-- ** Helpers + +-- | Read a 'Bool' value from an 'AST' +getBool :: MonadZ3 z3 => AST -> z3 Bool +getBool = liftFun1 Base.getBool + +-- | Return the integer value +getInt :: MonadZ3 z3 => AST -> z3 Integer +getInt = liftFun1 Base.getInt + +-- | Return rational value +getReal :: MonadZ3 z3 => AST -> z3 Rational +getReal = liftFun1 Base.getReal + +-- | Read the 'Integer' value from an 'AST' of sort /bit-vector/. +-- +-- See 'mkBv2int'. +getBv :: MonadZ3 z3 => AST + -> Bool -- ^ signed? + -> z3 Integer +getBv = liftFun2 Base.getBv + +--------------------------------------------------------------------- +-- Models + +-- | Evaluate an AST node in the given model. +-- +-- The evaluation may fail for the following reasons: +-- +-- * /t/ contains a quantifier. +-- * the model /m/ is partial. +-- * /t/ is type incorrect. +modelEval :: MonadZ3 z3 => Model -> AST -> z3 (Maybe AST) +modelEval = liftFun2 Base.modelEval + +-- | Get array as a list of argument/value pairs, if it is +-- represented as a function (ie, using as-array). +evalArray :: MonadZ3 z3 => Model -> AST -> z3 (Maybe FuncModel) +evalArray = liftFun2 Base.evalArray + +-- | Return the interpretation of the function f in the model m. +-- Return NULL, if the model does not assign an interpretation for f. +-- That should be interpreted as: the f does not matter. +-- +-- Reference: +getFuncInterp :: MonadZ3 z3 => Model -> FuncDecl -> z3 (Maybe FuncInterp) +getFuncInterp = liftFun2 Base.getFuncInterp + +-- | The (_ as-array f) AST node is a construct for assigning interpretations +-- for arrays in Z3. It is the array such that forall indices i we have that +-- (select (_ as-array f) i) is equal to (f i). This procedure returns Z3_TRUE +-- if the a is an as-array AST node. +-- +-- Reference: +isAsArray :: MonadZ3 z3 => AST -> z3 Bool +isAsArray = liftFun1 Base.isAsArray + +-- | Return the function declaration f associated with a (_ as_array f) node. +-- +-- Reference: +getAsArrayFuncDecl :: MonadZ3 z3 => AST -> z3 FuncDecl +getAsArrayFuncDecl = liftFun1 Base.getAsArrayFuncDecl + +-- | Return the number of entries in the given function interpretation. +-- +-- Reference: +funcInterpGetNumEntries :: MonadZ3 z3 => FuncInterp -> z3 Int +funcInterpGetNumEntries = liftFun1 Base.funcInterpGetNumEntries + +-- | Return a "point" of the given function intepretation. +-- It represents the value of f in a particular point. +-- +-- Reference: +funcInterpGetEntry :: MonadZ3 z3 => FuncInterp -> Int -> z3 FuncEntry +funcInterpGetEntry = liftFun2 Base.funcInterpGetEntry + +-- | Return the 'else' value of the given function interpretation. +-- +-- Reference: +funcInterpGetElse :: MonadZ3 z3 => FuncInterp -> z3 AST +funcInterpGetElse = liftFun1 Base.funcInterpGetElse + +-- | Return the arity (number of arguments) of the given function +-- interpretation. +-- +-- Reference: +funcInterpGetArity :: MonadZ3 z3 => FuncInterp -> z3 Int +funcInterpGetArity = liftFun1 Base.funcInterpGetArity + +-- | Return the value of this point. +-- +-- Reference: +funcEntryGetValue :: MonadZ3 z3 => FuncEntry -> z3 AST +funcEntryGetValue = liftFun1 Base.funcEntryGetValue + +-- | Return the number of arguments in a Z3_func_entry object. +-- +-- Reference: +funcEntryGetNumArgs :: MonadZ3 z3 => FuncEntry -> z3 Int +funcEntryGetNumArgs = liftFun1 Base.funcEntryGetNumArgs + +-- | Return an argument of a Z3_func_entry object. +-- +-- Reference: +funcEntryGetArg :: MonadZ3 z3 => FuncEntry -> Int -> z3 AST +funcEntryGetArg = liftFun2 Base.funcEntryGetArg + +-- | Convert the given model into a string. +modelToString :: MonadZ3 z3 => Model -> z3 String +modelToString = liftFun1 Base.modelToString + +-- | Alias for 'modelToString'. +showModel :: MonadZ3 z3 => Model -> z3 String +showModel = modelToString + +------------------------------------------------- +-- ** Helpers + +-- | Type of an evaluation function for 'AST'. +-- +-- Evaluation may fail (i.e. return 'Nothing') for a few +-- reasons, see 'modelEval'. +type EvalAst m a = Model -> AST -> m (Maybe a) + +-- | An alias for 'modelEval'. +eval :: MonadZ3 z3 => EvalAst z3 AST +eval = liftFun2 Base.eval + +-- | Evaluate an AST node of sort /bool/ in the given model. +-- +-- See 'modelEval' and 'getBool'. +evalBool :: MonadZ3 z3 => EvalAst z3 Bool +evalBool = liftFun2 Base.evalBool + +-- | Evaluate an AST node of sort /int/ in the given model. +-- +-- See 'modelEval' and 'getInt'. +evalInt :: MonadZ3 z3 => EvalAst z3 Integer +evalInt = liftFun2 Base.evalInt + +-- | Evaluate an AST node of sort /real/ in the given model. +-- +-- See 'modelEval' and 'getReal'. +evalReal :: MonadZ3 z3 => EvalAst z3 Rational +evalReal = liftFun2 Base.evalReal + +-- | Evaluate an AST node of sort /bit-vector/ in the given model. +-- +-- The flag /signed/ decides whether the bit-vector value is +-- interpreted as a signed or unsigned integer. +-- +-- See 'modelEval' and 'getBv'. +evalBv :: MonadZ3 z3 => Bool -- ^ signed? + -> EvalAst z3 Integer +evalBv = liftFun3 Base.evalBv + +-- | Evaluate a collection of AST nodes in the given model. +evalT :: (MonadZ3 z3,Traversable t) => Model -> t AST -> z3 (Maybe (t AST)) +evalT = liftFun2 Base.evalT + +-- | Run a evaluation function on a 'Traversable' data structure of 'AST's +-- (e.g. @[AST]@, @Vector AST@, @Maybe AST@, etc). +-- +-- This a generic version of 'evalT' which can be used in combination with +-- other helpers. For instance, @mapEval evalInt@ can be used to obtain +-- the 'Integer' interpretation of a list of 'AST' of sort /int/. +mapEval :: (MonadZ3 z3, Traversable t) => EvalAst z3 a + -> Model + -> t AST + -> z3 (Maybe (t a)) +mapEval f m = fmap T.sequence . T.mapM (f m) + +-- | Get function as a list of argument/value pairs. +evalFunc :: MonadZ3 z3 => Model -> FuncDecl -> z3 (Maybe FuncModel) +evalFunc = liftFun2 Base.evalFunc + +--------------------------------------------------------------------- +-- String Conversion + +-- | Set the mode for converting expressions to strings. +setASTPrintMode :: MonadZ3 z3 => ASTPrintMode -> z3 () +setASTPrintMode = liftFun1 Base.setASTPrintMode + +-- | Convert an AST to a string. +astToString :: MonadZ3 z3 => AST -> z3 String +astToString = liftFun1 Base.astToString + +-- | Convert a pattern to a string. +patternToString :: MonadZ3 z3 => Pattern -> z3 String +patternToString = liftFun1 Base.patternToString + +-- | Convert a sort to a string. +sortToString :: MonadZ3 z3 => Sort -> z3 String +sortToString = liftFun1 Base.sortToString + +-- | Convert a FuncDecl to a string. +funcDeclToString :: MonadZ3 z3 => FuncDecl -> z3 String +funcDeclToString = liftFun1 Base.funcDeclToString + +-- | Convert the given benchmark into SMT-LIB formatted string. +-- +-- The output format can be configured via 'setASTPrintMode'. +benchmarkToSMTLibString :: MonadZ3 z3 => + String -- ^ name + -> String -- ^ logic + -> String -- ^ status + -> String -- ^ attributes + -> [AST] -- ^ assumptions1 + -> AST -- ^ formula + -> z3 String +benchmarkToSMTLibString = liftFun6 Base.benchmarkToSMTLibString + +--------------------------------------------------------------------- +-- Miscellaneous + +-- | Return Z3 version number information. +getVersion :: MonadZ3 z3 => z3 Version +getVersion = liftIO Base.getVersion + +--------------------------------------------------------------------- +-- * Solvers + +-- mkSolver :: Context -> IO Solver +-- mkSolver = liftFun0 z3_mk_solver + +-- mkSimpleSolver :: Context -> IO Solver +-- mkSimpleSolver = liftFun0 z3_mk_simple_solver + +-- mkSolverForLogic :: Context -> Logic -> IO Solver +-- mkSolverForLogic c logic = withContextError c $ \cPtr -> +-- do sym <- mkStringSymbol c (show logic) +-- c2h c =<< z3_mk_solver_for_logic cPtr (unSymbol sym) + +-- | Return a string describing all solver available parameters. +solverGetHelp :: MonadZ3 z3 => z3 String +solverGetHelp = liftSolver0 Base.solverGetHelp + +-- | Set the solver using the given parameters. +solverSetParams :: MonadZ3 z3 => Params -> z3 () +solverSetParams = liftSolver1 Base.solverSetParams + +-- | Create a backtracking point. +solverPush :: MonadZ3 z3 => z3 () +solverPush = liftSolver0 Base.solverPush + +-- | Backtrack /n/ backtracking points. +solverPop :: MonadZ3 z3 => Int -> z3 () +solverPop = liftSolver1 Base.solverPop + +solverReset :: MonadZ3 z3 => z3 () +solverReset = liftSolver0 Base.solverReset + +-- | Number of backtracking points. +solverGetNumScopes :: MonadZ3 z3 => z3 Int +solverGetNumScopes = liftSolver0 Base.solverGetNumScopes + +-- | Assert a constraing into the logical context. +-- +-- Reference: +solverAssertCnstr :: MonadZ3 z3 => AST -> z3 () +solverAssertCnstr = liftSolver1 Base.solverAssertCnstr + +-- | Assert a constraint a into the solver, and track it +-- (in the unsat) core using the Boolean constant /p/. +-- +-- This API is an alternative to Z3_solver_check_assumptions +-- for extracting unsat cores. Both APIs can be used in the same +-- solver. The unsat core will contain a combination of the Boolean +-- variables provided using Z3_solver_assert_and_track and the +-- Boolean literals provided using Z3_solver_check_assumptions. +solverAssertAndTrack :: MonadZ3 z3 => AST -> AST -> z3 () +solverAssertAndTrack = liftSolver2 Base.solverAssertAndTrack + +-- | Check whether the assertions in a given solver are consistent or not. +solverCheck :: MonadZ3 z3 => z3 Result +solverCheck = liftSolver0 Base.solverCheck + +-- | Check whether the assertions in the given solver and optional assumptions are consistent or not. +solverCheckAssumptions :: MonadZ3 z3 => [AST] -> z3 Result +solverCheckAssumptions = liftSolver1 Base.solverCheckAssumptions + +-- | Retrieve the model for the last 'solverCheck'. +-- +-- The error handler is invoked if a model is not available because +-- the commands above were not invoked for the given solver, +-- or if the result was 'Unsat'. +solverGetModel :: MonadZ3 z3 => z3 Model +solverGetModel = liftSolver0 Base.solverGetModel + +-- | Retrieve the unsat core for the last 'solverCheckAssumptions'; the unsat core is a subset of the assumptions +solverGetUnsatCore :: MonadZ3 z3 => z3 [AST] +solverGetUnsatCore = liftSolver0 Base.solverGetUnsatCore + +-- | Return a brief justification for an 'Unknown' result for the commands 'solverCheck' and 'solverCheckAssumptions'. +solverGetReasonUnknown :: MonadZ3 z3 => z3 String +solverGetReasonUnknown = liftSolver0 Base.solverGetReasonUnknown + +-- | Convert the given solver into a string. +solverToString :: MonadZ3 z3 => z3 String +solverToString = liftSolver0 Base.solverToString + +------------------------------------------------- +-- ** Helpers + +-- | Create a backtracking point. +-- +-- For @push; m; pop 1@ see 'local'. +push :: MonadZ3 z3 => z3 () +push = solverPush + +-- | Backtrack /n/ backtracking points. +-- +-- Contrary to 'solverPop' this funtion checks whether /n/ is within +-- the size of the solver scope stack. +pop :: MonadZ3 z3 => Int -> z3 () +pop n = do + scopes <- solverGetNumScopes + if n <= scopes + then solverPop n + else error "Z3.Monad.safePop: too many scopes to backtrack" + +-- | Run a query and restore the initial logical context. +-- +-- This is a shorthand for 'push', run the query, and 'pop'. +local :: MonadZ3 z3 => z3 a -> z3 a +local q = do + push + r <- q + pop 1 + return r + +-- | Backtrack all the way. +reset :: MonadZ3 z3 => z3 () +reset = solverReset + +-- | Get number of backtracking points. +getNumScopes :: MonadZ3 z3 => z3 Int +getNumScopes = liftSolver0 Base.solverGetNumScopes + +assert :: MonadZ3 z3 => AST -> z3 () +assert = solverAssertCnstr + +-- | Check whether the given logical context is consistent or not. +check :: MonadZ3 z3 => z3 Result +check = solverCheck + +-- | Check whether the assertions in the given solver and optional assumptions are consistent or not. +checkAssumptions :: MonadZ3 z3 => [AST] -> z3 Result +checkAssumptions = solverCheckAssumptions + +solverCheckAndGetModel :: MonadZ3 z3 => z3 (Result, Maybe Model) +solverCheckAndGetModel = liftSolver0 Base.solverCheckAndGetModel + +-- | Get model. +-- +-- Reference : +getModel :: MonadZ3 z3 => z3 (Result, Maybe Model) +getModel = solverCheckAndGetModel + +-- | Check satisfiability and, if /sat/, compute a value from the given model. +-- +-- E.g. +-- @ +-- withModel $ \\m -> +-- fromJust \<$\> evalInt m x +-- @ +withModel :: (Applicative z3, MonadZ3 z3) => + (Base.Model -> z3 a) -> z3 (Result, Maybe a) +withModel f = do + (r,mb_m) <- getModel + mb_e <- T.traverse f mb_m + return (r, mb_e) + +-- | Retrieve the unsat core for the last 'checkAssumptions'; the unsat core is a subset of the assumptions. +getUnsatCore :: MonadZ3 z3 => z3 [AST] +getUnsatCore = solverGetUnsatCore diff --git a/src/Z3/Opts.hs b/src/Z3/Opts.hs new file mode 100644 --- /dev/null +++ b/src/Z3/Opts.hs @@ -0,0 +1,129 @@ + +-- | +-- Module : Z3.Opts +-- Copyright : (c) Iago Abal, 2013-2015 +-- (c) David Castro, 2013 +-- License : BSD3 +-- Maintainer: Iago Abal , +-- David Castro +-- +-- Configuring Z3. +-- +-- Z3 has plenty of configuration options and these had varied quite +-- a lot from Z3 3.x to Z3 4.x. We decided to keep things simple. +-- +-- Configurations are essentially sets of 'String' pairs, assigning +-- values to parameters. We just provide a thin layer of abstraction +-- on top of this. +-- +-- For instance, @opt \"proof\" True@ creates a configuration where +-- proof generation is enabled. The first argument of 'opt' is the +-- option name, the second is the option value. The same configuration +-- is created by @opt \"proof\" \"true\"@. We do not check option names, +-- and we do not assign types to options ---any 'String' is accepted +-- as a value. The 'OptValue' class is a specialization of 'Show' to +-- convert Haskell values into a proper 'String' representation for Z3. +-- +-- Configurations can be combined with the '+?' operator, for instance, +-- @opt \"proof\" True +? opt \"model\" True@ is a configuration with both +-- proof and model generation enabled. Configurations are 'Monoid's, +-- and '+?' is just an alias for 'mappend'. +-- +-- Configurations are set by 'setOpts' if you are using "Z3.Base", or +-- passing the configuration object (of type 'Opts') to a runner if you +-- are using the "Z3.Monad" interface. +-- + +module Z3.Opts + ( -- * Z3 configuration + Opts + , setOpts + , stdOpts + , (+?) + -- * Z3 options + , opt + , OptValue + ) + where + +import qualified Z3.Base as Base + +import Data.Fixed ( Fixed ) +import qualified Data.Fixed as Fixed +import Data.Monoid ( Monoid(..) ) + +--------------------------------------------------------------------- +-- Configuration + +-- | Z3 configuration. +newtype Opts = Opts [Opt] + +instance Monoid Opts where + mempty = Opts [] + mappend (Opts ps1) (Opts ps2) = Opts (ps1++ps2) + +singleton :: Opt -> Opts +singleton o = Opts [o] + +-- | Default configuration. +stdOpts :: Opts +stdOpts = mempty + +-- | Append configurations. +(+?) :: Opts -> Opts -> Opts +(+?) = mappend + +-- | Set a configuration option. +opt :: OptValue val => String -> val -> Opts +opt oid val = singleton $ option oid val + +-- | Set configuration. +-- +-- If you are using the 'Z3.Monad' interface, you don't need to +-- call this function directly, just pass your 'Opts' to /evalZ3*/ +-- functions. +setOpts :: Base.Config -> Opts -> IO () +setOpts baseCfg (Opts params) = mapM_ (setOpt baseCfg) params + +------------------------------------------------- +-- Options + +-- | Pair option-value. +data Opt = Opt String -- id + String -- value + +-- | Set an option. +setOpt :: Base.Config -> Opt -> IO () +setOpt baseCfg (Opt oid val) = Base.setParamValue baseCfg oid val + +-- | Values for Z3 options. +-- +-- Any 'OptValue' type can be passed to a Z3 option (and values will be +-- converted into an appropriate 'String'). +-- +-- /Since 0.4/ the 'Double' instance has been replaced by a new 'Fixed' +-- instance. +class OptValue val where + option :: String -> val -> Opt + +instance OptValue Bool where + option oid = Opt oid . boolVal + +instance OptValue Int where + option oid = Opt oid . show + +instance OptValue Integer where + option oid = Opt oid . show + +instance Fixed.HasResolution a => OptValue (Fixed a) where + option oid = Opt oid . Fixed.showFixed True + +instance OptValue [Char] where + option = Opt + +------------------------------------------------- +-- Utils + +boolVal :: Bool -> String +boolVal True = "true" +boolVal False = "false" diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/z3.cabal b/z3.cabal --- a/z3.cabal +++ b/z3.cabal @@ -1,81 +1,76 @@ Name: z3 -Version: 0.3.2 +Version: 4.0.0 Synopsis: Bindings for the Z3 Theorem Prover Description: - Bindings for the Z3 Theorem Prover (). - . - Low-level bindings to the Z3 API are provided by "Z3.Base", this API is - still incomplete but pretty much stable. + Bindings for the (now open source!) Z3 4./x/ Theorem Prover (). . - A simple but convenient wrapper for "Z3.Base" is provided by "Z3.Monad". + * "Z3.Base.C" provides the raw foreign imports from Z3's C API. . - The "Z3.Lang" API provides a high-level interface to Z3, but it is still - very experimental and likely to change. + * "Z3.Base" does the marshaling of values between Haskell and C, + and transparently handles reference counting of Z3 objects for you. . - * In version 0.3.2 the "Z3.Lang" interface has been deprecated, we will move - it to a dedicated package. + * "Z3.Monad" provides a convenient monadic wrapper for the common usage scenario. . - Important notes: + Examples: . - * Installation (Unix-like): Just be sure to use the standard locations for - dynamic libraries (\/usr\/lib) and header files (\/usr\/include), or else - use the --extra-lib-dirs and --extra-include-dirs Cabal flags. + Changelog: . - * Haddock documentation can be found at - . + Installation: . - * Hackage fails to compile this package because of the (unsatisfied) /libz3/ - dependency. + * /Unix-like/: Just be sure to use the standard locations for + dynamic libraries (\/usr\/lib) and header files (\/usr\/include), + or else use the --extra-lib-dirs and --extra-include-dirs Cabal flags. . - A changelog is available at + (Hackage reports a build failure because Z3's library is missing.) + Homepage: http://bitbucket.org/iago/z3-haskell License: BSD3 License-file: LICENSE Author: Iago Abal , David Castro -Maintainer: Iago Abal , - David Castro -Copyright: 2012-2014, Iago Abal, David Castro -Category: Math, SMT, Theorem Provers, Formal Methods +Maintainer: Iago Abal +Copyright: 2012-2015, Iago Abal, David Castro +Category: Math, SMT, Theorem Provers, Formal Methods, Bit vectors Build-type: Simple -Cabal-version: >= 1.6 +Cabal-version: >= 1.8 +Extra-source-files: README.md CHANGES.md HACKING.md + source-repository head type: mercurial location: https://bitbucket.org/iago/z3-haskell Library + hs-source-dirs: src + Exposed-modules: Z3.Base + Z3.Base.C Z3.Opts Z3.Monad - Z3.Lang - Z3.Lang.Prelude - Z3.Lang.Nat - Z3.Lang.Lg2 - Z3.Lang.Pow2 - - Other-modules: - - Z3.Base.C - - Z3.Lang.Exprs - Z3.Lang.Monad - Z3.Lang.TY - + -- TODO: Add flag to compile with -Werror, Hackage doesn't like it. ghc-options: -Wall -- Ban to mtl-2.1: modify in MonadState causes <> in mtl-2.1 - Build-depends: base > 3 && < 5, containers, mtl < 2.1 || > 2.1 + Build-depends: base >= 4.5 && <5, + containers, + mtl > 2.1 Build-tools: hsc2hs Extensions: FlexibleInstances + FlexibleContexts ForeignFunctionInterface + MultiParamTypeClasses + Other-extensions: DeriveDataTypeable + EmptyDataDecls + GeneralizedNewtypeDeriving + PatternGuards + includes: z3.h -- In OS X libz3 is linked statically against libgomp. @@ -84,3 +79,38 @@ extra-libraries: z3 else extra-libraries: gomp z3 gomp + +Flag examples + Description: Build examples. + Default: False + Manual: True + +Executable examples + if flag(examples) + Buildable: True + Build-depends: base >=4.5, + z3 >=0.4, + containers, + mtl >2.1 + else + Buildable: False + + Hs-source-dirs: examples + Main-Is: Examples.hs + +Test-suite spec + + Type: exitcode-stdio-1.0 + + Ghc-options: -Wall + + Extensions: ScopedTypeVariables + + Hs-source-dirs: test + + Main-is: Spec.hs + + Build-depends: base >= 4.5, + z3 >= 0.4, + hspec >= 2.1, + QuickCheck >= 2.5.1