The unmarshaller is no longer stored in the PGF object but is passed explicitly to each function that needs it.

src/runtime/c/pgf/data.h

@@ -119,15 +119,12 @@ struct PGF_INTERNAL_DECL PgfPGFRoot {
 #pragma GCC diagnostic ignored "-Wattributes"
 
 struct PgfPGF : DB {
-    PGF_INTERNAL_DECL PgfPGF(const char* fpath, int flags, int mode,
+    PGF_INTERNAL_DECL PgfPGF(const char* fpath, int flags, int mode)
-                             PgfUnmarshaller *unmarshaller)
                          : DB(fpath, flags, mode)
-    { u = unmarshaller; };
+    { };
 
     PGF_INTERNAL_DECL ~PgfPGF()
-    { u->free_me(); };
+    { };
-
-    PgfUnmarshaller *u;
 };
 
 #pragma GCC diagnostic pop

src/runtime/c/pgf/pgf.cxx

@@ -14,7 +14,6 @@ pgf_exn_clear(PgfExn* err)
 
 PGF_API
 PgfPGF *pgf_read_pgf(const char* fpath,
-                     PgfUnmarshaller *unmarshaller,
                      PgfExn* err)
 {
     PgfPGF *pgf = NULL;
@@ -22,7 +21,7 @@ PgfPGF *pgf_read_pgf(const char* fpath,
     pgf_exn_clear(err);
 
     try {
-        pgf = new PgfPGF(NULL, 0, 0, unmarshaller);
+        pgf = new PgfPGF(NULL, 0, 0);
 
         std::ifstream in(fpath, std::ios::binary);
         if (in.fail()) {
@@ -55,7 +54,6 @@ PgfPGF *pgf_read_pgf(const char* fpath,
 
 PGF_API
 PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
-                     PgfUnmarshaller *unmarshaller,
                      PgfExn* err)
 {
     PgfPGF *pgf = NULL;
@@ -63,7 +61,7 @@ PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
     pgf_exn_clear(err);
 
     try {
-        pgf = new PgfPGF(ngf_path, O_CREAT | O_EXCL | O_RDWR, S_IRUSR | S_IWUSR, unmarshaller);
+        pgf = new PgfPGF(ngf_path, O_CREAT | O_EXCL | O_RDWR, S_IRUSR | S_IWUSR);
 
         std::ifstream in(pgf_path, std::ios::binary);
         if (in.fail()) {
@@ -100,7 +98,6 @@ PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
 
 PGF_API
 PgfPGF *pgf_read_ngf(const char *fpath,
-                     PgfUnmarshaller *unmarshaller,
                      PgfExn* err)
 {
     PgfPGF *pgf = NULL;
@@ -109,7 +106,7 @@ PgfPGF *pgf_read_ngf(const char *fpath,
 
     bool is_new = false;
     try {
-        pgf = new PgfPGF(fpath, O_CREAT | O_RDWR, S_IRUSR | S_IWUSR, unmarshaller);
+        pgf = new PgfPGF(fpath, O_CREAT | O_RDWR, S_IRUSR | S_IWUSR);
 
         {
             DB_scope scope(pgf, WRITER_SCOPE);
@@ -170,7 +167,7 @@ void pgf_iter_categories(PgfPGF *pgf, PgfItor *itor)
 }
 
 PGF_API
-uintptr_t pgf_start_cat(PgfPGF *pgf)
+uintptr_t pgf_start_cat(PgfPGF *pgf, PgfUnmarshaller *u)
 {
     DB_scope scope(pgf, READER_SCOPE);
 
@@ -187,7 +184,7 @@ uintptr_t pgf_start_cat(PgfPGF *pgf)
 		case PgfLiteralStr::tag: {
 			auto lstr = ref<PgfLiteralStr>::untagged(flag->value);
 
-            uintptr_t type = pgf_read_type(&lstr->val, pgf->u);
+            uintptr_t type = pgf_read_type(&lstr->val, u);
 			if (type == 0)
 				break;
 			return type;
@@ -200,11 +197,11 @@ uintptr_t pgf_start_cat(PgfPGF *pgf)
     s->size = 1;
     s->text[0] = 'S';
     s->text[1] = 0;
-	return pgf->u->dtyp(0,NULL,s,0,NULL);
+	return u->dtyp(0,NULL,s,0,NULL);
 }
 
 PGF_API
-PgfTypeHypo *pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos)
+PgfTypeHypo *pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos, PgfUnmarshaller *u)
 {
     DB_scope scope(pgf, READER_SCOPE);
 
@@ -220,7 +217,7 @@ PgfTypeHypo *pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos
     for (size_t i = 0; i < abscat->context->len; i++) {
         hypos[i].bind_type = abscat->context->data[i].bind_type;
         hypos[i].cid = textdup(abscat->context->data[i].cid);
-        hypos[i].type = pgf_unmarshall_type(pgf->u, abscat->context->data[i].type);
+        hypos[i].type = pgf_unmarshall_type(u, abscat->context->data[i].type);
     }
 
     *n_hypos = abscat->context->len;
@@ -277,7 +274,7 @@ void pgf_iter_functions_by_cat(PgfPGF *pgf, PgfText *cat, PgfItor *itor)
 }
 
 PGF_API
-uintptr_t pgf_function_type(PgfPGF *pgf, PgfText *funname)
+uintptr_t pgf_function_type(PgfPGF *pgf, PgfText *funname, PgfUnmarshaller *u)
 {
     DB_scope scope(pgf, READER_SCOPE);
 
@@ -286,7 +283,7 @@ uintptr_t pgf_function_type(PgfPGF *pgf, PgfText *funname)
 	if (absfun == 0)
 		return 0;
 
-	return pgf_unmarshall_type(pgf->u, absfun->type);
+	return pgf_unmarshall_type(u, absfun->type);
 }
 
 PGF_API

src/runtime/c/pgf/pgf.h

@@ -93,15 +93,12 @@ struct PgfUnmarshaller {
                            PgfText *cat,
                            int n_exprs, uintptr_t *exprs)=0;
     virtual void free_ref(uintptr_t x)=0;
-    virtual void free_me()=0;
 };
 
 struct PgfMarshaller {
     virtual uintptr_t match_lit(PgfUnmarshaller *u, uintptr_t lit)=0;
     virtual uintptr_t match_expr(PgfUnmarshaller *u, uintptr_t expr)=0;
     virtual uintptr_t match_type(PgfUnmarshaller *u, uintptr_t ty)=0;
-    virtual void free_ref(uintptr_t x)=0;
-    virtual void free_me()=0;
 };
 #else
 typedef struct PgfUnmarshaller PgfUnmarshaller;
@@ -123,7 +120,6 @@ struct PgfUnmarshallerVtbl {
                       PgfText *cat,
                       int n_exprs, uintptr_t *exprs);
     void (*free_ref)(PgfUnmarshaller *this, uintptr_t x);
-    void (*free_me)(PgfUnmarshaller *this);
 };
 struct PgfUnmarshaller {
     PgfUnmarshallerVtbl *vtbl;
@@ -135,7 +131,6 @@ struct PgfMarshallerVtbl {
     uintptr_t (*match_lit)(PgfUnmarshaller *u, uintptr_t lit);
     uintptr_t (*match_expr)(PgfUnmarshaller *u, uintptr_t expr);
     uintptr_t (*match_type)(PgfUnmarshaller *u, uintptr_t ty);
-    void (*free_me)(PgfUnmarshaller *this);
 };
 struct PgfMarshaller {
     PgfMarshallerVtbl *vtbl;
@@ -177,7 +172,6 @@ typedef struct {
 /* Reads a PGF file and keeps it in memory. */
 PGF_API_DECL
 PgfPGF *pgf_read_pgf(const char* fpath,
-                     PgfUnmarshaller *unmarshaller,
                      PgfExn* err);
 
 /* Reads a PGF file and stores the unpacked data in an NGF file
@@ -186,7 +180,6 @@ PgfPGF *pgf_read_pgf(const char* fpath,
  * between machines. */
 PGF_API_DECL
 PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
-                     PgfUnmarshaller *unmarshaller,
                      PgfExn* err);
 
 /* Tries to read the grammar from an already booted NGF file.
@@ -195,7 +188,6 @@ PgfPGF *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
  * rules dynamically. */
 PGF_API_DECL
 PgfPGF *pgf_read_ngf(const char* fpath,
-                     PgfUnmarshaller *unmarshaller,
                      PgfExn* err);
 
 /* Release the grammar when it is no longer needed. */
@@ -209,13 +201,13 @@ PGF_API_DECL
 void pgf_iter_categories(PgfPGF *pgf, PgfItor *itor);
 
 PGF_API_DECL
-uintptr_t pgf_start_cat(PgfPGF *pgf);
+uintptr_t pgf_start_cat(PgfPGF *pgf, PgfUnmarshaller *u);
 
-PGF_API_DECL PgfTypeHypo*
+PGF_API_DECL
-pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos);
+PgfTypeHypo *pgf_category_context(PgfPGF *pgf, PgfText *catname, size_t *n_hypos, PgfUnmarshaller *u);
 
-PGF_API_DECL prob_t
+PGF_API_DECL
-pgf_category_prob(PgfPGF* pgf, PgfText *catname);
+prob_t pgf_category_prob(PgfPGF* pgf, PgfText *catname);
 
 PGF_API_DECL
 void pgf_iter_functions(PgfPGF *pgf, PgfItor *itor);
@@ -224,7 +216,7 @@ PGF_API_DECL
 void pgf_iter_functions_by_cat(PgfPGF *pgf, PgfText *cat, PgfItor *itor);
 
 PGF_API_DECL
-uintptr_t pgf_function_type(PgfPGF *pgf, PgfText *funname);
+uintptr_t pgf_function_type(PgfPGF *pgf, PgfText *funname, PgfUnmarshaller *u);
 
 PGF_API_DECL
 int pgf_function_is_constructor(PgfPGF *pgf, PgfText *funname);

src/runtime/c/pgf/printer.cxx

@@ -356,7 +356,3 @@ uintptr_t PgfPrinter::dtyp(int n_hypos, PgfTypeHypo *hypos,
 void PgfPrinter::free_ref(uintptr_t x)
 {
 }
-
-void PgfPrinter::free_me()
-{
-}

src/runtime/c/pgf/printer.h

@@ -60,7 +60,6 @@ public:
                            PgfText *cat,
                            int n_exprs, uintptr_t *exprs);
     virtual void free_ref(uintptr_t x);
-    virtual void free_me();
 };
 
 #endif

src/runtime/haskell/PGF2.hsc

@@ -67,8 +67,7 @@ readPGF fpath =
   withCString fpath $ \c_fpath ->
   allocaBytes (#size PgfExn) $ \c_exn ->
   mask_ $ do
-    u <- mkUnmarshaller
+    c_pgf <- pgf_read_pgf c_fpath c_exn
-    c_pgf <- pgf_read_pgf c_fpath u c_exn
     ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType)
     if ex_type == (#const PGF_EXN_NONE)
       then do fptr <- newForeignPtr pgf_free_fptr c_pgf
@@ -91,8 +90,7 @@ bootNGF pgf_path ngf_path =
   withCString ngf_path $ \c_ngf_path ->
   allocaBytes (#size PgfExn) $ \c_exn ->
   mask_ $ do
-    u <- mkUnmarshaller
+    c_pgf <- pgf_boot_ngf c_pgf_path c_ngf_path c_exn
-    c_pgf <- pgf_boot_ngf c_pgf_path c_ngf_path u c_exn
     ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType)
     if ex_type == (#const PGF_EXN_NONE)
       then do fptr <- newForeignPtr pgf_free_fptr c_pgf
@@ -114,8 +112,7 @@ readNGF fpath =
   withCString fpath $ \c_fpath ->
   allocaBytes (#size PgfExn) $ \c_exn ->
   mask_ $ do
-    u <- mkUnmarshaller
+    c_pgf <- pgf_read_ngf c_fpath c_exn
-    c_pgf <- pgf_read_ngf c_fpath u c_exn
     ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType)
     if ex_type == (#const PGF_EXN_NONE)
       then do fptr <- newForeignPtr pgf_free_fptr c_pgf
@@ -145,8 +142,9 @@ abstractName p =
 startCat :: PGF -> Type
 startCat p =
   unsafePerformIO $
+  withForeignPtr unmarshaller $ \u ->
   withForeignPtr (a_pgf p) $ \c_pgf -> do
-    c_typ <- pgf_start_cat c_pgf
+    c_typ <- pgf_start_cat c_pgf u
     typ <- deRefStablePtr c_typ
     freeStablePtr c_typ
     return typ
@@ -155,9 +153,10 @@ startCat p =
 functionType :: PGF -> Fun -> Maybe Type
 functionType p fn =
   unsafePerformIO $
+  withForeignPtr unmarshaller $ \u ->
   withForeignPtr (a_pgf p) $ \p_pgf ->
   withText fn $ \c_fn -> do
-    c_typ <- pgf_function_type p_pgf c_fn
+    c_typ <- pgf_function_type p_pgf c_fn u
     if c_typ == castPtrToStablePtr nullPtr
       then return Nothing
       else do typ <- deRefStablePtr c_typ
@@ -204,9 +203,10 @@ categoryContext p cat =
   unsafePerformIO $
   withText cat $ \c_cat ->
   alloca $ \p_n_hypos ->
+  withForeignPtr unmarshaller $ \u ->
   withForeignPtr (a_pgf p) $ \c_pgf ->
   mask_ $ do
-    c_hypos <- pgf_category_context c_pgf c_cat p_n_hypos
+    c_hypos <- pgf_category_context c_pgf c_cat p_n_hypos u
     if c_hypos == nullPtr
       then return []
       else do n_hypos <- peek p_n_hypos
@@ -284,7 +284,7 @@ functionsByCat p cat =
 showExpr :: [Var] -> Expr -> String
 showExpr scope e =
   unsafePerformIO $
-  bracket mkMarshaller freeMarshaller $ \m ->
+  withForeignPtr marshaller $ \m ->
   bracket (newPrintCtxt scope) freePrintCtxt $ \pctxt ->
   bracket (newStablePtr e) freeStablePtr $ \c_e ->
   bracket (pgf_print_expr c_e pctxt 1 m) free $ \c_text ->
@@ -309,7 +309,7 @@ readExpr :: String -> Maybe Expr
 readExpr str =
   unsafePerformIO $
   withText str $ \c_str ->
-  bracket mkUnmarshaller freeUnmarshaller $ \u -> do
+  withForeignPtr unmarshaller $ \u -> do
     c_expr <- pgf_read_expr c_str u
     if c_expr == castPtrToStablePtr nullPtr
       then return Nothing
@@ -324,7 +324,7 @@ readExpr str =
 showType :: [Var] -> Type -> String
 showType scope ty =
   unsafePerformIO $
-  bracket mkMarshaller freeMarshaller $ \m ->
+  withForeignPtr marshaller $ \m ->
   bracket (newPrintCtxt scope) freePrintCtxt $ \pctxt ->
   bracket (newStablePtr ty) freeStablePtr $ \c_ty ->
   bracket (pgf_print_type c_ty pctxt 0 m) free $ \c_text ->
@@ -335,7 +335,7 @@ readType :: String -> Maybe Type
 readType str =
   unsafePerformIO $
   withText str $ \c_str ->
-  bracket mkUnmarshaller freeUnmarshaller $ \u -> do
+  withForeignPtr unmarshaller $ \u -> do
     c_ty <- pgf_read_type c_str u
     if c_ty == castPtrToStablePtr nullPtr
       then return Nothing

src/runtime/haskell/PGF2/FFI.hsc

@@ -8,6 +8,7 @@ import Foreign.C
 import Foreign.Ptr
 import qualified Data.Map as Map
 import Control.Exception(bracket,mask_)
+import System.IO.Unsafe(unsafePerformIO)
 
 import PGF2.Expr
 
@@ -38,13 +39,13 @@ foreign import ccall unsafe "pgf_utf8_encode"
   pgf_utf8_encode :: Word32 -> Ptr CString -> IO ()
 
 foreign import ccall "pgf_read_pgf"
-  pgf_read_pgf :: CString -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfPGF)
+  pgf_read_pgf :: CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
 
 foreign import ccall "pgf_boot_ngf"
-  pgf_boot_ngf :: CString -> CString -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfPGF)
+  pgf_boot_ngf :: CString -> CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
 
 foreign import ccall "pgf_read_ngf"
-  pgf_read_ngf :: CString -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfPGF)
+  pgf_read_ngf :: CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
 
 foreign import ccall "&pgf_free"
   pgf_free_fptr :: FinalizerPtr PgfPGF
@@ -73,10 +74,10 @@ foreign import ccall "pgf_iter_categories"
   pgf_iter_categories :: Ptr PgfPGF -> Ptr PgfItor -> IO ()
 
 foreign import ccall "pgf_start_cat"
-  pgf_start_cat :: Ptr PgfPGF -> IO (StablePtr Type)
+  pgf_start_cat :: Ptr PgfPGF -> Ptr PgfUnmarshaller -> IO (StablePtr Type)
 
 foreign import ccall "pgf/pgf.h pgf_category_context"
-  pgf_category_context :: Ptr PgfPGF -> Ptr PgfText -> Ptr CSize -> IO (Ptr PgfTypeHypo)
+  pgf_category_context :: Ptr PgfPGF -> Ptr PgfText -> Ptr CSize -> Ptr PgfUnmarshaller -> IO (Ptr PgfTypeHypo)
 
 foreign import ccall "pgf/pgf.h pgf_category_prob"
   pgf_category_prob :: Ptr PgfPGF -> Ptr PgfText -> IO (#type prob_t)
@@ -88,7 +89,7 @@ foreign import ccall "pgf_iter_functions_by_cat"
   pgf_iter_functions_by_cat :: Ptr PgfPGF -> Ptr PgfText -> Ptr PgfItor -> IO ()
 
 foreign import ccall "pgf/pgf.h pgf_function_type"
-   pgf_function_type :: Ptr PgfPGF -> Ptr PgfText -> IO (StablePtr Type)
+   pgf_function_type :: Ptr PgfPGF -> Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Type)
 
 foreign import ccall "pgf/expr.h pgf_function_is_constructor"
    pgf_function_is_constructor :: Ptr PgfPGF -> Ptr PgfText -> IO (#type int)
@@ -266,26 +267,22 @@ foreign import ccall "&hs_free_reference" hs_free_reference :: FunPtr (Ptr a ->
 
 foreign import ccall "&hs_free_marshaller" hs_free_marshaller :: FinalizerPtr PgfMarshaller
 
-foreign import ccall "hs_free_marshaller" freeMarshaller :: Ptr PgfMarshaller -> IO ()
-
 foreign import ccall "&hs_free_unmarshaller" hs_free_unmarshaller :: FinalizerPtr PgfUnmarshaller
 
-foreign import ccall "hs_free_unmarshaller" freeUnmarshaller :: Ptr PgfUnmarshaller -> IO ()
-
 type MatchFun a = Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> StablePtr a -> IO (StablePtr a)
 
 foreign import ccall "wrapper"
   wrapMatchFun :: MatchFun a -> IO (FunPtr (MatchFun a))
 
-mkMarshaller = do
+{-# NOINLINE marshaller #-}
+marshaller = unsafePerformIO $ do
   vtbl <- mallocBytes (#size PgfMarshallerVtbl)
   wrapMatchFun matchLit  >>= (#poke PgfMarshallerVtbl, match_lit)  vtbl
   wrapMatchFun matchExpr >>= (#poke PgfMarshallerVtbl, match_expr) vtbl
   wrapMatchFun matchType >>= (#poke PgfMarshallerVtbl, match_type) vtbl
-  (#poke PgfMarshallerVtbl, free_me)  vtbl hs_free_marshaller
   ptr <- mallocBytes (#size PgfMarshaller)
   (#poke PgfMarshaller, vtbl) ptr vtbl
-  return ptr
+  newForeignPtr hs_free_marshaller ptr
   where
     matchLit this u c_lit = do
       vtbl <- (#peek PgfUnmarshaller, vtbl) u
@@ -364,7 +361,8 @@ mkMarshaller = do
           (#peek PgfTypeHypo, type) ptr >>= freeStablePtr
           freeHypos (ptr `plusPtr` (#size PgfTypeHypo)) (n-1)
 
-mkUnmarshaller = do
+{-# NOINLINE unmarshaller #-}
+unmarshaller = unsafePerformIO $ do
   vtbl <- mallocBytes (#size PgfUnmarshallerVtbl)
   wrapEAbsFun     unmarshalEAbs     >>= (#poke PgfUnmarshallerVtbl, eabs)     vtbl
   wrapEAppFun     unmarshalEApp     >>= (#poke PgfUnmarshallerVtbl, eapp)     vtbl
@@ -379,10 +377,9 @@ mkUnmarshaller = do
   wrapLStrFun     unmarshalLStr     >>= (#poke PgfUnmarshallerVtbl, lstr)     vtbl
   wrapDTypFun     unmarshalDTyp     >>= (#poke PgfUnmarshallerVtbl, dtyp)     vtbl
   (#poke PgfUnmarshallerVtbl, free_ref) vtbl hs_free_reference
-  (#poke PgfUnmarshallerVtbl, free_me)  vtbl hs_free_unmarshaller
   ptr <- mallocBytes (#size PgfUnmarshaller)
   (#poke PgfUnmarshaller, vtbl) ptr vtbl
-  return ptr
+  newForeignPtr hs_free_unmarshaller ptr
   where
     unmarshalEAbs this c_btype c_var c_body = do
       let btype = unmarshalBindType c_btype

src/runtime/python/pypgf.c

@@ -3513,7 +3513,7 @@ pgf_readPGF(PyObject *self, PyObject *args)
 
 	// Read the PGF grammar.
     PgfExn err;
-	py_pgf->pgf = pgf_read_pgf(fpath, NULL/*TO BE FIXED*/, &err);
+	py_pgf->pgf = pgf_read_pgf(fpath, &err);
     if (err.type == PGF_EXN_SYSTEM_ERROR) {
         errno = err.code;
         PyErr_SetFromErrnoWithFilename(PyExc_IOError, fpath);