diff --git a/.gitignore b/.gitignore index 849ddff..f84880c 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,5 @@ dist/ + +*.hi +*.o +dist-newstyle/ diff --git a/hswip.cabal b/hswip.cabal index 0e016e5..10eb3f2 100644 --- a/hswip.cabal +++ b/hswip.cabal @@ -1,5 +1,5 @@ name: hswip -version: 0.3 +version: 0.4 cabal-version: >= 1.10 build-type: Simple license: GPL @@ -12,10 +12,10 @@ description: Library for embedding swi-prolog in haskell inspired by pyswip. You should install swi-prolog in order to use the library. It is recommended to use swi-prolog-5.10 or newer. category: Foreign, Language -tested-with: GHC==7.10.1 +tested-with: GHC==9.4.7 library - default-language: Haskell98 + default-language: Haskell2010 exposed-modules: Language.Prolog.HSwip, Language.Prolog.HSwip.LowLevel @@ -29,3 +29,11 @@ library ghc-options: -Wall pkgconfig-depends: swipl + +test-suite hswip-smoke + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: smoke.hs + build-depends: base < 5, hswip + pkgconfig-depends: swipl diff --git a/src/Language/Prolog/HSwip/Internals.hs b/src/Language/Prolog/HSwip/Internals.hs index f064609..511cabc 100644 --- a/src/Language/Prolog/HSwip/Internals.hs +++ b/src/Language/Prolog/HSwip/Internals.hs @@ -6,27 +6,27 @@ import Foreign.Ptr foreign import ccall "SWI-Prolog.h PL_initialise" c_PLInitialise :: CInt -> Ptr (Ptr CChar) -> IO CInt foreign import ccall "SWI-Prolog.h PL_halt" c_PLHalt :: CInt -> IO () -foreign import ccall "SWI-Prolog.h PL_open_foreign_frame" c_PL_open_foreign_frame :: IO CULong -foreign import ccall "SWI-Prolog.h PL_close_foreign_frame" c_PL_close_foreign_frame :: CULong -> IO () +foreign import ccall "SWI-Prolog.h PL_open_foreign_frame" c_PL_open_foreign_frame :: IO CUIntPtr +foreign import ccall "SWI-Prolog.h PL_close_foreign_frame" c_PL_close_foreign_frame :: CUIntPtr -> IO () foreign import ccall "SWI-Prolog.h PL_predicate" c_PL_predicate :: Ptr CChar -> CInt -> Ptr CChar -> IO (Ptr ()) -foreign import ccall "SWI-Prolog.h PL_open_query" c_PL_open_query :: Ptr () -> CInt -> Ptr () -> CULong -> IO CULong -foreign import ccall "SWI-Prolog.h PL_next_solution" c_PL_next_solution :: CULong -> IO CInt -foreign import ccall "SWI-Prolog.h PL_close_query" c_PL_close_query :: CULong -> IO () -foreign import ccall "SWI-Prolog.h PL_call" c_PL_call :: CULong -> Ptr () -> IO CInt -foreign import ccall "SWI-Prolog.h PL_exception" c_PL_exception :: CULong -> IO CULong -foreign import ccall "SWI-Prolog.h PL_new_term_refs" c_PL_new_term_refs :: CInt -> IO CULong -foreign import ccall "SWI-Prolog.h PL_new_term_ref" c_PL_new_term_ref :: IO CULong -foreign import ccall "SWI-Prolog.h PL_copy_term_ref" c_PL_copy_term_ref :: CULong -> IO CULong -foreign import ccall "SWI-Prolog.h PL_reset_term_refs" c_PL_reset_term_refs :: CULong -> IO () -foreign import ccall "SWI-Prolog.h PL_atom_chars" c_PL_atom_chars :: CULong -> IO (Ptr CChar) -foreign import ccall "SWI-Prolog.h PL_get_string" c_PL_get_string :: CULong -> Ptr (Ptr CChar) -> Ptr CInt -> IO CInt -foreign import ccall "SWI-Prolog.h PL_get_chars" c_PL_get_chars :: CULong -> Ptr (Ptr CChar) -> CUInt -> IO CInt -foreign import ccall "SWI-Prolog.h PL_get_arg" c_PL_get_arg :: CInt -> CULong -> CULong -> IO CInt -foreign import ccall "SWI-Prolog.h PL_get_list" c_PL_get_list :: CULong -> CULong -> CULong -> IO CInt -foreign import ccall "SWI-Prolog.h PL_get_name_arity" c_PL_get_name_arity :: CULong -> Ptr CULong -> Ptr CInt -> IO Int -foreign import ccall "SWI-Prolog.h PL_term_type" c_PL_term_type :: CULong -> IO CInt -foreign import ccall "SWI-Prolog.h PL_put_variable" c_PL_put_variable :: CULong -> IO () -foreign import ccall "SWI-Prolog.h PL_put_atom_chars" c_PL_put_atom_chars :: CULong -> CString -> IO () -foreign import ccall "SWI-Prolog.h PL_put_list_chars" c_PL_put_list_chars :: CULong -> CString -> IO () -foreign import ccall "SWI-Prolog.h PL_put_term" c_PL_put_term :: CULong -> CULong -> IO () -foreign import ccall "SWI-Prolog.h PL_chars_to_term" c_PL_chars_to_term :: CString -> CULong -> IO CInt +foreign import ccall "SWI-Prolog.h PL_open_query" c_PL_open_query :: Ptr () -> CInt -> Ptr () -> CUIntPtr -> IO CUIntPtr +foreign import ccall "SWI-Prolog.h PL_next_solution" c_PL_next_solution :: CUIntPtr -> IO CInt +foreign import ccall "SWI-Prolog.h PL_close_query" c_PL_close_query :: CUIntPtr -> IO () +foreign import ccall "SWI-Prolog.h PL_call" c_PL_call :: CUIntPtr -> Ptr () -> IO CInt +foreign import ccall "SWI-Prolog.h PL_exception" c_PL_exception :: CUIntPtr -> IO CUIntPtr +foreign import ccall "SWI-Prolog.h PL_new_term_refs" c_PL_new_term_refs :: CInt -> IO CUIntPtr +foreign import ccall "SWI-Prolog.h PL_new_term_ref" c_PL_new_term_ref :: IO CUIntPtr +foreign import ccall "SWI-Prolog.h PL_copy_term_ref" c_PL_copy_term_ref :: CUIntPtr -> IO CUIntPtr +foreign import ccall "SWI-Prolog.h PL_reset_term_refs" c_PL_reset_term_refs :: CUIntPtr -> IO () +foreign import ccall "SWI-Prolog.h PL_atom_chars" c_PL_atom_chars :: CUIntPtr -> IO (Ptr CChar) +foreign import ccall "SWI-Prolog.h PL_get_string" c_PL_get_string :: CUIntPtr -> Ptr (Ptr CChar) -> Ptr CInt -> IO CInt +foreign import ccall "SWI-Prolog.h PL_get_chars" c_PL_get_chars :: CUIntPtr -> Ptr (Ptr CChar) -> CUInt -> IO CInt +foreign import ccall "SWI-Prolog.h PL_get_arg" c_PL_get_arg :: CInt -> CUIntPtr -> CUIntPtr -> IO CInt +foreign import ccall "SWI-Prolog.h PL_get_list" c_PL_get_list :: CUIntPtr -> CUIntPtr -> CUIntPtr -> IO CInt +foreign import ccall "SWI-Prolog.h PL_get_name_arity" c_PL_get_name_arity :: CUIntPtr -> Ptr CUIntPtr -> Ptr CInt -> IO CInt +foreign import ccall "SWI-Prolog.h PL_term_type" c_PL_term_type :: CUIntPtr -> IO CInt +foreign import ccall "SWI-Prolog.h PL_put_variable" c_PL_put_variable :: CUIntPtr -> IO () +foreign import ccall "SWI-Prolog.h PL_put_atom_chars" c_PL_put_atom_chars :: CUIntPtr -> CString -> IO () +foreign import ccall "SWI-Prolog.h PL_put_list_chars" c_PL_put_list_chars :: CUIntPtr -> CString -> IO () +foreign import ccall "SWI-Prolog.h PL_put_term" c_PL_put_term :: CUIntPtr -> CUIntPtr -> IO () +foreign import ccall "SWI-Prolog.h PL_chars_to_term" c_PL_chars_to_term :: CString -> CUIntPtr -> IO CInt diff --git a/src/Language/Prolog/HSwip/LowLevel.hs b/src/Language/Prolog/HSwip/LowLevel.hs index 2d1d25f..93cbcea 100644 --- a/src/Language/Prolog/HSwip/LowLevel.hs +++ b/src/Language/Prolog/HSwip/LowLevel.hs @@ -7,12 +7,12 @@ import Foreign.Marshal import Foreign.Storable import Language.Prolog.HSwip.Internals -type Term = CULong -type Atom = CULong +type Term = CUIntPtr +type Atom = CUIntPtr type Predicate = Ptr () type Module = Ptr () -type Qid = CULong -type Fid = CULong +type Qid = CUIntPtr +type Fid = CUIntPtr data TermType = TVariable | TAtom @@ -140,14 +140,9 @@ plGetString term_ = do plGetChars :: Term -> IO String plGetChars term_ = do resStr <- malloc :: IO (Ptr CString) - -- from example : PL_get_chars(t,&s, CVT_ALL) - -- CVT_ALL = CVT_INTEGER | CVT_FLOAT | CVT_ATOM | CVT_STRING | CVT_LIST - -- 0x1 | 0x2 | 0x4 | 0x8 | 0x10 - -- BUF_ALLOC = 0x0200 - _ <- c_PL_get_chars term_ resStr $ 0x1 .|. 0x2 .|. 0x4 .|. 0x8 .|. 0x10 .|. 0x0200 + _ <- c_PL_get_chars term_ resStr (0x1 .|. 0x2 .|. 0x4 .|. 0x8 .|. 0x10 .|. 0x20 .|. 0x10000) rescstring <- peek resStr res <- peekCString rescstring - free rescstring free resStr return res @@ -182,13 +177,18 @@ plTermType :: Term -> IO TermType plTermType term_ = do retc <- c_PL_term_type term_ return $ case retc of - 1 -> TVariable - 2 -> TAtom - 3 -> TInteger - 4 -> TFloat - 5 -> TString - 6 -> TTerm - _ -> undefined + 1 -> TVariable + 2 -> TAtom + 3 -> TInteger + 4 -> TInteger + 5 -> TFloat + 6 -> TString + 7 -> TTerm + 8 -> TAtom + 9 -> TTerm + 10 -> TTerm + 44 -> TTerm + _ -> TTerm -- PL_EXPORT(void) PL_put_variable(term_t t); -- foreign import ccall "SWI-Prolog.h PL_put_variable" c_PL_put_variable :: CULong -> IO () diff --git a/test/smoke.hs b/test/smoke.hs new file mode 100644 index 0000000..461b5c0 --- /dev/null +++ b/test/smoke.hs @@ -0,0 +1,23 @@ +module Main (main) where + +import Language.Prolog.HSwip +import Control.Monad (unless) +import System.Exit (exitFailure) + +main :: IO () +main = do + prologInit ["-q", "--no-signals"] + mapM_ prologCall + [ "asserta(parent(pam, bob))." + , "asserta(parent(tom, bob))." + , "asserta(parent(tom, liz))." + , "asserta(parent(bob, ann))." + , "asserta(parent(bob, pat))." + , "asserta(parent(pat, jim))." + ] + allPairs <- prologCall "parent(X,Y)." + bobKids <- prologCall "parent(bob, Who)." + let bobChildren = [ v | sol <- bobKids, (k, v) <- sol, k == "Who" ] + unless (length allPairs == 6) $ fail "expected 6 parent/2 solutions" + unless (bobChildren == ["pat", "ann"]) $ fail "expected bob's children pat, ann" + putStrLn "all assertions passed"