diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index ce0fe17a2..1ece08df3 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -280,7 +280,7 @@ void pgf_write_pgf(const char* fpath, fclose(out); } -#ifdef _GNU_SOURCE +#if defined(__linux__) PGF_API void pgf_write_pgf_cookie (void *cookie, cookie_io_functions_t *io_funcs, @@ -308,6 +308,35 @@ void pgf_write_pgf_cookie if (out != NULL) fclose(out); } +#elif defined(__APPLE__) +PGF_API +void pgf_write_pgf_cookie + (void *cookie, int (*writefn)(void *, const char *, int), + int (*closefn)(void *), + PgfDB *db, PgfRevision revision, + PgfText **langs, // null terminated list or null + PgfExn* err) +{ + FILE *out = NULL; + + PGF_API_BEGIN { + out = funopen(cookie, NULL, writefn, NULL, closefn); + if (!out) { + throw pgf_systemerror(errno, ""); + } + + { + DB_scope scope(db, READER_SCOPE); + ref pgf = db->revision2pgf(revision); + + PgfWriter wtr(langs, out); + wtr.write_pgf(pgf); + } + } PGF_API_END + + if (out != NULL) + fclose(out); +} #endif PGF_API diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index 70109a2da..502b40862 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -291,13 +291,21 @@ void pgf_write_pgf(const char* fpath, PgfText **langs, // null terminated list or null PgfExn* err); -#ifdef _GNU_SOURCE +#if defined(__linux__) PGF_API_DECL void pgf_write_pgf_cookie (void *cookie, cookie_io_functions_t *io_funcs, PgfDB *db, PgfRevision revision, PgfText **langs, // null terminated list or null PgfExn* err); +#elif defined(__APPLE__) +PGF_API_DECL +void pgf_write_pgf_cookie + (void *cookie, int (*writefn)(void *, const char *, int), + int (*closefn)(void *), + PgfDB *db, PgfRevision revision, + PgfText **langs, // null terminated list or null + PgfExn* err); #endif PGF_API_DECL diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index 39419d477..cdb3c1e20 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -208,8 +208,8 @@ writePGF fpath p mb_langs = withLangs clangs [] f = withArray0 nullPtr (reverse clangs) f withLangs clangs (lang:langs) f = withText lang $ \clang -> withLangs (clang:clangs) langs f -#ifdef __linux__ -writePGF_ :: (Ptr Word8 -> CSize -> IO CSize) -> PGF -> Maybe [ConcName] -> IO () +#if defined(__linux__) +writePGF_ :: (Ptr Word8 -> Int -> IO Int) -> PGF -> Maybe [ConcName] -> IO () writePGF_ callback p mb_langs = allocaBytes (#size cookie_io_functions_t) $ \io_functions -> withForeignPtr (a_revision p) $ \c_revision -> @@ -223,12 +223,11 @@ writePGF_ callback p mb_langs = where withLangs clangs [] f = withArray0 nullPtr (reverse clangs) f withLangs clangs (lang:langs) f = withText lang $ \clang -> withLangs (clang:clangs) langs f -#endif cookie_write :: Ptr () -> Ptr Word8 -> CSize -> IO CSize cookie_write cookie buf size = do callback <- deRefStablePtr (castPtrToStablePtr cookie) - callback buf size + fmap fromIntegral $ (callback :: Ptr Word8 -> Int -> IO Int) buf (fromIntegral size) 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) @@ -241,6 +240,36 @@ cookie_close cookie = do 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 import ccall "&cookie_write" cookie_write_ptr :: FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO CInt) + +cookie_close :: Ptr () -> IO CInt +cookie_close cookie = do + freeStablePtr (castPtrToStablePtr cookie) + return 0 + +foreign export ccall cookie_close :: Ptr () -> IO CInt +foreign import ccall "&cookie_close" cookie_close_ptr + +#endif + showPGF :: PGF -> String showPGF p = render (text "abstract" <+> ppAbstractName p <+> char '{' $$ diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index 50e93da86..4d0a8db9b 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -56,7 +56,6 @@ data PgfCohortsCallback data PgfPhrasetableIds data PgfExprEnum data PgfAlignmentPhrase -data CookieIOFunctions type Wrapper a = a -> IO (FunPtr a) type Dynamic a = FunPtr a -> a @@ -86,8 +85,11 @@ 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 () -#ifdef _GNU_SOURCE +#if defined(__linux__) +data CookieIOFunctions foreign import ccall pgf_write_pgf_cookie :: Ptr () -> Ptr CookieIOFunctions -> Ptr PgfDB -> Ptr PGF -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO () +#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 () #endif foreign import ccall "pgf_free_revision" pgf_free_revision_ :: Ptr PgfDB -> Ptr PGF -> IO ()