modernize for ghc 9.4.7 & swi-prolog 9.0.4

.gitignore

@@ -1 +1,5 @@
 dist/
+
+*.hi
+*.o
+dist-newstyle/

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

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

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 ()

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"