{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} -- | -- Module : Z3.Base -- Copyright : (c) Iago Abal, 2012 -- (c) David Castro, 2012 -- License : BSD3 -- Maintainer: Iago Abal , -- David Castro -- -- Medium-level bindings, highly inspired by yices-painless. -- module Z3.Base ( -- * Types Config , Context , Symbol , AST , Sort , App , Pattern , Model , castAST -- ** Satisfiability result , Result(..) -- ** Z3 types , Z3Type(..) , Z3Scalar(..) , Z3Num -- * Configuration , mkConfig , setParamValue , set_MODEL , set_MODEL_PARTIAL , set_WELL_SORTED_CHECK -- * Context , mkContext -- * Symbols , mkStringSymbol -- * Sorts , mkBoolSort , mkIntSort , mkRealSort -- * Constants and Applications , mkConst , mkTrue , mkFalse , mkEq , mkNot , mkIte , mkIff , mkImplies , mkXor , mkAnd , mkOr , mkAdd , mkMul , mkSub , mkUnaryMinus , mkDiv , mkMod , mkRem , mkLt , mkLe , mkGt , mkGe , mkInt2Real , mkReal2Int , mkIsInt -- * Numerals , mkNumeral , mkInt , mkReal -- * Accessors , getBool , getInt , getReal -- * Models , eval -- * Constraints , assertCnstr , check , getModel ) where import Z3.Base.C import Z3.Types.TY import Control.Applicative ( (<$>) ) import Control.Monad ( liftM2 ) import Data.Typeable ( Typeable ) import Data.Int import Data.Ratio ( Ratio, numerator, denominator, (%) ) import Data.Word import Data.Typeable ( Typeable, typeOf ) import Foreign hiding ( newForeignPtr, toBool ) import Foreign.C ( CInt, CUInt, CLLong, CULLong , peekCString , withCString ) import Foreign.Concurrent ( newForeignPtr ) --------------------------------------------------------------------- -- Types -- -- | A Z3 /configuration object/. -- -- -- /Notes:/ -- -- * The resource is automatically managed by the Haskell garbage -- collector, and the structure is automatically deleted once it is out -- of scope (no need to call 'z3_del_config'). -- newtype Config = Config { unConfig :: ForeignPtr Z3_config } deriving Eq -- | A Z3 /logical context/. -- -- -- /Notes:/ -- -- * The resource is automatically managed by the Haskell garbage -- collector, and the structure is automatically deleted once it is out -- of scope (no need to call 'z3_del_context'). -- newtype Context = Context { unContext :: ForeignPtr Z3_context } deriving Eq -- | A Z3 /Lisp-link symbol/. -- newtype Symbol = Symbol { unSymbol :: Ptr Z3_symbol } deriving (Eq, Ord, Show, Storable) -- | A Z3 /AST node/. -- -- TODO: Does the extra type safety provided by the phantom type worth -- complicating the higher-level layers such as 'Z3.Monad' ? -- newtype AST a = AST { unAST :: Ptr Z3_ast } deriving (Eq, Ord, Show, Storable) -- | Cast an 'AST a' to 'AST b' when 'a' and 'b' are the same type. -- -- This is useful when unpacking an existentially quantified AST. -- castAST :: forall a b. (Z3Type a, Z3Type b) => AST a -> Maybe (AST b) castAST (AST a) | typeOf (TY::TY a) == typeOf (TY::TY b) = Just (AST a) | otherwise = Nothing -- | Kind of Z3 AST representing /types/. -- newtype Sort a = Sort { unSort :: Ptr Z3_sort } deriving (Eq, Ord, Show, Storable) -- | A kind of Z3 AST used to represent constant and function declarations. -- newtype App a = App { _unApp :: Ptr Z3_app } deriving (Eq, Ord, Show, Storable) -- | A kind of AST used to represent pattern and multi-patterns used 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. -- data Model = Model { modelContext :: Context , unModel :: ForeignPtr Z3_model } deriving Eq -- | Result of a satisfiability check. -- data Result = Sat | Unsat | Undef deriving (Eq, Ord, Enum, Bounded, Read, Show) -- | 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 convenient. -- toBool :: Z3_bool -> Bool toBool b | b == z3_true = True | b == z3_false = False | otherwise = error "Z3.Base.toBool: illegal `Z3_bool' value" ----------------------------------------------------------- -- Z3 types -- -- | A Z3 type -- class Typeable a => Z3Type a where mkSort :: Context -> IO (Sort a) instance Z3Type Bool where mkSort = mkBoolSort instance Z3Type Integer where mkSort = mkIntSort instance Z3Type Rational where mkSort = mkRealSort -- | A Z3 scalar type -- class (Eq a, Show a, Z3Type a) => Z3Scalar a where mkValue :: Context -> a -> IO (AST a) getValue :: Context -> AST a -> IO (Maybe a) instance Z3Scalar Bool where mkValue ctx True = mkTrue ctx mkValue ctx False = mkFalse ctx getValue = getBool instance Z3Scalar Integer where mkValue ctx = mkInt ctx getValue ctx ast = Just <$> getInt ctx ast instance Z3Scalar Rational where mkValue ctx = mkReal ctx getValue ctx ast = Just <$> getReal ctx ast -- | A Z3 numeric type -- class (Z3Scalar a, Num a) => Z3Num a where instance Z3Num Integer where instance Z3Num Rational where --------------------------------------------------------------------- -- Configuration -- | Create a configuration. -- -- Reference: -- mkConfig :: IO Config mkConfig = do ptr <- z3_mk_config fptr <- newForeignPtr ptr (z3_del_config ptr) return $! Config fptr -- | Set a configuration parameter. -- -- Reference: -- -- See: -- setParamValue :: Config -> String -> String -> IO () setParamValue cfg s1 s2 = withForeignPtr (unConfig cfg) $ \cfgPtr -> withCString s1 $ \cs1 -> withCString s2 $ \cs2 -> z3_set_param_value cfgPtr cs1 cs2 -- | Set the /MODEL/ configuration parameter. -- -- default: 'True', enable/disable model construction. -- set_MODEL :: Config -> Bool -> IO () set_MODEL cfg True = setParamValue cfg "MODEL" "true" set_MODEL cfg False = setParamValue cfg "MODEL" "false" -- | Set the /MODEL_PARTIAL/ configuration parameter. -- -- default: 'False', enable/disable partial function interpretations. -- set_MODEL_PARTIAL :: Config -> Bool -> IO () set_MODEL_PARTIAL cfg True = setParamValue cfg "MODEL_PARTIAL" "true" set_MODEL_PARTIAL cfg False = setParamValue cfg "MODEL_PARTIAL" "false" -- | Set the /WELL_SORTED_CHECK/ configuration parameter. -- -- default: 'True', enable/disable type checker. -- set_WELL_SORTED_CHECK :: Config -> Bool -> IO () set_WELL_SORTED_CHECK cfg True = setParamValue cfg "MWELL_SORTED_CHECK" "true" set_WELL_SORTED_CHECK cfg False = setParamValue cfg "WELL_SORTED_CHECK" "false" --------------------------------------------------------------------- -- Context -- | Create a context using the given configuration. -- -- Reference: -- mkContext :: Config -> IO Context mkContext cfg = withForeignPtr (unConfig cfg) $ \cfgPtr -> do ptr <- z3_mk_context cfgPtr fptr <- newForeignPtr ptr (z3_del_context ptr) return $! Context fptr --------------------------------------------------------------------- -- Symbols -- | Create a Z3 symbol using a string. -- -- Reference: -- mkStringSymbol :: Context -> String -> IO Symbol mkStringSymbol ctx s = withForeignPtr (unContext ctx) $ \ctxPtr -> withCString s $ \cs -> Symbol <$> z3_mk_string_symbol ctxPtr cs --------------------------------------------------------------------- -- Sorts -- TODO Sorts: Z3_is_eq_sort -- TODO Sorts: Z3_mk_uninterpreted_sort -- | Create the Boolean type. -- -- Reference: -- mkBoolSort :: Context -> IO (Sort Bool) mkBoolSort c = withForeignPtr (unContext c) $ \cptr -> Sort <$> z3_mk_bool_sort cptr -- | Create an integer type. -- -- Reference: -- mkIntSort :: Context -> IO (Sort Integer) mkIntSort c = withForeignPtr (unContext c) $ \cptr -> Sort <$> z3_mk_int_sort cptr -- | Create a real type. -- -- Reference: -- mkRealSort :: Context -> IO (Sort Rational) mkRealSort c = withForeignPtr (unContext c) $ \cptr -> Sort <$> z3_mk_real_sort cptr -- TODO Sorts: from Z3_mk_real_sort on --------------------------------------------------------------------- -- Constants and Applications -- TODO Constants and Applications: Z3_mk_func_decl -- TODO Constants and Applications: Z3_mk_app -- | Declare and create a constant. -- -- Reference: -- mkConst :: Context -> Symbol -> Sort a -> IO (AST a) mkConst c x s = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_const cptr (unSymbol x) (unSort s) -- TODO Constants and Applications: Z3_mk_fresh_func_decl -- TODO Constants and Applications: Z3_mk_fresh_const -- | Create an AST node representing /true/. -- -- Reference: -- mkTrue :: Context -> IO (AST Bool) mkTrue c = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_true cptr -- | Create an AST node representing /false/. -- -- Reference: -- mkFalse :: Context -> IO (AST Bool) mkFalse c = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_false cptr -- | Create an AST node representing l = r. -- -- Reference: -- mkEq :: Z3Scalar a => Context -> AST a -> AST a -> IO (AST Bool) mkEq c e1 e2 = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_eq cptr (unAST e1) (unAST e2) -- | Create an AST node representing not(a). -- -- Reference: -- mkNot :: Context -> AST Bool -> IO (AST Bool) mkNot c e = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_not cptr (unAST e) -- | Create an AST node representing an if-then-else: ite(t1, t2, t3). -- -- Reference: -- mkIte :: Context -> AST Bool -> AST a -> AST a -> IO (AST a) mkIte c g e1 e2 = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_ite cptr (unAST g) (unAST e1) (unAST e2) -- | Create an AST node representing t1 iff t2. -- -- Reference: -- mkIff :: Context -> AST Bool -> AST Bool -> IO (AST Bool) mkIff c p q = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_iff cptr (unAST p) (unAST q) -- | Create an AST node representing t1 implies t2. -- -- Reference: -- mkImplies :: Context -> AST Bool -> AST Bool -> IO (AST Bool) mkImplies c p q = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_implies cptr (unAST p) (unAST q) -- | Create an AST node representing t1 xor t2. -- -- Reference: -- mkXor :: Context -> AST Bool -> AST Bool -> IO (AST Bool) mkXor c p q = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_xor cptr (unAST p) (unAST q) -- | Create an AST node representing args[0] and ... and args[num_args-1]. -- -- Reference: -- mkAnd :: Context -> [AST Bool] -> IO (AST Bool) mkAnd _ [] = error "Z3.Base.mkAnd: empty list of expressions" mkAnd c es = withArray es $ \aptr -> withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_and cptr n (castPtr aptr) where n = fromIntegral $ length es -- | Create an AST node representing args[0] or ... or args[num_args-1]. -- -- Reference: -- mkOr :: Context -> [AST Bool] -> IO (AST Bool) mkOr _ [] = error "Z3.Base.mkOr: empty list of expressions" mkOr c es = withArray es $ \aptr -> withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_or cptr n (castPtr aptr) where n = fromIntegral $ length es -- | Create an AST node representing args[0] + ... + args[num_args-1]. -- -- Reference: -- mkAdd :: Z3Num a => Context -> [AST a] -> IO (AST a) mkAdd _ [] = error "Z3.Base.mkAdd: empty list of expressions" mkAdd c es = withArray es $ \aptr -> withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_add cptr n (castPtr aptr) where n = fromIntegral $ length es -- | Create an AST node representing args[0] * ... * args[num_args-1]. -- -- Reference: -- mkMul :: Z3Num a => Context -> [AST a] -> IO (AST a) mkMul _ [] = error "Z3.Base.mkMul: empty list of expressions" mkMul c es = withArray es $ \aptr -> withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_mul cptr n (castPtr aptr) where n = fromIntegral $ length es -- | Create an AST node representing args[0] - ... - args[num_args - 1]. -- -- Reference: -- mkSub ::Z3Num a => Context -> [AST a] -> IO (AST a) mkSub _ [] = error "Z3.Base.mkSub: empty list of expressions" mkSub c es = withArray es $ \aptr -> withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_sub cptr n (castPtr aptr) where n = fromIntegral $ length es -- | Create an AST node representing -arg. -- -- Reference: -- mkUnaryMinus :: Z3Num a => Context -> AST a -> IO (AST a) mkUnaryMinus c e = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_unary_minus cptr (unAST e) -- | Create an AST node representing arg1 div arg2. -- -- Reference: -- mkDiv :: Z3Num a => Context -> AST a -> AST a -> IO (AST a) mkDiv c e1 e2 = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_div cptr (unAST e1) (unAST e2) -- | Create an AST node representing arg1 mod arg2. -- -- Reference: -- mkMod :: Context -> AST Integer -> AST Integer -> IO (AST Integer) mkMod c e1 e2 = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_mod cptr (unAST e1) (unAST e2) -- | Create an AST node representing arg1 rem arg2. -- -- Reference: -- mkRem :: Context -> AST Integer -> AST Integer -> IO (AST Integer) mkRem c e1 e2 = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_rem cptr (unAST e1) (unAST e2) -- | Create less than. -- -- Reference: -- mkLt :: Z3Num a => Context -> AST a -> AST a -> IO (AST Bool) mkLt c e1 e2 = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_lt cptr (unAST e1) (unAST e2) -- | Create less than or equal to. -- -- Reference: -- mkLe :: Z3Num a => Context -> AST a -> AST a -> IO (AST Bool) mkLe c e1 e2 = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_le cptr (unAST e1) (unAST e2) -- | Create greater than. -- -- Reference: -- mkGt :: Z3Num a => Context -> AST a -> AST a -> IO (AST Bool) mkGt c e1 e2 = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_gt cptr (unAST e1) (unAST e2) -- | Create greater than or equal to. -- -- Reference: -- mkGe :: Z3Num a => Context -> AST a -> AST a -> IO (AST Bool) mkGe c e1 e2 = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_ge cptr (unAST e1) (unAST e2) -- | Coerce an integer to a real. -- -- Reference: -- mkInt2Real :: Context -> AST Integer -> IO (AST Rational) mkInt2Real c e = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_int2real cptr (unAST e) -- | Coerce a real to an integer. -- -- Reference: -- mkReal2Int :: Context -> AST Rational -> IO (AST Integer) mkReal2Int c e = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_real2int cptr (unAST e) -- | Check if a real number is an integer. -- -- Reference: -- mkIsInt :: Context -> AST Rational -> IO (AST Bool) mkIsInt c e = withForeignPtr (unContext c) $ \cptr -> AST <$> z3_mk_is_int cptr (unAST e) -- TODO Bit-vector, Arrays, Sets --------------------------------------------------------------------- -- Numerals -- | Create a numeral of a given sort. -- -- Reference: -- mkNumeral :: Z3Num a => Context -> String -> Sort a -> IO (AST a) mkNumeral c str s = withForeignPtr (unContext c) $ \cptr -> withCString str $ \cstr-> AST <$> z3_mk_numeral cptr cstr (unSort s) ------------------------------------------------- -- Numerals / Integers -- | Create a numeral of sort /int/. mkInt :: Integral a => Context -> a -> IO (AST Integer) mkInt c n = mkIntSort c >>= mkNumeral c n_str where n_str = show $ toInteger n {-# INLINE mkIntZ3 #-} mkIntZ3 :: Z3Num a => Context -> Int32 -> Sort a -> IO (AST a) mkIntZ3 c n s = withForeignPtr (unContext c) $ \ctxPtr -> AST <$> z3_mk_int ctxPtr cn (unSort s) where cn = fromIntegral n :: CInt {-# INLINE mkUnsignedIntZ3 #-} mkUnsignedIntZ3 :: Z3Num a => Context -> Word32 -> Sort a -> IO (AST a) mkUnsignedIntZ3 c n s = withForeignPtr (unContext c) $ \ctxPtr -> AST <$> z3_mk_unsigned_int ctxPtr cn (unSort s) where cn = fromIntegral n :: CUInt {-# INLINE mkInt64Z3 #-} mkInt64Z3 :: Z3Num a => Context -> Int64 -> Sort a -> IO (AST a) mkInt64Z3 c n s = withForeignPtr (unContext c) $ \ctxPtr -> AST <$> z3_mk_int64 ctxPtr cn (unSort s) where cn = fromIntegral n :: CLLong {-# INLINE mkUnsignedInt64Z3 #-} mkUnsignedInt64Z3 :: Z3Num a => Context -> Word64 -> Sort a -> IO (AST a) mkUnsignedInt64Z3 c n s = withForeignPtr (unContext c) $ \ctxPtr -> AST <$> z3_mk_unsigned_int64 ctxPtr cn (unSort s) where cn = fromIntegral n :: CULLong {-# RULES "mkInt/mkInt_IntZ3" mkInt = mkInt_IntZ3 #-} mkInt_IntZ3 :: Context -> Int32 -> IO (AST Integer) mkInt_IntZ3 c n = mkIntSort c >>= mkIntZ3 c n {-# RULES "mkInt/mkInt_UnsignedIntZ3" mkInt = mkInt_UnsignedIntZ3 #-} mkInt_UnsignedIntZ3 :: Context -> Word32 -> IO (AST Integer) mkInt_UnsignedIntZ3 c n = mkIntSort c >>= mkUnsignedIntZ3 c n {-# RULES "mkInt/mkInt_Int64Z3" mkInt = mkInt_Int64Z3 #-} mkInt_Int64Z3 :: Context -> Int64 -> IO (AST Integer) mkInt_Int64Z3 c n = mkIntSort c >>= mkInt64Z3 c n {-# RULES "mkInt/mkInt_UnsignedInt64Z3" mkInt = mkInt_UnsignedInt64Z3 #-} mkInt_UnsignedInt64Z3 :: Context -> Word64 -> IO (AST Integer) mkInt_UnsignedInt64Z3 c n = mkIntSort c >>= mkUnsignedInt64Z3 c n ------------------------------------------------- -- Numerals / Reals -- | Create a numeral of sort /real/. mkReal :: Real r => Context -> r -> IO (AST Rational) 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 Rational) mkRealZ3 c r = withForeignPtr (unContext c) $ \ctxPtr -> AST <$> z3_mk_real ctxPtr 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 Rational) mkReal_IntZ3 c n = mkRealSort c >>= mkIntZ3 c n {-# RULES "mkReal/mkReal_UnsignedIntZ3" mkReal = mkReal_UnsignedIntZ3 #-} mkReal_UnsignedIntZ3 :: Context -> Word32 -> IO (AST Rational) mkReal_UnsignedIntZ3 c n = mkRealSort c >>= mkUnsignedIntZ3 c n {-# RULES "mkReal/mkReal_Int64Z3" mkReal = mkReal_Int64Z3 #-} mkReal_Int64Z3 :: Context -> Int64 -> IO (AST Rational) mkReal_Int64Z3 c n = mkRealSort c >>= mkInt64Z3 c n {-# RULES "mkReal/mkReal_UnsignedInt64Z3" mkReal = mkReal_UnsignedInt64Z3 #-} mkReal_UnsignedInt64Z3 :: Context -> Word64 -> IO (AST Rational) mkReal_UnsignedInt64Z3 c n = mkRealSort c >>= mkUnsignedInt64Z3 c n -- TODO Quantifiers --------------------------------------------------------------------- -- Accessors -- | 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. -- -- Reference: -- getBool :: Context -> AST Bool -> IO (Maybe Bool) getBool c a = withForeignPtr (unContext c) $ \ctxPtr -> castLBool <$> z3_get_bool_value ctxPtr (unAST a) -- | Return numeral value, as a string of a numeric constant term. -- -- Reference: -- getNumeralString :: Z3Num a => Context -> AST a -> IO String getNumeralString c a = withForeignPtr (unContext c) $ \ctxPtr -> peekCString =<< z3_get_numeral_string ctxPtr (unAST a) -- | Return 'Z3Int' value -- getInt :: Num a => Context -> AST Integer -> IO a getInt c a = fromInteger . read <$> getNumeralString c a -- | Return the numerator (as a numeral AST) of a numeral AST of sort /real/. -- -- Reference: -- getNumerator :: Context -> AST Rational -> IO Integer getNumerator c a = withForeignPtr (unContext c) $ \ctxPtr -> z3_get_numerator ctxPtr (unAST a) >>= getInt c . AST -- | Return the denominator (as a numeral AST) of a numeral AST of sort /real/. -- -- Reference: -- getDenominator :: Context -> AST Rational -> IO Integer getDenominator c a = withForeignPtr (unContext c) $ \ctxPtr -> z3_get_denominator ctxPtr (unAST a) >>= getInt c . AST -- | Return 'Z3Real' value -- getReal :: Fractional a => Context -> AST Rational -> IO a getReal c a = fromRational <$> liftM2 (%) (getNumerator c a) (getDenominator c a) -- TODO Modifiers --------------------------------------------------------------------- -- Models mkModel :: Context -> Ptr Z3_model -> IO Model mkModel ctx ptr = withForeignPtr (unContext ctx) $ \ctxPtr -> Model ctx <$> newForeignPtr ptr (z3_del_model ctxPtr ptr) -- | Evaluate an AST node in the given model. eval :: Model -> AST a -> IO (Maybe (AST a)) eval m a = withForeignPtr (unContext $ modelContext m) $ \ctxPtr -> withForeignPtr (unModel m) $ \mdlPtr -> alloca $ \aptr2 -> z3_eval ctxPtr mdlPtr (unAST a) aptr2 >>= peekAST aptr2 . toBool where peekAST :: Ptr (Ptr Z3_ast) -> Bool -> IO (Maybe (AST a)) peekAST _p False = return Nothing peekAST p True = Just . AST <$> peek p --------------------------------------------------------------------- -- Constraints -- TODO Constraints: Z3_push -- TODO Constraints: Z3_pop -- TODO Constraints: Z3_get_num_scopes -- TODO Constraints: Z3_persist_ast -- | Assert a constraing into the logical context. -- -- Reference: -- assertCnstr :: Context -> AST Bool -> IO () assertCnstr ctx ast = withForeignPtr (unContext ctx) $ \ctxPtr -> z3_assert_cnstr ctxPtr (unAST ast) -- | Get model (logical context is consistent) -- -- Reference : -- getModel :: Context -> IO (Result, Maybe Model) getModel c = withForeignPtr (unContext c) $ \ctxPtr -> alloca $ \mptr -> z3_check_and_get_model ctxPtr mptr >>= peekModel mptr . toResult where peekModel :: Ptr (Ptr Z3_model) -> Result -> IO (Result, Maybe Model) peekModel p r | p == nullPtr = return (r, Nothing) | otherwise = do z3m <- peek p m <- mkModel c z3m return (r, Just m) -- | Check whether the given logical context is consistent or not. -- -- Reference: -- check :: Context -> IO Result check ctx = toResult <$> withForeignPtr (unContext ctx) z3_check -- TODO Constraints: Z3_check_assumptions -- TODO Constraints: Z3_get_implied_equalities -- TODO From section 'Constraints' on.