GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

a second try on writePGF_

Browse Source
This commit is contained in:
Krasimir Angelov
2023-09-04 17:46:21 +02:00
parent 251d313d1b
commit 56c5b8e3e9
2 changed files with 14 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
src/runtime/haskell/PGF2.hsc
View File

@@ -208,66 +208,32 @@ writePGF fpath p mb_langs =
withLangs clangs [] f = withArray0 nullPtr (reverse clangs) f withLangs clangs [] f = withArray0 nullPtr (reverse clangs) f
withLangs clangs (lang:langs) f = withText lang $ \clang -> withLangs (clang:clangs) langs f withLangs clangs (lang:langs) f = withText lang $ \clang -> withLangs (clang:clangs) langs f
#if defined(__linux__) #if defined(__linux__) || defined(__APPLE__)
writePGF_ :: (Ptr Word8 -> Int -> IO Int) -> PGF -> Maybe [ConcName] -> IO () writePGF_ :: (Ptr Word8 -> Int -> IO Int) -> PGF -> Maybe [ConcName] -> IO ()
writePGF_ callback p mb_langs = writePGF_ callback p mb_langs =
allocaBytes (#size cookie_io_functions_t) $ \io_functions ->
withForeignPtr (a_revision p) $ \c_revision -> withForeignPtr (a_revision p) $ \c_revision ->
maybe (\f -> f nullPtr) (withLangs []) mb_langs $ \c_langs -> do maybe (\f -> f nullPtr) (withLangs []) mb_langs $ \c_langs ->
cookie <- fmap castStablePtrToPtr (newStablePtr callback) bracket (newStablePtr callback) freeStablePtr $ \cookie ->
(#poke cookie_io_functions_t, read) io_functions nullPtr withPgfExn "writePGF_" (pgf_write_pgf_cookie (castStablePtrToPtr cookie) cookie_write_ptr (a_db p) c_revision c_langs)
(#poke cookie_io_functions_t, write) io_functions cookie_write_ptr
(#poke cookie_io_functions_t, seek) io_functions nullPtr
(#poke cookie_io_functions_t, close) io_functions cookie_close_ptr
withPgfExn "writePGF_" (pgf_write_pgf_cookie cookie io_functions (a_db p) c_revision c_langs)
where where
withLangs clangs [] f = withArray0 nullPtr (reverse clangs) f withLangs clangs [] f = withArray0 nullPtr (reverse clangs) f
withLangs clangs (lang:langs) f = withText lang $ \clang -> withLangs (clang:clangs) langs f withLangs clangs (lang:langs) f = withText lang $ \clang -> withLangs (clang:clangs) langs f
cookie_write :: Ptr () -> Ptr Word8 -> CSize -> IO CSize #if defined(__linux__)
cookie_write cookie buf size = do
callback <- deRefStablePtr (castPtrToStablePtr cookie)
fmap fromIntegral $ (callback :: Ptr Word8 -> Int -> IO Int) buf (fromIntegral size)
foreign export ccall cookie_write :: Ptr () -> Ptr Word8 -> CSize -> IO CSize foreign export ccall cookie_write :: Ptr () -> Ptr Word8 -> CSize -> IO CSize
foreign import ccall "&cookie_write" cookie_write_ptr :: FunPtr (Ptr () -> Ptr Word8 -> CSize -> IO CSize) foreign import ccall "&cookie_write" cookie_write_ptr :: FunPtr (Ptr () -> Ptr Word8 -> CSize -> IO CSize)
cookie_close :: Ptr () -> IO CInt cookie_write :: Ptr () -> Ptr Word8 -> CSize -> IO CSize
cookie_close cookie = do #else
freeStablePtr (castPtrToStablePtr cookie)
return 0
foreign export ccall cookie_close :: Ptr () -> IO CInt
foreign import ccall "&cookie_close" cookie_close_ptr :: FunPtr (Ptr () -> IO CInt)
#elif defined(__APPLE__)
writePGF_ :: (Ptr Word8 -> Int -> IO Int) -> PGF -> Maybe [ConcName] -> IO ()
writePGF_ callback p mb_langs =
withForeignPtr (a_revision p) $ \c_revision ->
maybe (\f -> f nullPtr) (withLangs []) mb_langs $ \c_langs -> do
cookie <- fmap castStablePtrToPtr (newStablePtr callback)
withPgfExn "writePGF_" (pgf_write_pgf_cookie cookie cookie_write_ptr cookie_close_ptr (a_db p) c_revision c_langs)
where
withLangs clangs [] f = withArray0 nullPtr (reverse clangs) f
withLangs clangs (lang:langs) f = withText lang $ \clang -> withLangs (clang:clangs) langs f
cookie_write :: Ptr () -> Ptr Word8 -> CInt -> IO CInt
cookie_write cookie buf size = do
callback <- deRefStablePtr (castPtrToStablePtr cookie)
fmap fromIntegral $ (callback :: Ptr Word8 -> Int -> IO Int) buf (fromIntegral size)
foreign export ccall cookie_write :: Ptr () -> Ptr Word8 -> CInt -> IO CInt foreign export ccall cookie_write :: Ptr () -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall "&cookie_write" cookie_write_ptr :: FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO CInt) foreign import ccall "&cookie_write" cookie_write_ptr :: FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO CInt)
cookie_close :: Ptr () -> IO CInt cookie_write :: Ptr () -> Ptr Word8 -> CInt -> IO CInt
cookie_close cookie = do #endif
freeStablePtr (castPtrToStablePtr cookie)
return 0
foreign export ccall cookie_close :: Ptr () -> IO CInt
foreign import ccall "&cookie_close" cookie_close_ptr
cookie_write cookie buf size = do
callback <- deRefStablePtr (castPtrToStablePtr cookie)
fmap fromIntegral $ (callback :: Ptr Word8 -> Int -> IO Int) buf (fromIntegral size)
#endif #endif
showPGF :: PGF -> String showPGF :: PGF -> String

9
src/runtime/haskell/PGF2/FFI.hsc
View File

@@ -17,10 +17,6 @@ import System.IO.Unsafe(unsafePerformIO)
import PGF2.Expr import PGF2.Expr
#ifdef __linux__
#define _GNU_SOURCE
#include <stdio.h>
#endif
#include <pgf/pgf.h> #include <pgf/pgf.h>
type AbsName = String -- ^ Name of abstract syntax type AbsName = String -- ^ Name of abstract syntax
@@ -86,10 +82,9 @@ foreign import ccall pgf_merge_pgf :: Ptr PgfDB -> Ptr PGF -> CString -> Ptr Pgf
foreign import ccall pgf_write_pgf :: CString -> Ptr PgfDB -> Ptr PGF -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO () foreign import ccall pgf_write_pgf :: CString -> Ptr PgfDB -> Ptr PGF -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ()
#if defined(__linux__) #if defined(__linux__)
data CookieIOFunctions foreign import ccall pgf_write_pgf_cookie :: Ptr () -> FunPtr (Ptr () -> Ptr Word8 -> CSize -> IO CSize) -> Ptr PgfDB -> Ptr PGF -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ()
foreign import ccall pgf_write_pgf_cookie :: Ptr () -> Ptr CookieIOFunctions -> Ptr PgfDB -> Ptr PGF -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ()
#elif defined(__APPLE__) #elif defined(__APPLE__)
foreign import ccall pgf_write_pgf_cookie :: Ptr () -> FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO CInt) -> FunPtr (Ptr () -> IO CInt) -> Ptr PgfDB -> Ptr PGF -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO () foreign import ccall pgf_write_pgf_cookie :: Ptr () -> FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO CInt) -> Ptr PgfDB -> Ptr PGF -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ()
#endif #endif
foreign import ccall "pgf_free_revision" pgf_free_revision_ :: Ptr PgfDB -> Ptr PGF -> IO () foreign import ccall "pgf_free_revision" pgf_free_revision_ :: Ptr PgfDB -> Ptr PGF -> IO ()