make it possible to write grammars via a cookie in glibc

src/runtime/c/pgf/pgf.cxx

@@ -280,6 +280,36 @@ end:
         fclose(out);
 }
 
+#ifdef _GNU_SOURCE
+PGF_API
+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)
+{
+    FILE *out = NULL;
+
+    PGF_API_BEGIN {
+        out = fopencookie(cookie, "wb", *io_funcs);
+        if (!out) {
+            throw pgf_systemerror(errno, "<cookie>");
+        }
+
+        {
+            DB_scope scope(db, READER_SCOPE);
+            ref<PgfPGF> pgf = db->revision2pgf(revision);
+
+            PgfWriter wtr(langs, out);
+            wtr.write_pgf(pgf);
+        }
+    } PGF_API_END
+
+    if (out != NULL)
+        fclose(out);
+}
+#endif
+
 PGF_API
 const char *pgf_file_path(PgfDB *db)
 {

src/runtime/c/pgf/pgf.h

@@ -291,6 +291,15 @@ void pgf_write_pgf(const char* fpath,
                    PgfText **langs, // null terminated list or null
                    PgfExn* err);
 
+#ifdef _GNU_SOURCE
+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);
+#endif
+
 PGF_API_DECL
 const char *pgf_file_path(PgfDB *db);
 

src/runtime/haskell/PGF2.hsc

@@ -16,6 +16,9 @@
 module PGF2 (-- * PGF
              PGF,readPGF,bootNGF,readNGF,newNGF,writePGF,showPGF,
              readPGFWithProbs, bootNGFWithProbs,
+#ifdef __linux__
+             writePGF_,
+#endif
 
              -- * Abstract syntax
              AbsName,abstractName,globalFlag,abstractFlag,
@@ -109,6 +112,10 @@ import Data.Char(isUpper,isSpace,isPunctuation)
 import Data.Maybe(maybe)
 import Text.PrettyPrint
 
+#ifdef __linux__
+#define _GNU_SOURCE
+#include <stdio.h>
+#endif
 #include <pgf/pgf.h>
 
 -- | Reads a PGF file and keeps it in memory.
@@ -201,6 +208,39 @@ 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 ()
+writePGF_ callback p mb_langs =
+  allocaBytes (#size cookie_io_functions_t) $ \io_functions ->
+  withForeignPtr (a_revision p) $ \c_revision ->
+  maybe (\f -> f nullPtr) (withLangs []) mb_langs $ \c_langs -> do
+    cookie <- fmap castStablePtrToPtr (newStablePtr callback)
+    (#poke cookie_io_functions_t, read) io_functions nullPtr
+    (#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
+    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
+
+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)
+
+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 :: FunPtr (Ptr () -> IO CInt)
+
 showPGF :: PGF -> String
 showPGF p =
   render (text "abstract" <+> ppAbstractName p <+> char '{' $$

src/runtime/haskell/PGF2/FFI.hsc

@@ -17,6 +17,10 @@ import System.IO.Unsafe(unsafePerformIO)
 
 import PGF2.Expr
 
+#ifdef __linux__
+#define _GNU_SOURCE
+#include <stdio.h>
+#endif
 #include <pgf/pgf.h>
 
 type AbsName  = String -- ^ Name of abstract syntax
@@ -52,6 +56,7 @@ data PgfCohortsCallback
 data PgfPhrasetableIds
 data PgfExprEnum
 data PgfAlignmentPhrase
+data CookieIOFunctions
 
 type Wrapper a = a -> IO (FunPtr a)
 type Dynamic a = FunPtr a -> a
@@ -81,6 +86,10 @@ 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
+foreign import ccall pgf_write_pgf_cookie :: Ptr () -> Ptr CookieIOFunctions -> 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 ()
 
 foreign import ccall "&pgf_free_revision" pgf_free_revision :: FinalizerEnvPtr PgfDB PGF