Skip to content

Commit

Permalink
ready for release
Browse files Browse the repository at this point in the history
  • Loading branch information
José Iborra committed Dec 25, 2009
1 parent e2d1fff commit c3c3d2b
Show file tree
Hide file tree
Showing 3 changed files with 42 additions and 10 deletions.
37 changes: 33 additions & 4 deletions Bindings/Yices.hs
Expand Up @@ -10,6 +10,8 @@ import Foreign.Ptr
import Foreign.C.Types import Foreign.C.Types
import Foreign.C.String import Foreign.C.String


import qualified Data.Traversable as T

type Context = Ptr YContext type Context = Ptr YContext
type Expr = Ptr YExpr type Expr = Ptr YExpr
type Decl = Ptr YDecl type Decl = Ptr YDecl
Expand All @@ -27,6 +29,25 @@ data SAT a = Sat a | Unknown a | Unsat
mkContext :: IO Context mkContext :: IO Context
mkContext = c_mk_context mkContext = c_mk_context


delContext :: Context -> IO ()
delContext = c_del_context

withContext :: (Context -> IO a) -> IO a
withContext f = do {ctx <- c_mk_context; f ctx <* c_del_context ctx}

setVerbosity :: Int -> IO ()
setVerbosity = c_set_verbosity . fromIntegral

setLogFile :: FilePath -> IO ()
setLogFile fp = withCString fp c_enable_log_file

enableTypeChecker :: Bool -> IO ()
enableTypeChecker True = c_enable_type_checker 1
enableTypeChecker False = c_enable_type_checker 0

isInconsistent :: Context -> IO Bool
isInconsistent = liftM (toEnum.fromIntegral) . c_inconsistent

-- * Assertions -- * Assertions


assert :: Context -> Expr -> IO () assert :: Context -> Expr -> IO ()
Expand Down Expand Up @@ -79,13 +100,21 @@ getVarDecl ctx name = do
ptr <- withCString name $ c_get_var_decl_from_name ctx ptr <- withCString name $ c_get_var_decl_from_name ctx
return $ if nullPtr == ptr then Nothing else Just ptr return $ if nullPtr == ptr then Nothing else Just ptr


getBoolValue :: Model -> VarDecl -> YBool getVarFromDecl :: Context -> VarDecl -> IO Expr
getBoolValue m vd = eatYBool $ c_get_value m vd getVarFromDecl = c_mk_var_from_decl

getVar :: Context -> String -> IO (Maybe Expr)
getVar ctx name = getVarDecl ctx name >>= T.sequence . liftM (getVarFromDecl ctx)


class YEval a where getValue :: Model -> VarDecl -> YDef a class YEval a where getValue :: Model -> VarDecl -> YDef a
instance YEval Bool where getValue = getBoolValue instance YEval Bool where getValue = getBoolValue
instance YEval Int where instance YEval Int where getValue = getNatValue
getValue m vd = unsafePerformIO $ alloca $ \ptr -> do
getBoolValue :: Model -> VarDecl -> YBool
getBoolValue m vd = eatYBool $ c_get_value m vd

getNatValue :: Model -> VarDecl -> YDef Int
getNatValue m vd = unsafePerformIO $ alloca $ \ptr -> do
code <- c_get_int_value m vd ptr code <- c_get_int_value m vd ptr
case code of case code of
0 -> return YUndef 0 -> return YUndef
Expand Down
8 changes: 4 additions & 4 deletions Bindings/Yices/Internal.hsc
@@ -1,8 +1,6 @@
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE EmptyDataDecls #-}


#include "yices_c.h"

module Bindings.Yices.Internal where module Bindings.Yices.Internal where


import Foreign import Foreign
Expand All @@ -18,9 +16,11 @@ data YType
data YModel data YModel
data YVarIterator data YVarIterator
newtype AssertionId = AssertionId Int deriving (Eq, Ord) newtype AssertionId = AssertionId Int deriving (Eq, Ord)
data YDef a = YDef a | YUndef data YDef a = YDef !a | YUndef




#include "yices_c.h"

-- ------------- -- -------------
-- Marshalling -- Marshalling
-- ------------- -- -------------
Expand Down Expand Up @@ -303,7 +303,7 @@ foreign import ccall unsafe "yices_c.h yices_iterator_next"
-- --


foreign import ccall unsafe "yices_c.h yices_iterator_reset" foreign import ccall unsafe "yices_c.h yices_iterator_reset"
c_iterator_reset :: Ptr YVarIterator -> IO (()) c_iterator_reset :: Ptr YVarIterator -> IO ()


-- --


Expand Down
7 changes: 5 additions & 2 deletions bindings-yices.cabal
Expand Up @@ -47,7 +47,8 @@ Library
-- Modules exported by the library. -- Modules exported by the library.
Exposed-modules: Bindings.Yices, Exposed-modules: Bindings.Yices,
Bindings.Yices.Internal Bindings.Yices.Internal


extra-libraries: yices
-- Packages needed in order to build this package. -- Packages needed in order to build this package.
Build-depends: base Build-depends: base


Expand All @@ -56,5 +57,7 @@ Library


-- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
Build-tools: hsc2hs Build-tools: hsc2hs

includes: yices_c.h includes: yices_c.h
extra_libraries: yices
ghc-prof-options: -auto

0 comments on commit c3c3d2b

Please sign in to comment.